API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jun 14th, 2019
182
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
TCL 25.34 KB | None | 0 0
raw download clone embed print report
  1. ######################################################
  2. # WindropClan @ http://windrop.clan.su
  3. # Автор: Vertigo
  4. # Версия: 2.1 (mod Vladislav)
  5. # Описание: Скрипт цитирует заголовок URL-ссылки, когда ее пишут в канал.
  6. #           Юзеры с флагом I (глобал) будут игнорироваться скриптом.
  7. # Команда: !ссылки
  8. ######################################################
  9.  
  10. namespace eval title {
  11.  
  12. # На фразы, начинающиеся с указанных символов не будет реакции:
  13. variable denyprefixes {"!" "$" "." "^"}
  14. # На указанные домены будет осуществляться автореагирование (помимо http://):
  15. variable domains      {".ru" ".com" ".org" ".su" ".info" ".net" ".de" ".au" ".ua"}
  16. # [1/0] Разрешить реагирование на текст, содержащий только домены (без http://):
  17. variable nodomains    0
  18. # Максимальное число редиректов:
  19. variable maxredirects 5
  20. # Таймут соединения (в секундах):
  21. variable timeout      10
  22. # Сколько байт скачивать при запросе (актуально, если сервер поддерживает Accept-Range):
  23. variable readlimit    11564
  24. # Юзер-агент:
  25. variable useragent    {Opera/9.52 (Windows NT 5.1; U; en)}
  26. # [1/0] Включить отладку:
  27. variable debug        0
  28. # Шаблон вывода сообщения в канал:
  29. variable deftemplate  {\037Заголовок\037:}
  30. # Защита от флуда (в секундах):
  31. variable flood        5
  32. # Канальный флаг, разрешающий/запрещающий работу скрипта:
  33. variable flagactas    "no"
  34. variable chflag       "$flagactas[namespace tail [namespace current]]"
  35. setudef  flag         $chflag
  36.  
  37. if {![catch {package require tls} err]} {::http::register https 443 ::tls::socket; variable using_ssl 1} else {variable using_ssl 0}
  38. variable redir        0
  39. variable clock        0
  40. variable template     ""
  41.  
  42. bind pubm -    *     ::title::pub
  43. bind ctcp - "ACTION" ::title::actn
  44.  
  45. if {[info exists sp_version]} {set ::max_tcl_events 20; set ::select_timeout 100}
  46.  
  47. proc pub {nick uhost hand chan text} {
  48. variable chflag ; variable flagactas
  49. if {![channel get $chan $chflag] ^ $flagactas eq "no" } {return}
  50. if {[info exists ::vktitle::clock] && ([string match -nocase "*http://vk.com*" $text] || [string match -nocase "*https://vk.com*" $text] || [string match -nocase "*.vk.com*" $text] || [string match -nocase "*http://vkontakte.ru*" $text] || [string match -nocase "*https://vkontakte.ru*" $text] || [string match -nocase "*.vkontakte.ru*" $text])} {return}
  51. if {[info exists ::youtubetitle::clock] && ([string match -nocase "*http://*youtube*watch*" $text] || [string match -nocase "*https://*youtube*watch*" $text] || [string match -nocase "*http://youtu.be/?*" $text] || [string match -nocase "*https://youtu.be/?*" $text])} {return}
  52. if {[info exists ::bash::clock] && [string match -nocase "*http://bash.im/quote/*" $text]} {return}
  53. ::title::main $nick $uhost $hand $chan $text; return
  54. }
  55.  
  56. proc actn {nick uhost hand chan key text} {
  57. variable chflag ; variable flagactas
  58. if {[string match "*#*" $chan]} { if {![channel get $chan $chflag] ^ $flagactas eq "no"} {return} }
  59. ::title::main $nick $uhost $hand $chan $text; return
  60. }
  61.  
  62. proc nodomain {text} {
  63. variable domains
  64. foreach _ $domains { if {![string match "*$_*" "$text"]} {continue}; if {[string match "*$_*" "$text"]} {return 0} }; return 1
  65. }
  66.  
  67. proc main {nick uhost hand chan text} {
  68. if {[matchattr $hand I]} {return}
  69. variable denyprefixes; variable using_ssl; variable debug; variable nodomains
  70. set text [string trim [string map { "" \[ "" \] "" \{ "" \} "" ( "" ) "" \" "" ' "" > "" < ""} [stripcodes bcruag $text]]]
  71. foreach _ $denyprefixes { if {[string index $text 0] eq $_} {if {$debug} {putlog "::title:: \[main\] Found denied prefix. Not responding."}; return} }
  72. if {![string match "*http://*" $text] && ![string match "*https://*" $text] && ![string match "*www.*" $text] && ![string match "*wap.*" $text] && [nodomain $text]} {if {$debug} {putlog "::title:: \[main\] Links not found."}; return}
  73. variable flood; variable clock
  74. if {[expr [clock seconds]-$clock] < $flood} {return}; set clock [clock seconds]
  75. set i 0; set urls [list]; foreach _ [split $text] {
  76. if {$i > 1} {return}
  77. if {[regexp -nocase -- {^(http://.+?)$} $_ -> url] || [regexp -nocase -- {^(www.*?|wap.*?)$} $_ -> url]} { if {[lsearch -exact -nocase $urls $url] == -1} {incr i; lappend urls $url; request $url $nick $uhost $chan} }
  78. if {$using_ssl && [regexp -nocase -- {^(https://.+?)$} $_ -> url]} { if {[lsearch -exact -nocase $urls $url] == -1} {incr i; lappend urls $url; request $url $nick $uhost $chan} }
  79. if {![regexp -nocase -- {^(http://.+?)$} [lindex $_ 0]] && $nodomains} { if {![nodomain [lindex $_ 0]]} { if {[lsearch -exact -nocase $urls "http://[lindex $_ 0]"] == -1} {incr i; lappend urls "http://[lindex $_ 0]"; request "http:\/\/[lindex $_ 0]" $nick $uhost $chan} } }
  80. }
  81. }
  82.  
  83. proc request {url nick uhost chan} {
  84. variable useragent; variable debug; variable timeout; variable readlimit
  85. if {[string range $url 0 7] eq "http://-"} {set url "http://[string range [string trim $url "-"] 8 end]"}
  86. if {![regexp -nocase -- {^(https://.+?)$} $url] && [string range $url 0 6] ne "http://"} {set url "http://$url"}
  87. set extra [list $nick $uhost $chan $url]
  88. if {[regexp -nocase -- {^http://[а-яё]{1}.+?\.?} $url] || [regexp -nocase -- {^http://www.[а-яё]{1}.+?\.?} $url]} {
  89. regsub -all -nocase -- {^http://([а-яё]{1}.+?\.?)(/)} [string map [list \[ \\\[ \] \\\] \{ \\\{ \} \\\} \$ \\\$ \\ \\\\] $url] "http://\[::ccs::idna::encode \[encoding convertto utf-8 \\1\]\]\\2" url; set url [subst -novar $url]
  90. regsub -all -nocase -- {^http://([а-яё]{1}.+?\.?)$} [string map [list \[ \\\[ \] \\\] \{ \\\{ \} \\\} \$ \\\$ \\ \\\\] $url] "http://\[::ccs::idna::encode \[encoding convertto utf-8 \\1\]\]" url; set url [subst -novar $url]
  91. regsub -all -nocase -- {^http://www.([а-яё]{1}.+?\.?)(/)} [string map [list \[ \\\[ \] \\\] \{ \\\{ \} \\\} \$ \\\$ \\ \\\\] $url] "http://\[::ccs::idna::encode \[encoding convertto utf-8 \\1\]\]\\2" url; set url [subst -novar $url]
  92. regsub -all -nocase -- {^http://www.([а-яё]{1}.+?\.?)$} [string map [list \[ \\\[ \] \\\] \{ \\\{ \} \\\} \$ \\\$ \\ \\\\] $url] "http://\[::ccs::idna::encode \[encoding convertto utf-8 \\1\]\]" url; set url [subst -novar $url]
  93. }
  94. ::http::config -useragent $useragent
  95. if {$debug} {putlog "::title \[request\] Extra: $extra."}
  96. if {[catch {set token [::http::geturl $url -binary 1 -timeout [expr $timeout*1000] -headers [list "Range" "bytes=0-$readlimit"] -command [list [namespace current]::data $extra]]} err]} {return}
  97. }
  98.  
  99. proc data {extra token} {
  100. variable maxredirects; variable deftemplate; variable debug;
  101. variable redir; variable maxredirects; variable using_ssl; variable template
  102. set status [::http::status $token]
  103. set ncode [::http::ncode $token]
  104. array set meta [::http::meta $token]
  105. if {$debug} {putlog "::title:: \[data\] status: $status\; metacode: $ncode\."}
  106. if {![info exists meta(Content-Length)]} {set Size "размер неизвестен"} else {set Size [fsize $meta(Content-Length)]}
  107. if {[info exists meta(Content-Range)]} { if {[regexp -nocase -- {bytes.*?\/(.+?)$} $meta(Content-Range) -> Size]} {set Size [fsize $Size]} else {set Size ""} }
  108. if {[info exists meta(Content-Type)]} {set Type $meta(Content-Type)} else {set Type "неизвестен"}
  109. if {$Size eq "размер неизвестен" && $Type eq "неизвестен"} {::http::cleanup $token; return}
  110. set nick [lindex $extra 0]; set uhost [lindex $extra 1]; set chan [lindex $extra 2]; set url [lindex $extra 3]
  111. set tempurl [regsub -nocase -- "http.*://" $url ""]
  112. set query [join [lindex [split $tempurl "/"] 0] "/"]
  113. set get [join [lrange $tempurl 1 end] "/"]
  114. if {[info exists meta(Location)]} {
  115. if {$debug} {putlog "::title:: \[data\] query: $query\; get: $get"}
  116. set simb "/"
  117. if {![string match "*http://*" $meta(Location)] && [string range $meta(Location) 0 0] == "/"} { set link "http://$host$meta(Location)"}
  118. if {![string match "*http://*" $meta(Location)] && ![string match "*https://*" $meta(Location)] && [string range $meta(Location) 0 0] != "/"} { set link "http://$query$simb$meta(Location)"}
  119. if {[string match "http://*" $meta(Location)]} {set link $meta(Location)}
  120. if {![string match "*https://*" $meta(Location)] && ![info exists link] && $using_ssl == 1} {set link "https://$query$simb$meta(Location)"}
  121. if {[string match "*https://*" $meta(Location)] && $using_ssl == 1} {set link $meta(Location)}
  122. if {$meta(Location) != "" && [string match "*domain=*" [::http::meta $token]] && ![string match "http*" $meta(Location)]} {set link "http://[lindex [split http://$query "/"] 2]$simb$meta(Location)"}
  123. if {($ncode eq "301" || $ncode eq "302") && $status eq "ok"} {
  124. if {$debug} {putlog "::title:: \[data\] redirect detected."}
  125. incr redir
  126. if {$debug} {putlog "::title:: \[data\] Redirect \#$redir."}
  127. if {$redir >= $maxredirects} {if {$debug} {putlog "::title:: \[data\] Max. redirects reached. Stopping."}; set redir 0; return}
  128. set url $link
  129. ::http::cleanup $token
  130. ::title::request $url $nick $uhost $chan
  131. }
  132. } else {
  133. if {$debug} {putlog "::title:: \[data\] Data received. Processing..."}
  134. catch {array unset meta; unset -nocomplain meta}
  135. set html [::http::data $token]; set meta [::http::meta $token]; ::http::cleanup $token; append meta $html
  136. if {![regexp -nocase -- {charset=(.+?)\"} $meta -> charset]} {set charset ""}
  137. unset -nocomplain meta
  138. if {[string length $html] < 5000 && [regexp -nocase -- {<meta http-equiv="refresh" content=".*URL=(.+?)".*</head>} $html -> redirr]} {
  139. regsub -all -- {\"\>} $redirr {} redirr; set simb "/"
  140. if {![string match "*http://*" $redirr] && [string index $redirr 0] != "/"} {set redirr "http://$query$simb[lindex [split $get "/"] 0]$simb$redirr"}
  141. if {![string match "*http://*" $redirr] && [string index $redirr 0] == "/"} {set redirr "http://$query$redirr"}
  142. ::title::request $redirr $nick $uhost $chan
  143. if {$debug} {putlog "::title:: \[data\] meta-refresh redirect detected. URL: $redirr"}
  144. return
  145. }
  146. switch -glob -- [string range $html 0 19] {
  147. "GIF8*" {set title [gif_dimensions $html]; set sh_size 1}
  148. "\x89PNG\r\n\x1a\n*" {set title [png_dimensions $html]; set sh_size 1}
  149. "\xFF\xD8\xFF*" {set title [jpeg_dimensions $html]; set sh_size 1}
  150. "BM*" {set title [bmp_dimensions $html]; set sh_size 1}
  151. default {set title [::title::decode $html $charset]; set template $deftemplate; set sh_size 0}
  152. }
  153. set bayan [tpoisk $url]
  154. if {$bayan == 0 || [string equal -nocase [lindex $bayan 1] $nick]} {set msgbayan1 ""; set msgbayan2 ""; tsave $url $nick} else {set msgbayan1 "\[:\]||||\[:\]-"; set msgbayan2 " $::gcolor(14)([lindex $bayan 1] [clock format [lindex $bayan 2] -format "%d.%m.%Y"], [expr 1+[lindex $bayan 3]]-й раз)"; tsave $url $nick}
  155. if {$title ne ""} {
  156. if {[string length $title] > 250} {set title "[string range $title 0 250]..."}
  157. if {$sh_size} {append title " $::gcolor(5)@\017 $Size"}
  158. putserv "PRIVMSG $chan :$::gcolor(14)^-$msgbayan1[subst $template]\017 $title$msgbayan2"
  159. variable redir
  160. set redir 0
  161. } else {putserv "PRIVMSG $chan :$::gcolor(14)^-$msgbayan1\037Файл\037:\017 $::gcolor(14)тип:\017 $Type $::gcolor(5)@\017 $Size$msgbayan2"; return}
  162. }
  163. }
  164.  
  165. proc bmp_dimensions {data} {
  166. variable template
  167. set template "\037Изображение\037:\017 $::gcolor(14)формат:\017 bmp $::gcolor(5)::\017"
  168. binary scan [string range $data 18 25] ii width height
  169. set ret [list $width $height]
  170. return "$::gcolor(14)разрешение:\017 [join $ret x] px."
  171. }
  172.  
  173. proc jpeg_dimensions {data} {
  174. variable template
  175. set template "\037Изображение\037:\017 $::gcolor(14)формат:\017 jpeg $::gcolor(5)::\017"
  176. set ret [list]
  177. set i 2
  178. while {[string index $data $i] eq "\xFF"} {
  179. binary scan [string range $data [incr i] [expr $i+2]] H2S type len
  180. incr i 3
  181. set len [expr {$len & 0x0000FFFF}]
  182. incr len -2
  183. if {[string match {c[0-3]} $type]} {set p $i; break}
  184. incr i $len
  185. }
  186. if {[info exists p]} {binary scan [string range $data $p [expr $p+4]] cSS precision height width; set ret [list $width $height]}
  187. return "$::gcolor(14)разрешение:\017 [join $ret x] px."
  188. }
  189.            
  190. proc png_dimensions {data} {
  191. variable template
  192. set template "\037Изображение\037:\017 $::gcolor(14)формат:\017 png $::gcolor(5)::\017"
  193. set ret [list]
  194. set i 0
  195. binary scan [string range $data [incr i 8] [expr $i+7]] Ia4 len type
  196. set r [string range $data [incr i 8] [expr $i+$len]]
  197. if {$i < [string length $data] && $type eq "IHDR"} {
  198. binary scan $r II width height
  199. set ret [list $width $height]
  200. }
  201. return "$::gcolor(14)разрешение:\017 [join $ret x] px."
  202. }
  203.        
  204. proc gif_dimensions {data} {
  205. variable template
  206. set template "\037Изображение\037:\017 $::gcolor(14)формат:\017 gif $::gcolor(5)::\017"
  207. set sig [string range $data 0 3]
  208. set ret [list]
  209. binary scan [string range $data 6 7] s wid
  210. binary scan [string range $data 8 9] s hgt
  211. set ret [list $wid $hgt]
  212. return "$::gcolor(14)разрешение:\017 [join $ret x] px."
  213. }
  214.  
  215. proc decode {data charset} {
  216. variable debug
  217.         regsub -all -- {[\x5C\x27\x2F\x3E\x3C\x22\x5F\x7B\x5D\x7D\x5B]+} $charset "" charset
  218.         set charset [string trim $charset]
  219.         regsub -all -nocase "fc|!.*" $charset "" charset
  220.         set charset [string trim [string tolower $charset] \x5D\x7D\x7B\x5B\x3C\x3E\x22\x27]
  221.         set charset [lindex [split $charset] 0]
  222.         if {$charset == "" || $charset == "windows-1251" || $charset == "no"} {set charset cp1251}
  223.         set charset0 ""
  224.         set charset [string map {"win-" "cp" "windows-" "cp" "iso-" "iso" "cp-" "cp" "utf8" "utf-8"} $charset]
  225.         if {[string is space [lsearch -all [encoding names] $charset]]} {if {$debug} {putlog "::title:: \[decode\] Encoding $charset was not found! Setting to default..."}; set charset [encoding system]}
  226.         if {[regexp -nocase -- {<title>(.+?)</title>} $data -> info]} {set info [string trim $info]} else {set info ""}
  227.         if {$info == ""} { if {[regexp -nocase -- {<title.*>(.+?)</title>} $data -> info]} {set info [string trim $info]} else {set info ""} }
  228.         if {$info == "" && [string match "*card*" $data]} { if {[regexp -nocase -- {title="(.*?)"} $data -> info]} {set info [string trim $info]} else {set info ""} }
  229.         if {$info == "" && [string match "*meta name*" $data]} { if {[regexp -nocase -- {name="title" content="(.*?)"} $data -> info]} {set info [string trim $info]} else {set info ""} }
  230.         if {$debug} {putlog "::title:: \[decode\] Raw title: $info"}
  231.         regsub -all "\n|\r|\t" $info " " info
  232.         regsub -all {  } $info { } info
  233.         if {$data == {}} {if {$debug} {putlog "::title:: \[decode\] Data not present!"}; return ""}
  234.         if {$charset == {}} {set charset cp1251}
  235.         set info000 [encoding convertfrom [encoding system] $info]
  236.         set enc_need ""
  237.         if {[string match -nocase "*windows-1251*" $data] && ![regexp -nocase -- {[а-яА-ЯёЁ]} $data]} {set enc_need 1}
  238.         if {![regexp -- {[а-яА-ЯёЁ]} $info]} {set enc_need auto}
  239.         if {[string match "*\\\?\\\?\\\?*" $info] && ![string match "*charset=*" $data]} {set enc_need 2}
  240.         if {[string match "*Рµ*" $info] || [string match "*?*" $info] || ([string match "*?°*" $info] && ![string match "*-°?*" $info]) || [string match -nocase "<meta http-equiv*charset=utf-8" $data]} {set enc_need 3}
  241.         if {([string match -nocase "*koi8-r*" $data] && $enc_need != "3" && $charset != "cp1251") || ([string tolower $charset] == "koi8-r" && $enc_need != "3")} {set enc_need 2}
  242.         if {[string range $info000 1 4] ==[string toupper [string range info000 1 4]] && [regexp -- {[А-Я]} $info]} {set enc_need 2}
  243.         if {[string match "*&#1072;*" $info]} {set enc_need "not_need"}
  244.         if { $info == "" } {return}
  245.         if {[string match "\\\?\\\?\\\?\\\?*" $info]} {set enc_need "auto"}
  246.         if {$debug} {putlog "::title:: \[decode\] Charset detected: $charset\; Encoding mode: $enc_need."}
  247.         switch -glob -- $enc_need {
  248.         "1" {set info [encoding convertfrom [encoding system] $info]}
  249.         "2" {set info [encoding convertfrom koi8-r $info]}
  250.         "3" {set info [encoding convertfrom utf-8 $info]}
  251.         "auto" {set info [encoding convertfrom $charset $info]}
  252.         default {set info [lindex $info]}
  253.         }
  254.         set debinfo [regsub -all -- {\x20|[^А-Яа-яёЁ]} $info ""]
  255.         if {[issmall [string range $debinfo 0 0]] && ![issmall [string range $debinfo 1 15]] && [regexp -- {[А-ЯЁ]} $debinfo] && $charset != "utf-8"} {set info [encoding convertfrom koi8-r [encoding convertto cp1251 $info]]}
  256.         set info [::title::webstrip $info]
  257.         if {![regexp -all -- {[а-яА-ЯёЁa-zA-Z]} $info]} {set info [encoding convertfrom [encoding system] $info]}
  258.         if {[string match "*Р°*СЂ*" $info] || [string match "*Р»*Рї*" $info]} {set info [encoding convertfrom utf-8 [encoding convertto [encoding system] $info]]}     
  259.         set enc_need 0
  260.         return $info
  261. }
  262.  
  263. proc issmall {{t ""}} {
  264. if {$t eq ""} {return 1}
  265. set a [regexp -all -- {[а-яё]} $t];
  266. set b [format %.1f [expr $a/[string length $t].0*100]]
  267. if {$b >=40} {return 1} else {return 0}
  268. }
  269.  
  270. proc regsub-eval {re string cmd} {return [subst [regsub -all $re [string map {\[ \\[ \] \\] \$ \\$ \\ \\\\} $string] "\[format %c \[$cmd\]\]"]]}
  271.  
  272. proc fsize {bytes} {
  273. if {![string is digit $bytes]} {error "value must be a valid digit, more then zero"}
  274. if {$bytes >=0 && $bytes < 1024} {return "$bytes byte\(s\)"
  275. } elseif {$bytes >= 1024 && $bytes < 1024000} {return "[format %.2f [expr $bytes /1024.0]] KB"
  276. } elseif {$bytes >= 1024e3 && $bytes < 1024e6} {return "[format %.2f [expr $bytes/1024.0/1024.0]] MB"
  277. } elseif {$bytes >= 1024e6 && $bytes < 1024e9} {return "[format %.2f [expr $bytes/1024.0/1024.0/1024.0]] GB"
  278. } elseif {$bytes >= 1024e9 && $bytes < 1024e12} {return "[format %.2f [expr $bytes/1024.0/1024.0/1024.0/1024.0/1024.0]] TB"
  279. } elseif {$bytes >= 1024e12 && $bytes < 1024e15} {return "[format %.2f [expr $bytes/1024.0/1024.0/1024.0/1024.0/1024.0/1024.0]] PB"
  280. } elseif {$bytes >= 1024e15 && $bytes < 1024e18} {return "[format %.2f [expr $bytes/1024.0/1024.0/1024.0/1024.0/1024.0/1024.0/1024.0]] EB"
  281. } elseif {$bytes >= 1024e18 && $bytes < 1024e21} {return "[format %.2f [expr $bytes/1024.0/1024.0/1024.0/1024.0/1024.0/1024.0/1024.0/1024.0]] ZB"
  282. } else {return "[format %.2f [expr $bytes/1024.0/1024.0/1024.0/1024.0/1024.0/1024.0/1024.0/1024.0/1024.0]] IB"
  283. }
  284. }
  285.  
  286. proc webstrip {t} {
  287. regsub -all -nocase -- {<.*?>(.*?)</.*?>} $t {\1} t
  288. regsub -all -nocase -- {<.*?>} $t {} t
  289. set t [string map -nocase {&#x202c; "" &#x202a; "" &rlm; "" &rln; "" &mdash; - &raquo; » &laquo; « &quot; \" &lt; < &gt; > &nbsp; " " &amp; & &copy; © &#169; © &bull; • &#183; - &sect; § &reg; ® \
  290.         &#8214;    || \
  291.         &#38;      &     &#91;      (     &#92;      /     &#93;      )      &#123;     (     &#125;     ) \
  292.         &#163;     Ј     &#168;     Ё     &#169;     ©     &#171;     «      &#173;     ­     &#174;     ® \
  293.         &#161;     Ў     &#191;     ї     &#180;     ґ     &#183;     ·      &#185;     №     &#187;     » \
  294.         &#188;     ј     &#189;     Ѕ     &#190;     ѕ     &#192;     А      &#193;     Б     &#194;     В \
  295.         &#195;     Г     &#196;     Д     &#197;     Е     &#198;     Ж      &#199;     З     &#200;     И \
  296.         &#201;     Й     &#202;     К     &#203;     Л     &#204;     М      &#205;     Н     &#206;     О \
  297.         &#207;     П     &#208;     Р     &#209;     С     &#210;     Т      &#211;     У     &#212;     Ф \
  298.         &#213;     Х     &#214;     Ц     &#215;     Ч     &#216;     Ш      &#217;     Щ     &#218;     Ъ \
  299.         &#219;     Ы     &#220;     Ь     &#221;     Э     &#222;     Ю      &#223;     Я     &#224;     а \
  300.         &#225;     б     &#226;     в     &#227;     г     &#228;     д      &#229;     е     &#230;     ж \
  301.         &#231;     з     &#232;     и     &#233;     й     &#234;     к      &#235;     л     &#236;     м \
  302.         &#237;     н     &#238;     о     &#239;     п     &#240;     р      &#241;     с     &#242;     т \
  303.         &#243;     у     &#244;     ф     &#245;     х     &#246;     ц      &#247;     ч     &#248;     ш \
  304.         &#249;     щ     &#250;     ъ     &#251;     ы     &#252;     ь      &#253;     э     &#254;     ю \
  305.         &#176;     °     &#8231;    ·     &#716;     .     &#363;     u      &#299;     i     &#712;     ' \
  306.         &#596;     o     &#618;     i     &apos;     '} $t]
  307. set t [string map -nocase {&iexcl;  \xA1  &curren;   \xA4  &cent;     \xA2  &pound;    \xA3   &yen;      \xA5  &brvbar;   \xA6 \
  308.         &sect;     \xA7  &uml;      \xA8  &copy;     \xA9  &ordf;     \xAA   &laquo;    \xAB  &not;      \xAC \
  309.         &shy;      \xAD  &reg;      \xAE  &macr;     \xAF  &deg;      \xB0   &plusmn;   \xB1  &sup2;     \xB2 \
  310.         &sup3;     \xB3  &acute;    \xB4  &micro;    \xB5  &para;     \xB6   &middot;   \xB7  &cedil;    \xB8 \
  311.         &sup1;     \xB9  &ordm;     \xBA  &raquo;    \xBB  &frac14;   \xBC   &frac12;   \xBD  &frac34;   \xBE \
  312.         &iquest;   \xBF  &times;    \xD7  &divide;   \xF7  &Agrave;   \xC0   &Aacute;   \xC1  &Acirc;    \xC2 \
  313.         &Atilde;   \xC3  &Auml;     \xC4  &Aring;    \xC5  &AElig;    \xC6   &Ccedil;   \xC7  &Egrave;   \xC8 \
  314.         &Eacute;   \xC9  &Ecirc;    \xCA  &Euml;     \xCB  &Igrave;   \xCC   &Iacute;   \xCD  &Icirc;    \xCE \
  315.         &Iuml;     \xCF  &ETH;      \xD0  &Ntilde;   \xD1  &Ograve;   \xD2   &Oacute;   \xD3  &Ocirc;    \xD4 \
  316.         &Otilde;   \xD5  &Ouml;     \xD6  &Oslash;   \xD8  &Ugrave;   \xD9   &Uacute;   \xDA  &Ucirc;    \xDB \
  317.         &Uuml;     \xDC  &Yacute;   \xDD  &THORN;    \xDE  &szlig;    \xDF   &agrave;   \xE0  &aacute;   \xE1 \
  318.         &acirc;    \xE2  &atilde;   \xE3  &auml;     \xE4  &aring;    \xE5   &aelig;    \xE6  &ccedil;   \xE7 \
  319.         &egrave;   \xE8  &eacute;   \xE9  &ecirc;    \xEA  &euml;     \xEB   &igrave;   \xEC  &iacute;   \xED \
  320.         &icirc;    \xEE  &iuml;     \xEF  &eth;      \xF0  &ntilde;   \xF1   &ograve;   \xF2  &oacute;   \xF3 \
  321.         &ocirc;    \xF4  &otilde;   \xF5  &ouml;     \xF6  &oslash;   \xF8   &ugrave;   \xF9  &uacute;   \xFA \
  322.         &ucirc;    \xFB  &uuml;     \xFC  &yacute;   \xFD  &thorn;    \xFE   &yuml;     \xFF} $t]
  323. set t [::title::regsub-eval {&#([0-9]{1,5});} $t {string trimleft \1 "0"}]
  324. regsub -all {\s+} $t " " t
  325. return $t
  326. }
  327.  
  328. # Сохранение ссылок:
  329. variable file "data/title.dat"
  330.  
  331. proc treads {} {
  332. variable file
  333. if {![file exists $file]} {set f [open $file w+]; close $f}
  334. set f [open $file r]; set data [lrange [split [read $f] \n] 0 end-1]; close $f
  335. return $data
  336. }
  337.  
  338. proc tsave {url nick} {
  339. variable file
  340. set data [treads]; set url [string trim $url "/"]
  341. if {[set num [lsearch -index 0 -exact -noc $data $url]] != -1} {
  342. set stat [lindex $data $num]; set num2 [expr [lindex $stat 3]+1]; set stat [lreplace $stat 3 3 $num2]
  343. set data [lreplace $data $num $num $stat]; set f [open $file w+]; foreach line $data { puts $f $line }; close $f
  344. } else { set f [open $file a+]; puts $f [list $url $nick [unixtime] 1]; close $f }
  345. }
  346.  
  347. proc tpoisk {url} {
  348. set data [treads]; set url [string trim $url "/"]
  349. set info ""; foreach line $data { if {[string equal -nocase [lindex $line 0] $url]} {set info $line; break} }
  350. if {$info != ""} {return $info} else {return 0}
  351. }
  352.  
  353. # Вывод ссылок на pastebin:
  354. variable urltimer 20
  355. variable urlclock 0
  356.  
  357. foreach bind {ссылка ссылки} {bind pub - $::gprefix(1)$bind [namespace current]::urlpub; bind msg - $::gprefix(1)$bind [namespace current]::urlmsg}
  358.  
  359. proc urlmsg {nick host hand text} {urlpub $nick $host $hand $nick $text; return}
  360.  
  361. proc urlpub {nick host hand chan text} {
  362. variable urltimer; variable urlclock
  363. if {$chan != $nick && [channel get $chan no[namespace tail [namespace current]]]} {return} else {set text [lindex [split [string trim [string map { {}} [stripcodes cubr $text]]]] 0]}
  364. if {[expr [clock seconds]-$urlclock] < $urltimer} {putserv "[expr {$nick == $chan ? "PRIVMSG":"NOTICE"}] $nick :Команда недавно запрашивалась. Повтори попытку через [expr $urltimer-([clock seconds]-$urlclock)] сек."; return}; set urlclock [clock seconds]
  365. set data [treads]; if {[llength $data] == 0} {putserv "[expr {$nick == $chan ? "PRIVMSG":"NOTICE"}] $nick :В базе нет ссылок!"; return} else {
  366. if {[string is space $text]} {set data [lrange [lreverse $data] 0 99]} else {
  367. set ndata [list]; foreach _ $data { if {[string equal -nocase [lindex $_ 1] $text]} {lappend ndata $_} }; set data $ndata; if {[llength $data] == 0} {putserv "[expr {$nick == $chan ? "PRIVMSG":"NOTICE"}] $nick :В базе нет ссылок от $text!"; return} else {set data [lrange [lreverse $data] 0 99]}
  368. }
  369. }
  370. set ndata ""; foreach _ $data {append ndata "[lindex $_ 0] <- [lindex $_ 1] ([clock format [lindex $_ 2] -format "%d.%m.%Y в %H:%M"])\n"}; set data $ndata
  371. ::http::config -urlencoding utf-8 -useragent "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 2.0.50727; .NET CLR 3.0.04506.30)"
  372. set tok [::http::geturl "http://pastebin.com/api/api_post.php" -query [http::formatQuery api_dev_key 3c297476dcac3461208c96a18fdf28a3 api_paste_format text api_option paste api_paste_expire_date 1D api_paste_name "Urls $::botnick" api_paste_code $data] -timeout 20000]; set adres [::http::data $tok]; ::http::cleanup $tok
  373. if {[string match -nocase "*post limit, maximum pastes*" $adres]} {putserv "[expr {$nick == $chan ? "PRIVMSG":"NOTICE"}] $nick :Достигнут лимит, попробуйте завтра!"} else {putserv "PRIVMSG $chan :$::gcolor(14)Последние ссылки: $::gcolor(12)$adres"}
  374. }
  375.  
  376. }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!