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