| d0gma | 23 Ağustos 2007 11:17 |
Cevap: Yanıt: Eggdrop (TCL Arşivleri)
Alıntı:
asilmavi Nickli Üyeden Alıntı
(Mesaj 150065)
Sayac.Tcl ( Kanalda Atılan Kickleri,toplam girişleri v.s Sayar.) Kod:
# Bu Tcl Cok basit kanal kick ve join Sayac Tcl`idir..
# Kanaliza Giren Kisileri vede kanaldan atilan kisileri sayar..
# Bu Tcl IRCturk NEtwork Team Tarafindan Yazilmistir..
# Tcl calismak icin userinfo1.0.tcl ye ihtiyac duyar..
# Aksi takdirde calismicaktir..
# Stonkeep
#
# Kullanabileceginiz Komutlar..
# Kanalda:
# !toplamgiris - Kanala bugune kadar kisi sayisini gosterir..
# !toplamatilan - Kanaldan bugune kadar atilan kisi sayisini gosterir..
# !toplamatilan <nick> - Nick`in kac kisiyi attigini gosterir..
# DCC Komutlari:
# .toplamgiris - Kanala bugune kadar kisi sayisini gosterir..
# .toplamatilan - Kanaldan bugune kadar atilan kisi sayisini gosterir..
# .toplamatilan <nick> - Nick`in Kac kisiyi attigini gosterir..
#
if {![info exists userinfover] } {
putlog "*** Sayac Tcl Yuklenemiyo 2.0 -- Userinfo v1.01 .tcl Yuklu Olmak Zorunda.!"
return 0
}
bind pub -|- !toplamgiris pub:toplamgiris
bind dcc -|- toplamgiris dcc:toplamgiris
bind join -|- * joincounter
bind pub -|- !toplamatilan pub:toplamatilan
bind dcc -|- toplamatilan dcc:toplamatilan
bind kick -|- * kickcounter
set khits 0
set jhits 0
proc convert {number} {
set one .
set two .
set three .
set others .
set numlength [string length $number]
incr numlength -2
set num2ndchar [string index $number $numlength]
switch $num2ndchar {
1 { set number $number$others }
default {
incr numlength
set numchar [string index $number $numlength]
switch $numchar {
1 { set number $number$one }
2 { set number $number$two }
3 { set number $number$three }
default { set number $number$others }
}
}
}
return $number
}
proc dcc:toplamgiris {hand idx arg} {
if {$arg == ""} {
set temp 0
set chan [lindex [console $idx] 0]
set rchan [string tolower $chan]
if {[file exists ./scripts/$rchan.jcount.txt]} {
set o_fid [open "./scripts/$rchan.jcount.txt" "RDONLY"]
gets $o_fid temp
close $o_fid
putdcc $idx "$rchan kanalini toplam $temp kisi ziyaret etti."
return 0
} else {
putdcc $idx "$rchan kanalini suana kadar kimse ziyaret etmedi.."
}
} else {
set temp 0
set rchan [string tolower $arg]
if {[file exists ./scripts/$rchan.jcount.txt]} {
set o_fid [open "./scripts/$rchan.jcount.txt" "RDONLY"]
gets $o_fid temp
close $o_fid
putdcc $idx "$rchan kanalini toplam $temp kisi ziyaret etti"
return 0
} else {
putdcc $idx "$rchan kanalini suana kadar kimse ziyaret etmedi"
}
}
}
proc pub:toplamgiris {nick host hand chan arg} {
if { $arg == "" } {
set temp 0
set rchan [string tolower $chan]
if {[file exists ./scripts/$rchan.jcount.txt]} {
set o_fid [open "./scripts/$rchan.jcount.txt" "RDONLY"]
gets $o_fid temp
close $o_fid
putserv "PRIVMSG $chan :$chan Kanalini toplamda $temp kisi Ziyaret Etti."
return 0
} else {
putserv "PRIVMSG $chan :Uzgunum, $rchan kanalini simdiye kadar kimse ziyaret etmedi."
}
} else {
set temp 0
set rchan [string tolower $arg]
if {[file exists ./scripts/$rchan.jcount.txt]} {
set o_fid [open "./scripts/$rchan.jcount.txt" "RDONLY"]
gets $o_fid temp
close $o_fid
putserv "PRIVMSG $chan :#rchan Kanalini Toplamda $temp kisi Ziyaret Etti."
return 0
} else {
putserv "PRIVMSG $chan :Uzgunum, $rchan kanalini simdiye kadar kimse ziyaret etmedi."
}
}
}
proc joincounter {nick host hand chan} {
global jhits
set temp 0
set rchan [string tolower $chan]
if {[file exists ./scripts/$rchan.jcount.txt]} {
set o_fid [open "./scripts/$rchan.jcount.txt" "RDONLY"]
gets $o_fid temp
close $o_fid
} else {
set o_fid [open "./scripts/$rchan.jcount.txt" "CREAT RDWR"]
puts $o_fid temp
close $o_fid
}
set jhits $temp
incr jhits
putserv "NOTICE $nick :$chan Kanalina Giren [convert $jhits] Kisisiniz.! Turkiyenin IRC Portali
Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir.
o_id [open "./scripts/$rchan.jcount.txt" "WRONLY"]
puts $o_id $jhits
close $o_id
}
proc dcc:toplamatilan {hand idx arg} {
if {$arg == ""} {
set temp 0
set chan [lindex [console $idx] 0]
set rchan [string tolower $chan]
if {[file exists ./scripts/$rchan.kcount.txt]} {
set o_fid [open "./scripts/$rchan.kcount.txt" "RDONLY"]
gets $o_fid temp
close $o_fid
putdcc $idx "$rchan kanalindan toplamda $temp kisi atildi."
return 0
} else {
putdcc $idx "Suana kadar kimse $rchan kanalindan atilmadi."
}
} else {
set temp 0
set nick [string tolower $arg]
if {[validuser $nick]} {
if {[getuser $nick XTRA KICKS] == ""} {
putdcc $idx "$arg Kimseyi Atmadi."
} else {
set tkicks [getuser $nick XTRA KICKS]
putdcc $idx "$arg Suana Kadar $tkicks kisiyi kanaldan atti."
}
} else {
putdcc $idx "$arg Kim Bilmiyorum..!"
}
}
}
proc pub:toplamatilan {nick host hand chan arg} {
if { $arg == "" } {
set temp 0
set rchan [string tolower $chan]
if {[file exists ./scripts/$rchan.kcount.txt]} {
set o_fid [open "./scripts/$rchan.kcount.txt" "RDONLY"]
gets $o_fid temp
close $o_fid
putserv "PRIVMSG $chan :$chan Kanalindan toplamda $temp kisi Atildi."
return 0
} else {
putserv "PRIVMSG $chan :Suana kadar kimse $rchan kanalindan atilmadi."
}
} else {
set temp 0
set nick [string tolower $arg]
if {[validuser $nick]} {
if {[getuser $nick XTRA KICKS] == ""} {
putserv "PRIVMSG $chan :$arg Kimseyi Kanaldan Atmadi."
} else {
set tkicks [getuser $nick XTRA KICKS]
putserv "PRIVMSG $chan :$arg Suanada kadar Kanaldan $tkicks kisiyi atti."
}
} else {
putserv "PRIVMSG $chan :$arg kimdir bilmiyorum..!"
}
}
}
proc kickcounter {nick host hand chan knick reason} {
global khits
set temp 0
set rchan [string tolower $chan]
if {[file exists ./scripts/$rchan.kcount.txt]} {
set o_fid [open "./scripts/$rchan.kcount.txt" "RDONLY"]
gets $o_fid temp
close $o_fid
} else {
set o_fid [open "./scripts/$rchan.kcount.txt" "CREAT RDWR"]
puts $o_fid temp
close $o_fid
}
set khits $temp
incr khits
if {[validuser [nick2hand $nick $chan]]} {
if {[getuser $hand XTRA KICKS] == ""} {
setuser $hand XTRA KICKS 0
}
set tkicks [getuser $hand XTRA KICKS]
incr tkicks
setuser $hand XTRA KICKS $tkicks
putserv "PRIVMSG $chan :$nick Bugune Kadar $tkicks Kisi Kicklemis.."
}
putserv "NOTICE $knick :Siz $chan Kanalindan Atilan [convert $khits] Kisiniz.!"
set o_id [open "./scripts/$rchan.kcount.txt" "WRONLY"]
puts $o_id $khits
close $o_id
}
putlog "Join ve Kick Kanal Sayaci"
| Eggdrop v1.6.18 (C) 1997 Robey Pointer (C) 2006 Eggheads
[04:14] --- Loading eggdrop v1.6.18 (Thu Aug 23 2007)
[04:14] Module loaded: channels
[04:14] Module loaded: server
[04:14] Module loaded: ctcp
[04:14] Module loaded: irc
[04:14] Module loaded: notes (with lang support)
[04:14] Module loaded: console (with lang support)
[04:14] Module loaded: blowfish
[04:14] Listening at telnet port 3334 (all).
[04:14] *** Sayac Tcl Yuklenemiyo 2.0 -- Userinfo v1.01 .tcl Yuklu Olmak Zorunda
.!
[04:14] Ban Flooders v2.1.3 by MC_8 loaded.
[04:14] Userfile loaded, unpacking...
USERFILE ALREADY EXISTS (drop the '-m')
[04:14] === EGGDROP: 1 channels, 1 users.
Launched into the background (pid: 16775)
nasil hallaedebilirim | 