3 package require TclCurl
5 proc ProgressCallback {dltotal dlnow ultotal ulnow} {
7 set dltotal [expr round($dltotal)]
8 set dlnow [expr round($dlnow)]
9 set ultotal [expr round($ultotal)]
10 set ulnow [expr round($ulnow)]
12 puts "Progress callback: $dltotal - $dlnow - $ultotal - $ulnow"
17 proc Perform {multiHandle} {
18 if {[catch {$multiHandle active} activeTransfers]} {
19 puts "Error checking active transfers: $activeTransfers"
23 if {[catch {$multiHandle perform} running]} {
24 puts "Error: $running"
30 proc Transfer {multiHandle easyHandle} {
32 set runningTransfers [Perform $multiHandle]
33 if {$runningTransfers>0} {
34 set eventId [after 200 "Transfer $multiHandle $easyHandle"]
36 puts "Were are done, cleaning up..."
37 $multiHandle removehandle $easyHandle
45 proc StartTransfer {} {
47 set curlEasyHandle [curl::init]
49 $curlEasyHandle configure -url "127.0.0.1/~andres/cosa&co.tar" \
50 -canceltransvarname cancel -progressproc ProgressCallback\
51 -file cosa.tar -noprogress 0
53 set curlMultiHandle [curl::multiinit]
54 $curlMultiHandle addhandle $curlEasyHandle
56 after 100 "Transfer $curlMultiHandle $curlEasyHandle"
61 proc StopTransfer {} {
64 puts "The download has been cancelled"
71 set start [button .start -text Start -command StartTransfer]
72 set stop [button .stop -text Stop -command StopTransfer]
74 pack $start $stop -side left -padx 10 -pady 10