Remote Get class ASP XmlHttp

Editor's note: This class is primarily used to manipulate XMLHTTP in ASP.





The first is the class definition cls_asphttp.asp:



<%
''=================================================================
' Flying Remote Acquisition Class (Asphttp) 1.0.1 Bate1
"By the Pentium Heart
"' 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
'' ============================================
' Class module initialization
'' ============================================
Private Sub Class_Initialize ()
Oform = ""
Set oXML = Server.CreateObject ("MSXML2. ServerXMLHTTP ")
Set ados = Server.CreateObject ("ADODB.stream")
Slresolvetimeout = 20000 "" Resolves DNS name timeout, 20 seconds
Slconnecttimeout = 20000 ' Establish Winsock connection timeout, 20 seconds
Slsendtimeout = 30000 ' timeout for sending data, 30 seconds
Slreceivetimeout = 30000 ' To receive response timeout, 30 seconds
End Sub

'' ============================================
' Return version information
'' ============================================
Public Property Get Version
Version = "Flying Asphttp class 1.0.0"
End Property
'' ============================================
"Resolve timeout for DNS name
'' ============================================
Public Property Let Lresolvetimeout (Lngsize)
If IsNumeric (lngsize) Then
Slresolvetimeout = CLNG (lngsize)
End If
End Property
'' ============================================
' Establish timeout for Winsock connection
'' ============================================
Public Property Let Lconnecttimeout (Lngsize)
If IsNumeric (lngsize) Then
Slconnecttimeout = CLNG (lngsize)
End If
End Property
'' ============================================
"Timeout for sending data
'' ============================================
Public Property Let Lsendtimeout (Lngsize)
If IsNumeric (lngsize) Then
Slsendtimeout = CLNG (lngsize)
End If
End Property
'' ============================================
' To receive response timeout
'' ============================================
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
'' ============================================
' Send 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
'' ============================================
"Set up a data transfer pair!"
'' ============================================
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
'' ============================================
"Send data and retrieve remote data
'' ============================================
Public Function HttpGet ()
Dim Sreturn
With oXML
. settimeouts Slresolvetimeout,slconnecttimeout,slsendtimeout,slreceivetimeout
. Open Smethod,surl,false
If ssetcookie<> "" Then
. setRequestHeader "Cookie", Ssetcookie ' Set cookie
End If
If sreferer<> "" Then
. setRequestHeader "Referer", sreferer ' set page source
Else
. setRequestHeader "Referer", sURL
End If
If slanguage<> "" Then
. setRequestHeader "Accept-language", slanguage ' set language
End If
. setRequestHeader "Content-length", Len (sData) ' Set data length
If scontent<> "" Then
. setRequestHeader "Content-type", Scontent ' Set accept data type
End If
If sagent<> "" Then
. setRequestHeader "User-agent", Sagent ' Set browser
End If
If sencoding<> "" Then
. setRequestHeader "Accept-encoding", sencoding ' set gzip compression
End If
If saccept<> "" Then
. setRequestHeader "Accept", saccept ' document type
End If
. Send SData ' sends data
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
'' ============================================
"Processing binary data
'' ============================================
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
'' ============================================
' Class module logoff
'' ============================================
Private Sub Class_Terminate
Oform = ""
Set oXML = Nothing
Set ADOs = Nothing
End Sub
End Class
%>