Posted to tcl by Emiliano at Fri Nov 09 22:40:05 GMT 2007view pretty

package require Tk
package require http

#procedure callback to actualize the status of the downloads
proc showProgress {part_id token total actual} {
   global w part

   $w($part_id.progress) configure -value $actual
   $w($part_id.percent) configure -text \
        [format {%5.1f%%} [expr {double($actual)/$total*100}]]
}

#procedure callback when each connection finalize
proc finalize {tok} {
   global state part

   incr state(active) -1
   http::cleanup $tok
   if {$state(active) == 0} {
        set fd [open $state(targetFile) w]
        fconfigure $fd -translation binary -encoding binary
        for {set i 1} {$i <= $state(pieces)} {incr i} {
           seek $part($i.fd) 0
           fcopy $part($i.fd) $fd
           close $part($i.fd)
           file delete $part($i.filename)
        }
        close $fd
        exit
   }
}

#build the gui
proc gui {} {
   global w state part
   
   . configure -background \
        [ttk::style lookup $::ttk::currentTheme -background]
   for {set i 1} {$i <= $state(pieces)} {incr i} {
        set l [ttk::label .l_$i -text "Part $i:"]
        set w($i.progress) [ttk::progressbar .pbar_$i -maximum $part($i.size)]
        set w($i.percent) [ttk::label .p_$i -text "  0.0%"]
        grid $l $w($i.progress) $w($i.percent) -padx 3 -pady 3
        grid configure $w($i.progress) -sticky ew
   }
   set dest [ttk::label .dest -text "File downloaded in folder: [pwd]"]
   grid $dest - - -sticky ew
   grid columnconfigure . 1 -weight 1
}

# get the size of the file to download
proc getSize {} {
   global state
   set tok [http::geturl $state(url) -validate 1]
   set state(size) [set ${tok}(totalsize)]
   http::cleanup $tok
}

#main procedure
proc main {} {
   global state part

   set state(targetFile) [lindex [split $state(url) /] end]

   #the getSize proc may block the script, so first hide the main window
   wm state . withdrawn
   getSize
   
   set pSize [expr {$state(size)/$state(pieces)}]
   
   for {set i 1} {$i <= $state(pieces) } {incr i} {
        set from [expr { ($i-1) * $pSize }]
      set to   [expr { $i * $pSize - 1 }]
      if {$i == $state(pieces)} {
           set to [expr {$state(size) - 1}]
        }
        set part($i.size) [expr {$to - $from + 1}]

      set part($i.filename) $state(targetFile).part$i
      set part($i.fd) [open $part($i.filename) w+]
      fconfigure $part($i.fd) -translation binary -encoding binary
        set part($i.token) [http::geturl $state(url) \
           -binary 1 \
           -channel $part($i.fd) \
           -headers [list Range "bytes=$from-$to"] \
           -command finalize \
           -progress [list showProgress $i]]
   }

   if [catch {ttk::setTheme xpnative}] {ttk::setTheme clam}
   gui

   #now show the main window
   wm state . normal
   
   set state(active) $state(pieces)
}

#by default we split the file in 4 pieces
set state(pieces) 4

if {$argc < 1 || $argc > 2} {
   puts "Usage: $argv0 url \[pieces\]"
   exit
} else {
   set state(url) [lindex $argv 0]
   if {$argc == 2} {
        set state(pieces) [lindex $argv 1]
   }
}

if 0 {
   set state(url) http://ftp.netbsd.org/pub/NetBSD/misc/hubertf/netbsd-4.0RC3-i386pkg.iso
}

main