1. Hey Guest, are you looking for a place to host your IRC related project? Then check out the Resource Manager on IRCForums! Click the resources tab above this notice!
  2. Hello Guest, are you new to IRCForums? Why not introduce yourself in the introduction forum!
  3. We have updated the layout of our forums. Please see this thread for more information.
Resources Introduce yourself! Updates

[TCL] Images Tracker

Discussion in 'Script Gallery (Depreciated)' started by Nascimento, Jan 3, 2012.

  1. Nascimento
    Offline

    Nascimento Sports Chat

    Member Since:
    Dec 20, 2011
    Message Count:
    305
    Likes Received:
    53
    Trophy Points:
    86
    Quite a nice script, the following script stores (with no duplicates) .jpg/.jpe/.jpeg/.gif/.png/.bmp images posted by the users in your channel and generates a HTML file.

    I've also added a crontab script to update and upload it to our channel's website once a day.

    Code (tcl):

    set piccheck(version) "0.1"
    set filePath /home/eggdropusers/images.html
     
     
    bind pub - !plast urlshow
    proc urlshow {nick ushost hand chan text} {
    global filePath
    set file [open $filePath r]
    set data [read $file]
    close $file
    putlog [llength [split $data \n]]
    set plast [string map {<br> "" <b> "\002" </b> "\002" "<img src=\"" "\00312\037" "\">" "\037"} [lindex [split $data \n] [expr [llength [split $data \n]]-2]]]
    putserv "PRIVMSG $chan :Last picture: $plast"
    }
     
    bind pubm - * urlcheck
     
    setudef flag piccheck
     
    proc urlcheck { nick uhost hand chan str } {
    global piccheck
    set urlcheck(ext) {
    jpg
    jpe
    jpeg
    gif
    png
    bmp
    }
    if {![regexp {((?:[URL='http://|www\.)+[^']http://|www\.) [^[/URL] ]+)} $str str]} { return 0 }
    set extension ""
    set wlink $str
    regsub -all -- {([URL='http://)+}']http://) }[/URL] $str "" str
    regexp {([URL='http://www.)?[A-z|0-9|\-|\.|\_]*\.[A-z]{2,3}}']www.)?[A-z|0-9|\-|\.|\_]*\.[A-z]{2,3}}[/URL] $str host
    regexp {[/]+(.)*} $str url
    regexp {[A-z]{3,4}$} $str extension
    set ispic 0
    foreach i $urlcheck(ext) {
    if {[string match -nocase $extension $i]} {
    set ispic 1
    }
    }
    if {$ispic != 1} { return 0 }
    set linecheck "[getdata $host $url $chan]"
    putlog "-- $linecheck"
    set ispic 0
    if {[string match -nocase *error* $linecheck]} { putserv "PRIVMSG $chan :\002Error:\002 $linecheck. \002Not a picture.\002"; set ispic 1 }
    if {[string match -nocase "*<html>*" $linecheck]} { putserv "PRIVMSG $chan :\002Error:\002 $linecheck. \002Not a picture.\002"; set ispic 1 }
    #putlog $linecheck
    global filePath
    set file [open $filePath r]
    set data [read $file]
    close $file
    set already 0;
    foreach line [split $data \n] {
    if { [string match -nocase "*$wlink*" "$line"] == 1 } {
    catch {unset data}
    set already 1
    putserv "PRIVMSG $chan :\002$nick\002, your link already exists."
    }
    }
    if { $ispic == 0 && $already == 0 } {
    if {[catch {set file [open $filePath "a"]} err]} {
    putserv "PRIVMSG $chan :Error opening file: $err"
    }
    set systemTime [clock seconds]
    if {[catch {puts $file "<br><b>Added by $nick at [clock format $systemTime -format {%A, the %d of %B, %Y}]<b><br> \<img src=\"$wlink\"\><br>"} err]} {
    putserv "PRIVMSG $chan :Error appending file: $err"
    }
    close $file
    }
    }
     
    proc getdata { host url chan } {
    global sock
    if {[string match "*error*" [open_socket $host $url $chan]]} { return "error"}
    gets $sock line
    if {[string match -nocase "*HTTP/1.? 301 Moved*" $line]} {
    while {![eof $sock]} {
    gets $sock line
    if {[string match -nocase "*Location*" $line]} {
    set url [lindex [split $line] 1]
    regsub -all -- {([URL='http://)+}']http://) }[/URL] $url "" url
    regexp {[/]+(.)*} $url url
    close $sock
    open_socket $host $url $chan
    gets $sock line
    break
    }
    }
    }
    if {![string match "HTTP/1.? 200 OK" $line]} { close $sock;return "error($line)" }
    set msg ""
    while {(![eof $sock]) && ([string length $line] != 0)} {
    gets $sock line
     
    if {[string match -nocase *server* $line]} {regsub -all -- "Server" $line "\002Server\002" line; append msg $line }
    if {[string match -nocase *date* $line]} {regsub -all -- "Date" $line "\002Date\002" line; append msg ", " $line }
     
    if {[string match -nocase *content*type* $line]} {
    if {![string match -nocase "*image/*" "$line"]} {
    close $sock
    return error
    }
    regsub -all -- "Content-Type" $line "\002Content-Type\002" line; append msg ", " $line
    }
     
    if {[string match -nocase *content*length* $line]} {regsub -all -- "Content-Length" $line "\002Content-Length\002" line; append msg ", " $line }
    if {[string match -nocase *connection* $line]} {regsub -all -- "Connection" $line "\002Connection\002" line; append msg ", " $line }
    if {[string match -nocase *keep*alive* $line]} {regsub -all -- "Keep-Alive" $line "\002Keep-Alive\002" line; append msg ", " $line }
    if {[string match -nocase *expires* $line]} {regsub -all -- "Expires" $line "\002Expires\002" line; append msg ", " $line }
    if {[string match -nocase *cache*control* $line]} {regsub -all -- "Cache-Control" $line "\002Cache-Control\002" line; append msg ", " $line }
    if {[string match -nocase *accept*ranges* $line]} {regsub -all -- "Accept-Ranges" $line "\002Accept-Ranges\002" line; append msg ", " $line }
    }
    gets $sock line
    close $sock
    #putserv "PRIVMSG $chan :[string trim [join [append msg "."]] ", "]"
    return $line
    }
     
    proc open_socket { host url chan } {
    global sock
    #putlog "Host: $host - url : $url"
     
    if {[catch {set sock [socket [string map -nocase {www. ""} $host] 80] } sockerror]} {
    putserv "PRIVMSG $chan: \002Error:\002 $sockerror"
    return "error: $sockerror"
    } else {
    puts $sock "GET $url HTTP/1.1"
    puts $sock "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    puts $sock "Accept :*/*"
    puts $sock "Host: $host"
    puts $sock ""
    flush $sock
    }
    }
     
    putlog "Drilly's Picture-URL-Saver $piccheck(version) loaded..."
     
     
    Nascimento, Jan 3, 2012
    #1

Share This Page