Fork me on GitHub

【tcl/tk】tcl实现http请求

package require "http"

proc errLog args {
    puts $args
}

proc SendHttp args {
    global token
    set toUrl [lindex $args 0]
    if {[catch {set token [::http::geturl $toUrl ]} errMsg]} {
        errLog "geturl error: $errMsg"
        return -code -1 "geturl error: $errMsg"
    }
    return "send OK"
}

proc RecvHttp args {
    global token
    ::http::wait $token

    set rStatus [::http::status $token]
    if {$rStatus == "timeout"} {
        errLog "RecvHttp Error: http connect timeout"
        ::http::cleanup $token
        return -code -1 "timeout"
    } elseif {$rStatus == "reset"} {
        errLog "RecvHttp Error: http connect reset"
        ::http::cleanup $token
        return -code -1 "reset"
    } elseif {$rStatus != "ok"} {
        errLog "RecvHttp Error: $rStatus"
        ::http::cleanup $token
        return -code -1 "$rStatus"
    }
    ##############process Responce###################
    set rSize [::http::size $token]
    set rBody [::http::data $token]
    ::http::cleanup $token

    errLog "receive message is [encoding convertfrom utf-8 $rBody]"
    return $rBody
}

set toUrl "http://www.baidu.com"
puts $toUrl
if {[catch {SendHttp $toUrl} errMsg]} {
    errLog "SendHttp error: $errMsg"
} else {
    catch {RecvHttp}
}

  

posted @ 2015-12-15 15:28  Mr.YF  阅读(1241)  评论(0编辑  收藏  举报