用MSXML2.ServerXMLHTTP的setTimeouts属性解决并死问题

照例使用XMLhttp同步方式获取数据,可是由于网络不稳定,经常造成'死锁'状况,既send之后一直不返回服务器结果,也不出错.

被这个问题折磨了好久,最后才查到还有ServerXMLHTTP这个对象,看了介绍才知道它才是天生为了服务器端获取其他网站信息设计的.利用他的超时机制setTimeouts，问题轻松解决:D

参考：

http://support.microsoft.com/kb/290761/zh-cn

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/xmlsdk/html/97884cf6-5fdf-4b1f-8273-73c0e098b8f3.asp

下面付简单封装了ServerXMLHTTP的简单类,共参考:

<％ 
'使用范例
'读取URL 的HTML
dim myHttp
set myHttp=new xhttp
myHttp.URL="http://www.aspxhome.com"
Response.Write(myHttp.html)
'保存远程图片到本地
myHttp.URL="https://www.aspxhome.com/images/logo.gif"
myHttp.saveimage="myfile.gif"
'为防止xhttp卡死的情况，使用超时，错误处理
dim sHtmlcode,iStep
myHttp.URL="http://www.acnow.net"
sHtmlcode=myHttp.html
do while myHttp.xhttpError=""
    Response.Error("ERROR: AGAIN!<br />")
    sHtmlcode=myHttp.html
    iStep=iStep+1
    if iStep>100 then
        Response.Write("ERROR:OVER!<hr />")
        exit do
    end if
loop
Response.Write(sHtmlcode)
set myHttp=nothing
'--------------------------------------------------------------------
Class xhttp
    private cset,sUrl,sError
    Private Sub Class_Initialize()
        'cset="UTF-8"
        cset="GB2312"
        sError=""
    end sub
    Private Sub Class_Terminate()
    End Sub
        Public Property LET URL(theurl)
                sUrl=theurl
        end property
        public property GET BasePath()
                BasePath=mid(sUrl,1,InStrRev(sUrl,"/")-1)
        end property
        public property GET FileName()
                FileName=mid(sUrl,InStrRev(sUrl,"/")+1)
        end property
        public property GET Html()
                Html=BytesToBstr(getBody(sUrl))
        end property
        
        public property GET xhttpError()
                xhttpError=sError
        end property
        
        private Function BytesToBstr(body)
                on error resume next
                'Cset:GB2312 UTF-8
                dim objstream 
                set objstream = Server.CreateObject("adodb.stream") 
                with objstream
                        .Type = 1 '
                        .Mode = 3 '
                        .Open     
                        .Write body  '
                        .Position = 0 '
                        .Type = 2  '
                        .Charset = Cset  '
                        BytesToBstr = .ReadText '
                        .Close 
                end with
                set objstream = nothing 
        End Function 
        
        private function getBody(surl)
                on error resume next
                dim xmlHttp
                'Set xmlHttp=server.createobject("Msxml2.XMLHTTP.4.0")
                'set xmlHttp=server.createobject("Microsoft.XMLHTTP")
                set xmlHttp=server.createobject("MSXML2.ServerXMLHTTP")
                xmlHttp.setTimeouts 10000,10000,10000,30000
                xmlHttp.open "GET",surl,false
                xmlHttp.send
                if xmlHttp.readystate=4 then 
                'if xmlHttp.status=200 then
                         getBody=xmlhttp.responsebody
                'end if
                         else
                getBody=""
                end if
        
                if Err.Number<>0 then 
                        sError=Err.Number
                        Err.clear
                else
                        sError=""
                end if
                set xmlHttp=nothing
        end function
        
        Public function saveimage(tofile)
                on error resume next
                dim objStream,imgs
                imgs=getBody(sUrl)
                Set objStream = Server.CreateObject("ADODB.Stream")
                with objStream
                        .Type =1
                        .Open
                        .write imgs
                        .SaveToFile server.mappath(tofile),2
                        .Close()
                end with
                set objstream=nothing
        end function
end class
 
％>