漫畫下載器....

最近學了tcl，而又想寫個大陸的漫畫網站的gg人，所以就決定用tcl+tk啦~
在今天大功告成，簡記幾個mistakes
分別是writing binary data, use ::http to get binary data with -channel specified, get http in background
##CONTINUE##

• Writing Binary Data: 平常都是使用 puts $channel "string" 寫入資料，但是當想寫入binary資料時，就必需要設定 fconfigure $channel -translation binary 來更正channel的設定


• http package: 其實想把http的data content寫到檔案中，也可以用set $channel [open ...]打開channel，然後使用 ::http::geturl $URL -channel $channel，將 content直接放到channel中。這個方法就不需要先改channel的translation了。


• fetch http in background: 基本上，一本漫畫都是近百頁的。如果一次抓一張，實在是.....有些慢。所以使用 ::http::geturl $URL -command Callbackfunction ，做到non-blocked http request with callback function。雖然每個檔案不是使用多分割下載，但是已經比之前好很多了。唯一的困難點在於參數的傳遞，因為callback function的參數是定死的。還好能從URL中parse圖片的名字。

附上目前的 source code

package require http
frame .n1
label .n1.filetosave -text "Save to:"
entry .n1.folder -textvariable folder
button .n1.openfolder -text "openfolder" -command setfolder
button .n1.rename -text "rename" -command rename
pack .n1.filetosave .n1.folder .n1.openfolder .n1.rename -side left
frame .n2
label .n2.folderurl -text "folderurl:"
entry .n2.url -textvariable url
button .n2.download -text "download" -command download
button .n2.stop -text "stop" -command stop
pack .n2.folderurl .n2.url .n2.download .n2.stop -side left
label .debug -text ""
label .state -text "Idle"
pack .state .n1 .n2 .debug -side top -fill both
set folder "comic_temp"
set serverno 2
set url "http://dm.99770.com/Comic/618/25601/?v=1*s=2"
set pagenumber 5
# =================================================================
# get http://dm.99770.com/Comic/618/25601/?v=1*s=2
# find pattern:
# 1. picurl=""
# 2. http://.....love.js
# get *love.js
# find pattern: ServerList[]
proc setfolder {} {
global folder
set tfolder [tk_chooseDirectory ]
if {$tfolder!= ""} {
set folder $tfolder
}
}
proc httpcallback { file token } {
# upvar #0 $token state
set fn [open $file w]
fconfigure $fn -translation binary
puts $fn [::http::data $token]
close $fn
}
proc wget { url { file "NULL"} } {
if {$file=="NULL"} {
return [::http::data [::http::geturl $url]]
} else {
::http::geturl $url -command [list httpcallback $file]
}
}
proc stop {} {
if {[.state cget -text]=="Downloading"} {
.state configure -text "Stop"
}
}
proc download {} {
global serverno ,pagenumber
set url [.n2.url get ]
set server ""

set fd [.n1.folder get]
if {[file exists $fd]==0} {
file mkdir $fd
}
cd $fd

.debug configure -text ""
.state configure -text "Downloading"
regexp {s=(\d+)} $url tmp serverno
set data [wget $url]
regexp {http[^>]*love.js} $data matched
debug [format "%s%s" "love js:" $matched]
set lovejs [wget $matched]
set i 0
while {\
[regexp -indices -line {^ServerList\[\d\]=[^;]*;} $lovejs index] } {
incr i
set tt [string range $lovejs [lindex $index 0] [lindex $index 1]]
if {$i==$serverno} {
regexp {http.*/} $tt server
debug [format "server: %s" $server]
}
set lovejs [string range $lovejs [lindex $index 1] end]
}

set index [expr [string last "/" $url]+1]
set baseurl [string replace $url $index end]
set i 1
while {1} {
if {[.state cget -text]=="Stop"} {
return
}
set url [format "%s%d.htm" $baseurl $i]
set data [wget $url]
regexp {picurl=\"([^;]*)\"} $data pic pic2
regexp {datas=([^;]*)} $data tmp pagenumber
set url [format "%s%s" $server $pic2]
set pic [lindex [split $pic2 "/"] end]
wget $url [format "%.3d%s" $i [string range $pic end-3 end]]
if {$i>=$pagenumber} {
break
}
incr i
}
.state configure -text "Complete"
cd ..
}

proc rename {} {
cd [.n1.folder get]
set i 1
foreach {f} [glob -nocomplain *] {
file rename $f [format "%.3d%s" $i [string range $f end-3 end]]
incr i
}
cd ..
}

proc debug { err } {
.debug configure -text [format "%s\n%s" [.debug cget -text] $err]
}