kendi botumda kullanmak için daha gelişmiş bir versionunu yaptım ..bu haliyle atılan linki kısa hale çevirmekle birlikte linkin başlığını da yansıtıyor. ayrıca hem aktif edildiği kanalda hemde bot özelinde de aynı işi yapabiliyor...
( bunu kullanmak için tcl sürümü 8.5.x ve yukarısı olmalı ...8.4 ise boşa denemeyin....hata atar..)
Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir. Kod: Kodu kopyalamak için üzerine çift tıklayın!
if {[info tclversion] < 8.5} {
putloglev o * "Bu scripti kullanmak icin en az, Tcl8.5.x ve ustu Tcl surumlerinden biri kurulu olmali. Algilanan surum : $tcl_patchLevel"
} else {
putloglev o * "Algilanan Tcl surumu : $tcl_patchLevel shorten.tcl yuklendi.kanal ustunde aktif etmek icin : .chanset #kanal +shorten"
}
package require Tcl 8.5
namespace eval isgd {
package require http
setudef flag shorten
bind pubm - "*" ::isgd::is_gd:pubm
bind msgm - "*" ::isgd::is_gd:msgm
proc is_gd:msgm {nick uhost hand text} {
::isgd::is_gd:main $nick $uhost $hand $nick $text
return 0
}
proc is_gd:pubm {nick uhost hand chan text} {
if {![channel get $chan shorten]} { return 0 }
::isgd::is_gd:main $nick $uhost $hand $chan $text
return 0
}
proc is_gd:main {nick uhost hand chan text} {
set veri [::isgd::check_txt $text]
#putlog "$nick -> $veri"
set isurl "http://is.gd/api.php?longurl=$veri"
set url [::http::geturl "$isurl" -timeout [expr {4*1000}]]
set data [split [::http::data $url] \n]
::http::cleanup $url
regexp {(.*)} $data "" output
set titleurl "http://$veri"
set turl [::http::geturl "$titleurl" -timeout [expr {4*1000}]]
set tdata [split [::http::data $turl] \n]
::http::cleanup $turl
regexp {<title>(.*?)</title>} $tdata "" title
if {![info exists title]} {
set title "bilgi yok.."
} elseif {[string match -nocase "error*" $output]} {
set output "hata oluştu..";}
lappend cikti $output {*}$title
puthelp "privmsg $chan :$nick -> $cikti"
return 0
}
proc check_txt {text} {
set t [stripcodes bcruag $text]
foreach _ [split $t] {
if {[regexp -nocase -- {http://([^\s]+)} $_ -> out] || \
[regexp -nocase -- {https://([^\s]+)} $_ -> out] || \
[regexp -nocase -- {ftp://([^\s]+)} $_ -> out] || \
[regexp -nocase -- {
Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir.
out]} {
return $out
}
}
}
putlog "ok..."
}