Code:

####################################################### ### PIC-Check-SCRIPT ################################### ###################################################### proc url:check {nick host hand chan arg} {     if {[lsearch -exact [channel info $chan] +urlcheck] < 0} { return }     if {[string match "*www.*.jpg*" [strlwr $arg]] || [string match "*www.*.gif*" [strlwr $arg]] || [string match "*http://*.jpg*" [strlwr $arg]] || [string match "*http://*.gif*" [strlwr $arg]]} {         url:check:geturl $nick $chan $arg     } } proc url:check:geturl {nick chan arg} {     foreach word [split $arg " "] {         if {[string match "*www.*.jpg*" [strlwr $word]] || [string match "*www.*.gif*" [strlwr $word]] || [string match "*http://*.jpg*" [strlwr $word]] || [string match "*http://*.gif*" [strlwr $word]]} {             putlog "Checke $word von $nick in $chan"             url:check:imgscan $nick $chan $word         }     } } proc url:check:imgscan {nick chan arg} {     global image     set script 0     regsub -all "http://" $arg {} url     set server [lindex [split $url /] 0]     set url [string replace $url 0 [string first / $url]]     set query "http://$server/$url"     set agent "Mozilla/4.0 (compatible; MSIE 5.0; Windows 98)"     http::config -useragent $agent     set token [http::geturl $query -timeout 10000]     upvar #0 $token state     array set meta $state(meta)     set htmlcode [http::code $token ]     set htmlmeta [join $state(meta)]     http::cleanup $token     if {[string match "HTTP/1.*" $htmlcode] && [string match "*200 OK*" $htmlcode]} {         set success 1     } elseif {[string match "HTTP/1.*" $htmlcode] && [string match "*404*" $htmlcode]} {         url:saytext $nick $chan $server $url "Error 404: Datei $server/$url nicht gefunden!"         return     } elseif {[string match "HTTP/1.*" $htmlcode] && [string match "*401*" $htmlcode]} {         url:saytext $nick $chan $server $url "Error 401: Access to $url denied on $server"         return     } elseif {[string match "HTTP/1.*" $htmlcode] && [string match "*302*" $htmlcode]} {         set moved 1     } elseif {[string match "HTTP/1*" $htmlcode]} {         url:saytext $nick $chan $server $url "Server returned code"     }     if {[string match "*Location *" $htmlmeta] && [info exists moved]} {         url:saytext $nick $chan $server $url "Server reports URL to you of $nick one shifted! New URL: [lindex $htmlmeta [expr [lsearch $htmlmeta "Location"] + 1]]"         return     }     if {[string match "*Content-Type text/html*" $htmlmeta] && [info exists success]} {         url:saytext $nick $chan $server $url "Server reports that the URL from Statuscode \"200 OK\" from $nick's URL, but HTML does not report an image. Possible Virus!"         return     }     if {[string match "*Content-Type image/*" $htmlmeta] && [info exists success]} {         set image($chan) 1     }     if {[string match "*<script*" $htmlmeta] && [info exists image]} {         set script 1         url:saytext $nick $chan $server $url "Server reports web page from $nick with Scripts. Possible Virus!"     }     url:end $nick $chan $server $url $script } proc url:end {nick chan server url script} {     global image     if {[info exists image($chan)] && $script == 0} {         url:saytext $nick $chan $server $url "URL from $nick is safe (No Danger!)"         unset image($chan)     } } proc url:saytext {nick chan server url text} {     set chanifo [getchanmode $chan]     set chanifo1 [string first c $chanifo]     set line [url:getskin $chan $text]     if {[onchan $::botnick $chan] && [validchan $chan]} {         if {$chanifo1 < 0} {             puthelp "PRIVMSG $chan :$line"         } elseif {$chanifo1 >= 0 && [string first "" $line] < 0} {             puthelp "PRIVMSG $chan :$line"         } else {             puthelp "PRIVMSG $chan :» URL-Check »» $text «"         }     } else {         putlog "\[url:saytext\] With $chan tunes which not!"     } } proc url:getskin {chan text} {     set skin($chan)         [channel get $chan fun_style]     if {$skin($chan) == ""} {         channel set $chan fun_style 1         set skin($chan)    1     }     set getskin ""     if {$skin($chan) == 1} {         set getskin "1,0 » 2URL-Check1 »» $text « "     } elseif {$skin($chan) == "own"} {         set getskin [channel get $chan fun_style_own]     }     if {$getskin == ""} {         channel set $chan fun_style 1         set getskin "1,0 » 2URL-Check1 »» $text « "     }     regsub -all {:text:} $getskin "$text" getskin     return [join $getskin] }