前些日子公司需要大量读取dangdang.com商品数据并要下载图片到本地.
照例使用XMLhttp同步方式获取数据,可是由于网络不稳定,经常造成'死锁'状况,既send之后一直不返回服务器结果,也不出错.
被这个问题折磨了好久,最后才查到还有ServerXMLHTTP这个对象,看了介绍才知道它才是天生为了服务器端获取其他网站信息设计的.利用他的超时机制,问题轻松解决:D
参考:
下面付简单封装了ServerXMLHTTP的简单类,共参考:
<%
'
使用范例
'读取URL 的HTML
dim myHttp
set myHttp=new xhttp
myHttp.URL=" http://www.baidu.com "
Response.Write(myHttp.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"
myHttp.saveimage="myfile.gif"
'为防止xhttp卡死的情况,使用超时,错误处理
dim sHtmlcode,iStep
myHttp.URL=" http://www.hrbshopping.com "
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
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
'cset="UTF-8"
cset="GB2312"
sError=""
end sub
Private Sub Class_Terminate()
End Sub
Public Property LET URL(theurl)
sUrl=theurl
end property
end property
public property GET BasePath()
BasePath=mid(sUrl,1,InStrRev(sUrl,"/")-1)
end property
end property
public property GET FileName()
FileName=mid(sUrl,InStrRev(sUrl,"/")+1)
end property
end property
public property GET Html()
Html=BytesToBstr(getBody(sUrl))
end property
end property
public property GET xhttpError()
xhttpError=sError
end property
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
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
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
%>