# tcllib yüklü olmalı yada 
# http.tcl scripts klasörüne atılıp 
# .conf içinde yüklenmeli.
# bu durumda http.tcl'nin bu script'ten
# evvel yüklenmiş olması gerekir.
# o nedenle daha üst bir satırda 
# gösterebilirsiniz.
# tcllib yüklüyse  buna gerek yoktur.
;##############################################

package require http

;# yapılan işlemin rapor edileceği kanal:
set rapor "#raporkanal"

;# işlem yapılırken gönderilecek sebep;
set sebep "bizi tercih ettiğiniz için teşekkür ederiz...Selametle güzel insan evladı..."

;# hangi sayıdan itibaren yapılan işlemleri saydırmaya başlıyacak:
set torno "0"

;###################burdan sonrasını değişmemelisiniz########################

;# sunucu girişlerinde yakalanacak notice:
set grsnotc "*client connecting*"

;# tor yakalandığını bildiren siteden alınan mesajlardan biri:
set msj1 "*blacklist for*"

;# tor yakalandığını bildiren siteden alınan mesajlardan biri:
set msj2 "*Schwarze Liste*"

;# taramada kullandığımız adres;
set link "
Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir.
kısmı sonlandı######################################

bind raw * notice tor_join

proc tor_join {from keyword text} {
  if {![string match -nocase $::grsnotc $text] || [string match -nocase "*!*@*" $from]} { return 0;}
  
  set uhost [lindex [split $text] 9]
  set q [lindex [split $uhost @] 1]
  
  set stamp "[concat $::torno - [clock format [expr {3600 + [clock seconds]}] -format "Tarih: %d/%m/%Y - Saat: %H:%M:%S %z"]]"
  set uagent "Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.0.1) Gecko/2008070208 Firefox/3.0.1"
  
::http::config -useragent $uagent
catch { set url [::http::geturl $::link$q -timeout 40000] } error
set data [::http::data $url]
::http::cleanup $url

if {[string match -nocase "*couldn't open socket*" $error] && [string equal -nocase [::http::status $url] "*timeout*"]} {
 putcmdlog " $q taranamadı ... hata oluştu... : [clock format [expr {3600 + [clock seconds]}] -format "Tarih: %d/%m/%Y - Saat: %H:%M:%S %z"]"
 return 0
 } else {

regexp -- {<div class="ueberschrift">(.*?)</div>} $data "" listed

regsub -all {\n} $data {} data

if {[string match -nocase $::msj1 $listed] && [string match -nocase $::msj2 $listed]} {
    incr ::torno
   putquick "gzline *@$q :$::sebep:$stamp"
   puthelp "privmsg $::rapor :$q yakalandı...sunucudan uzaklaştırıldı...: $stamp"
   } else {
   putcmdlog "$q tarandı...tor bulunmadı...: $stamp"
      return 0
      }
   }
}

putlog "ok..."