ASP中使用XMLHTTP或ServerXMLHTTP讀取遠端資料

照例使用xmlhttp同步方式擷取資料,可是由於網路不穩定,經常造成'死結'狀況,既send之後一直不返回伺服器結果,也不出錯.

被這個問題折磨了好久,最後才查到還有ServerxmlHTTP這個對象,看了介紹才知道它才是天生為了伺服器端擷取其他網站資訊設計的.利用他的逾時機制，問題輕鬆解決: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.baidu.com"
Response.Write(myHttp.html)

'儲存遠程圖片到本地
myHttp.URL="http://www.baidu.com/img/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!
")
sHtmlcode=myHttp.html
iStep=iStep+1
if iStep>100 then
Response.Write("ERROR:OVER!

")
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

 

'lresolveTimeout   =   5000       '   解析DNS名字的逾時時間,5秒  
'lconnectTimeout   =   5000         '   建立Winsock串連的逾時時間,5秒  
'lsendTimeout   =   5000           '   發送資料的逾時時間,5秒  
'lreceiveTimeout   =   5000           '   接收response的逾時時間,5秒  

'Set   xml   =   Server.CreateObject("MSXML2.ServerXMLHTTP")            
'xml.setTimeouts   lresolveTimeout,lconnectTimeout,lsendTimeout,lreceiveTimeout

 

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

%>