As shown in the following example, data is obtained through XMLHTTP synchronization. However, due to unstable network conditions, 'deadlocks 'are often caused. This means that no server results are returned or errors occur after sending.
After suffering from this problem for a long time, I finally found the serverxmlhttp object. After reading the introduction, I realized that it was designed for the server to obtain other website information. using its timeout mechanism, the problem can be easily solved: d
Refer:
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
The following is a simple class that encapsulates serverxmlhttp. For details, refer:
<%
'Example
'Read the HTML of the URL
Dim myhttp
Set myhttp = new xhttp
Myhttp. url = "http://www.baidu.com"
Response.write(myhttp.html)
'Save the remote image to a local device
Myhttp. url = "http://www.baidu.com/img/logo.gif"
Myhttp. saveimage = "myfile.gif"
'To prevent xhttp from getting stuck, use timeout and error handling
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, faster Rev (Surl, "/")-1)
End Property
Public property get filename ()
Filename = mid (Surl, limit Rev (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
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 expires, 10000, expires, and 30000
'Lresolvetimeout = 5000 'specifies the DNS name resolution timeout time, which is 5 seconds.
'Lconnecttimeout = 5000 'timeout time for establishing a Winsock connection, 5 seconds
'Lsendtimeout = 100' the time-out for sending data, 5 seconds
'Lreceivetimeout = 5000 'timeout for receiving response, 5 seconds
'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
Set objstream = nothing
End Function
End Class
%>