CiKo Sağol O TCL elimde var fakat nasıl kullanılıyor kurulumu vs.. biraz açıklanırsa üstadlar tarafından. bizde faydalanabiliriz. herkez becerikli değil Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir.
Valla Burda Aktif Olarak Paylaşım yapan Bi Kaç Arkadaşımızın Sitelerinde Bu Olay Var Ama Sanırım Paylaşmak İstemiolar Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir. Hadi Bakalım Taş Attım Kafalar Yarılmadan Bişeyler Yazın :P
#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 {\" " & & < < > >} $string]
# Otherwise use this:
regsub -all "\\&" $string "\\&" string
regsub -all "\"" $string "\\"" string
regsub -all "<" $string "<" 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 ] ] "
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 Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir.
TCL'yi yükle [Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...] da oda listesi/kullanıcı sayısı/topicler gösterilcek...
__________________ Eskiden buralar hep dutluktu...
Olmadı be Çikoo Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir. Biraz Daha Açıklarsan Çok Seviniris Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir.