IRCForumları - IRC ve mIRC Kullanıcılarının Buluşma Noktası

Kod:
¨# ======= Bot en az IRCOP olmalýdýr. ======

    set url "
Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir.
Verilerin alýnacaðý sitenin adresi.

    set sayfa "/gunluk_fal/bugun.asp?burc="        ;# Baþvuru yapýlacak web sayfasý.

     set port 80                            ;# Web portu.

    set baskelime "<strong><big>"                ;# Web sayfasýndaki yorumun baþladýðý html kodu

    set bitkelime "</big></strong>"            ;# Web sayfasýndaki yorumun bittiði html kodu

    set baslen [strlen $baskelime]            ;# Dokunmayýn.

    set burckanali "#ayva"                ;# Botun bulunacaðý ve iletileri yazacaðý kanal.

    set bekleme "30"                        ;# Ýkinci bir yorumu almak için kiþinin bekleme süresi (Sn.)

    set satiruzunlugu "250"                    ;# Bir seferde kiþiye gönderilecek azami satýr uzunluðu.

    set cevapturu "0"                        ;# 0- yorum kanala, 1- yorum özele.
 

bind pub - !burc pub:burc
 

proc pub:burc {n u h c a } {

 global burckanali bekleme

     set c [string tolower [lindex $c 0]]

     if {$c != $burckanali} { return 0 }

     if {[beklemekontrol $u,$c $bekleme]} {

        putquick "PRIVMSG $n :Sýk aralýklarla istekte bulunamazsýnýz!"

        putquick "PRIVMSG $n :Tekrar yorum almak için lütfen $bekleme saniye bekleyip yeniden deneyiniz."

        return 0

    } else {

    set burc "[string tolower [lindex $a 0]]"

    switch -- $burc {

        "koc" { baglan $n 1 Koç }

        "boga" { baglan $n 2 Boða }

        "ikizler" { baglan $n 3 Ýkizler }

        "yengec" { baglan $n 4 Yengeç }

        "aslan" { baglan $n 5 Aslan }

        "basak" { baglan $n 6 Baþak }

        "terazi" { baglan $n 7 Terazi }

        "akrep" { baglan $n 8 Akrep }

        "yay" { baglan $n 9 Yay }

        "oglak" { baglan $n 10 Oðlak }

        "kova" { baglan $n 11 Kova }

        "balik" { baglan $n 12 Balýk }

        "info" { return 0 }

       default {

        putquick "PRIVMSG $n :Geçersiz bir burç adý girdiniz!"

        putquick "PRIVMSG $n :12koc,boga,ikizler,aslan,basak,terazi,akrep,yay,oglak,kova,balik"

        putquick "PRIVMSG $n :Yukarýdaki tanýmlamalara uygun olarak 12!burc burcunuz þeklinde yazýnýz."

        putquick "PRIVMSG $n :Aksi taktirde burcunuzun yorumunu alamayacaksýnýz"

        return 0

            }

           }

     } 

}
 

#=============================================================

proc baglan { nick id burc } {

     global burckanali baskelime bitkelime baslen url port satiruzunlugu cevapturu sayfa

    if {$cevapturu == 1} { putserv "PRIVMSG $nick :4 $burc  burcunun yorumu alýnýyor lütfen bekleyiniz..." }

    if {$cevapturu == 0} { putquick "mode $burckanali +m" ; putserv "PRIVMSG $burckanali :4$nick için $burc  burcunun yorumu alýnýyor..." }

    if {[catch { set sock [socket -async $url $port] } sockerror]} { putserv "PRIVMSG $nick :$sockerror : Veri alýnamadý." ; return 0 } 

    fconfigure $sock  -encoding utf-8; puts $sock "GET $sayfa$id"; puts $sock "User-Agent: Mozilla/5.0 (X11; U; Linux i686; tr-TR; rv:1.4) Gecko/20030624"

    puts $sock "Host: $url"; puts $sock "Connection: close"; puts $sock ""; flush $sock

    while {[eof $sock] != 1} { append content [gets $sock] }; close $sock

    set basla [string first $baskelime $content]; set bitis [string first $bitkelime $content]; set content [string range $content [expr $basla + $baslen] [expr $bitis -1]]

    regsub -all {<br>} $content "" content

   if {$cevapturu == 1} { foreach satir [yazibol $content $satiruzunlugu] { puthelp "PRIVMSG $nick :6$satir" }; puthelp "PRIVMSG $nick :Bu yorum 12$url sitesinden alýnmýþtýr." }

   if {$cevapturu == 0} { foreach satir [yazibol $content $satiruzunlugu] { puthelp "PRIVMSG $burckanali :6$satir" }; puthelp "PRIVMSG $burckanali :Bu yorum 12$url sitesinden alýnmýþtýr."; puthelp "mode $burckanali -m" }    

}

#=============================================================

proc yazibol {data len} { 

   set out {} 

   foreach line [split [string trim $data] "\n"] { 

      set curr {}; set i 0 

      foreach word [split [string trim $line]] { 

         if {[incr i [string len $word]]>$len} { lappend out [join $curr]; set curr [list $word]; set i [string len $word] } 

        lappend curr $word 

            incr i 

          } 

      if {[llength $curr]} { lappend out [join $curr] } 

   } 

   set out 

} 

#=============================================================

proc beklemekontrol {id sure} {

      global beklemekontrol

    if {[info exists beklemekontrol($id)]} { return 1 }; set beklemekontrol($id) [clock sec];    utimer $sure [list unset beklemekontrol($id)]; return 0

}