远程获取类Asp xmlHttp2009-12-12 asp.org.cn 编者注：这个class主要用于操作asp中的xmlhttp。首先是类定义 Cls_AspHttp.asp：<% ""================================================================= ""飞扬远程获取类（AspHttp） 1.0.1 Bate1 "" By 奔腾的心 "" 2006-04-19 ""================================================================= Class FlyCms_AspHttp Public oForm,oXml,Ados Public strHeaders Public sMethod Public sUrl Public sReferer Public sSetCookie Public sLanguage Public sCONTENT Public sAgent Public sEncoding Public sAccept Public sData Public sCodeBase Private slresolveTimeout,slconnectTimeout,slsendTimeout,slreceiveTimeout "" ============================================ "" 类模块初始化 "" ============================================ Private Sub Class_Initialize（） oForm = "" Set oXml = Server.CreateObject（"MSXML2.ServerXMLHTTP"） set Ados = Server.CreateObject（"Adodb.Stream"） slresolveTimeout = 20000 "" 解析DNS名字的超时时间,20秒 slconnectTimeout = 20000 "" 建立Winsock连接的超时时间,20秒 slsendTimeout = 30000 "" 发送数据的超时时间,30秒 slreceiveTimeout = 30000 "" 接收response的超时时间,30秒 End Sub
"" ============================================ "" 返回版本信息 "" ============================================ Public Property Get Version Version = "飞扬asphttp类1.0.0" End Property "" ============================================ "" 解析DNS名字的超时时间 "" ============================================ Public Property Let lresolveTimeout（LngSize） If IsNumeric（LngSize） Then slresolveTimeout = Clng（LngSize） End If End Property "" ============================================ "" 建立Winsock连接的超时时间 "" ============================================ Public Property Let lconnectTimeout（LngSize） If IsNumeric（LngSize） Then slconnectTimeout = Clng（LngSize） End If End Property "" ============================================ "" 发送数据的超时时间 "" ============================================ Public Property Let lsendTimeout（LngSize） If IsNumeric（LngSize） Then slsendTimeout = Clng（LngSize） End If End Property "" ============================================ "" 接收response的超时时间 "" ============================================ Public Property Let lreceiveTimeout（LngSize） If IsNumeric（LngSize） Then slreceiveTimeout = Clng（LngSize） End If End Property "" ============================================ "" Method "" ============================================ Public Property Let Method（strMethod） sMethod = strMethod End Property "" ============================================ "" 发送url "" ============================================ Public Property Let Url（strUrl） sUrl = strUrl End Property "" ============================================ "" Data "" ============================================ Public Property Let Data（strData） sData = strData End Property "" ============================================ "" Referer "" ============================================ Public Property Let Referer（strReferer） sReferer = strReferer End Property "" ============================================ "" SetCookie "" ============================================ Public Property Let SetCookie（strCookie） sSetCookie = strCookie End Property "" ============================================ "" Language "" ============================================ Public Property Let Language（strLanguage） sLanguage = strLanguage End Property "" ============================================ "" CONTENT-Type "" ============================================ Public Property Let CONTENT（strCONTENT） sCONTENT = strCONTENT End Property "" ============================================ "" User-Agent "" ============================================ Public Property Let Agent（strAgent） sAgent = strAgent End Property "" ============================================ "" Accept-Encoding "" ============================================ Public Property Let Encoding（strEncoding） sEncoding = strEncoding End Property "" ============================================ "" Accept "" ============================================ Public Property Let Accept（strAccept） sAccept = strAccept End Property "" ============================================ "" CodeBase "" ============================================ Public Property Let CodeBase（strCodeBase） sCodeBase = strCodeBase End Property "" ============================================ "" 建立数据传送对向！ "" ============================================ Public Function AddItem（Key, Value） On Error Resume Next Dim TempStr If oForm = "" Then oForm = Key + "=" + Server.URLEncode（Value） Else oForm = oForm + "&" + Key + "=" + Server.URLEncode（Value） End If End Function "" ============================================ "" 发送数据并取回远程数据 "" ============================================ Public Function HttpGet（） Dim sReturn With oXml .setTimeouts slresolveTimeout,slconnectTimeout,slsendTimeout,slreceiveTimeout .Open sMethod,sUrl,False If sSetCookie<>"" Then .setRequestHeader "Cookie", sSetCookie ""设定Cookie End If If sReferer<>"" Then .setRequestHeader "Referer", sReferer ""设定页面来源 Else .setRequestHeader "Referer", sUrl End If If sLanguage<>"" Then .setRequestHeader "Accept-Language", sLanguage ""设定语言 End If .setRequestHeader "Content-Length",Len（sData） ""设定数据长度 If sCONTENT<>"" Then .setRequestHeader "CONTENT-Type",sCONTENT ""设定接受数据类型 End If If sAgent<>"" Then .setRequestHeader "User-Agent", sAgent ""设定浏览器 End If If sEncoding<>"" Then .setRequestHeader "Accept-Encoding", sEncoding ""设定gzip压缩 End If If sAccept<>"" Then .setRequestHeader "Accept", sAccept ""文档类型 End If .Send sData ""发送数据 While .readyState <> 4 .waitForResponse 1000 Wend strHeaders = .getAllResponseHeaders（） If sCodeBase<>"" Then sReturn = bytes2BSTR（.responseBody） Else sReturn = .responseBody End If End With HttpGet = sReturn End Function "" ============================================ "" 处理二进制数据 "" ============================================ Private Function bytes2BSTR（vIn） strReturn = "" For i = 1 To LenB（vIn） ThisCharCode = AscB（MidB（vIn,i,1）） If ThisCharCode < &H80 Then strReturn = strReturn & Chr（ThisCharCode） Else NextCharCode = AscB（MidB（vIn,i+1,1）） strReturn = strReturn & Chr（CLng（ThisCharCode） * &H100 + CInt（NextCharCode）） i = i + 1 End If Next bytes2BSTR = strReturn End Function "" ============================================ "" 类模块注销 "" ============================================ Private Sub Class_Terminate oForm = "" Set oXml = Nothing Set Ados = Nothing End Sub End Class %>
易网时代-编程资源站