MSXML2.ServerXMLHTTP使用实例

 

(2006-04-15 09:48:30)

转载▼

MSXML2.ServerXMLHTTP使用实例

• 作者：----
• 来源：网络
• 编辑：backer
• 时间：2006-04-05
• 类别：asp

• 第 1 页 一个实例
  

 

<%
'使用范例
'读取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."
sHtmlcode=myHttp.html
iStep=0
do while myHttp.xhttpError=""
 Response.Write("ERROR: AGAIN!<br />")
 sHtmlcode=myHttp.html
 iStep=iStep+1
 if iStep=1 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
%>