IRCForumları - IRC ve mIRC Kullanıcılarının Buluşma Noktası - IRC deki User Sayısını Web e Yansıtmak.

Kod:
#Chanlist 1.00 Aug 2001
 #Creates a channel list and stores in an HTML file
 #The color codes conversion is based on ques5.tcl by Robert Pointer and
 #the eggheads Developement Team, modifyed to read the background codes.
 #Any questions? mailto:
Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir.

 #Where id the channel file located?
 set listfile "../../
Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir.
size="2">#How many seconds will the bot wait to write a new list?
 #be careful, in large networks this can take a while
 set refresh 2
 #What is the title of the page?
 set pagetitle "IRC.MYSEV.NET Oda Listesi"
 ###### the code starts here ########
 utimer $refresh get_channels 
 # Which characters should be allowed in URLs?
 # DO NOT MODIFY unless you really know what you are doing.
 # Expecially never add '<', '"' and '>'
 set web_urlchars "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890 :+-/!\$%&()=[]{}#^~*.:,;\\|?_@"
 # IRC -> HTML color translation table
 set web_color(0) "#FFFFFF"
 set web_color(1) "#000000"
 set web_color(2) "#00007F"
 set web_color(3) "#008F00"
 set web_color(4) "#FF0000"
 set web_color(5) "#7F0000"
 set web_color(6) "#9F009F"
 set web_color(7) "#FF7F00"
 set web_color(8) "#F0FF00"
 set web_color(9) "#00F700"
 set web_color(10) "#008F8F"
 set web_color(11) "#00F7FF"
 set web_color(12) "#0000FF"
 set web_color(13) "#FF00FF"
 set web_color(14) "#7F7F7F"
 set web_color(15) "#CFCFCF"
 # IRC -> HTML style translation table
 set web_style(\002) "<B> </B>"
 set web_style(\003) "<FONT> </FONT>"
 set web_style(\026) "<I> </I>"
 set web_style(\037) "<U> </U>"
 set web_style(,) ","
 proc webify {string} {
 # TCL8.1 only:
 #return [string map {\" &quot; & &amp; < &lt; > &gt;} $string]
 # Otherwise use this:
 regsub -all "\\&" $string "\\&amp;" string
 regsub -all "\"" $string "\\&quot;" string
 regsub -all "<" $string "&lt;" string
 return $string
 }
 proc convstyle {string} {
 global web_color web_style
 set result ""
 set stack ""
 for {set i 0} "\$i < [string length $string]" {incr i} {
 set char [string index $string $i]
 switch -- $char {
 "\002" - "\026" - "\037" {
 if {[string first $char $stack] != -1} {
 # NOT &&
 if {[string index $stack 0] == $char} {
 append result [lindex $web_style($char) 1]
 set stack [string range $stack 1 end]
 }
 } else {
 append result [lindex $web_style($char) 0]
 set stack $char$stack
 }
 }
 "\003" {
 if {[string first $char $stack] != -1} {
 if {[string index $stack 0] == $char} {
 append result [lindex $web_style($char) 1]
 set stack [string range $stack 1 end]
 }
 }

 
 set c [getnumber [string range $string [expr $i + 1] [expr $i + 2]]]

 
 if {$c != "" && $c >= 0 && $c <= 15} {
 incr i [expr [string length $c] + 0 ]
 append result "<FONT COLOR=\"$web_color($c)\">"
 set stack $char$stack
 }
 }
 "," {
 if {[string first $char $stack] != -1} {
 if {[string index $stack 0] == $char} {
 append result [lindex $web_style($char) 1]
 set stack [string range $stack 1 end]
 }
 }
 set d [getnumber [string range $string [expr $i + 1] [expr $i + 2]]]
 if {$d != "" && $d >= 0 && $d <= 15 && $d != ","} {
 append result "<span style=\"background-color : $web_color($d);\">"
 incr i [expr [string length $d] + 0]
 set stack $char$stack

 
 }
 }
 default {append result $char}
 }
 }
 foreach char [split $stack ""] {
 if {$char == "\002" || $char == "\003" ||
 $char == "\026" || $char == "\037"} {
 append result [lindex $web_style($char) 1]
 }
 }
 return $result
 }
 proc getnumber {string} {
 set result ""
 foreach char [split $string ""] {
 if {[string first $char "0123456789"] == -1} {
 return $result
 } else {
 for {set i 0} "\$i < [string length $string]" {incr i} {
 if { [string first [string range $string $i $i] "0123456789"] == -1} {
 } else {
 append result $char
 set i [string length $string]
 }
 }
 }
 }
 return $result
 }
 # set variables to defaults
 set list_active 0
 if {![info exists list_data]} then {set list_data ""}
 # get a new channel list
 proc get_channels {} {
 global list_active listfile pagetitle
 set fh1 [open $listfile w]
 puts $fh1 "<html>"
 puts $fh1 "<head>"
 puts $fh1 "<title>"
 puts $fh1 $pagetitle
 puts $fh1 "</title>"
 puts $fh1 "<style>"
 puts $fh1 "tr, td, body { font-family: arial,helvetica;}"
 puts $fh1 "</style>"
 puts $fh1 "</head>"
 puts $fh1 "<body bgcolor=#FFFFFF>"
 puts $fh1 "<table border=1 cellspacing=0 cellpadding=5 bordercolor=black>"
 puts $fh1 "<tr><td><b><font color="#FF0000" size="4" face="Trebuchet MS">Oda 
 Adı</font></b></td><td><b>
 <font color="#FF0000" size="4" face="Trebuchet MS">Kullanıcı Sayısı</font></b></td><td>
 <b><font color="#FF0000" size="4" face="Trebuchet MS">Oda Başlığı</font></b></td></tr>"
 close $fh1
 set list_active 1
 putlog "Listing channels..."
 putserv "LIST"
 return 0
 }
 # begin of channel list
 proc raw_321 {from key arg} {
 global list_active list_data
 if {$list_active} then {
 putlog "Start of channel list."
 set list_data ""
 }
 return 0
 }
 # channel list
 proc raw_322 {from key arg} {
 global list_active list_data listfile
 set fh [open $listfile a]
 if {$list_active} then {
 puts $fh "<tr><td>"
 puts $fh "[lindex [split $arg] 1]"
 puts $fh "</td align=\"center\">"
 puts $fh "<td>[lindex [split $arg] 2]</td>"
 set thestring [string trimright [lrange $arg 3 [llength $arg] ] ]
 if {[string length $thestring] > 0} {
 set thestring2 [string range $thestring 1 [ string length $thestring]]
 }
 puts $fh "<td>"
 puts $fh "[convstyle [ webify $thestring2 ] ]&nbsp;"
 puts $fh "</td></tr>"
 lappend list_data [lindex [split $arg] 1]
 }
 close $fh
 return 0
 }
 # end of channel list
 proc raw_323 {from key arg} {
 global list_active listfile refresh
 set fh2 [open $listfile a]
 puts $fh2 "</table></body></html>"
 close $fh2
 if {$list_active} then {
 putlog "End of channel list."
 set list_active 0
 }
 utimer $refresh get_channels
 return 0
 }
 bind raw -|- 321 raw_321
 bind raw -|- 322 raw_322
 bind raw -|- 323 raw_323
 #####
Al BaRiCeLLo senin olsun :D
TCL'yi yükle [Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...] da oda listesi/kullanıcı sayısı/topicler gösterilcek...