学步园

http://school.oicp.cn/html/view/195/

前些日子公司需要大量读取dangdang.com商品数据并要下载图片到本地.

照例使用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.hrbshopping.com"

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

 

%>