'************************************************ *******************************
'Function(public)
'Name: Remote fetch function
'Function: Use XMLHTTP to remotely capture data
'Parameters: sMethod --- sending method
' sUrl ------ target address
' iMode ----- Return content type: 0 is binary, 1 is text, 2 is cookie, 3 is file header information
' sBase ----- set encoding
' sReferer -- set source
' sCookie --- Set cookie
' sLanguage - Set language
' sData ----- Set the parameters to be sent
' sContent -- Set the receiving data type
' sAgent ---- set browser
' sEncoding - Set gzip compression
' sAccept --- Set document type
'************************************************ *******************************
Public Function SenFe_StealData(sMethod, sUrl, iMode, sBase, sReferer, sCookie, sLanguage, sData, sContent, sAgent, sEncoding, sAccept)
Dim oXmlHttp : Set oXmlHttp = Server.CreateObject(Msxml2.ServerXMLHTTP)
With oXmlHttp
If sMethod= Then sMethod = GET
.Open sMethod, sUrl, False
'Set page source
If sReferer<>Then
.SetRequestHeader Referer, sReferer
Else
.SetRequestHeader Referer, Split(sUrl, /)(2)
End If
If sCookie<> Then .SetRequestHeader Cookie, sCookie 'Set Cookie
If sLanguage<> Then .SetRequestHeader Accept-Language, sLanguage 'Set language
If sData<> Then .SetRequestHeader Content-Length, Len(sData) 'Set data length
If sContent<> Then .SetRequestHeader Content-Type, sContent 'Set the accepted data type
If sAgent<> Then .SetRequestHeader User-Agent, sAgent 'Set browser
If sEncoding<> Then .SetRequestHeader Accept-Encoding, sEncoding 'Set gzip compression
If sAccept<> Then .SetRequestHeader Accept, sAccept 'Document type
.Send sData
'While .ReadyState <> 4
' .WaitForResponse 1000
'Wend
If .ReadyState<>4 Or .Status<>200 Then
SenFe_StealData = Unable to retrieve data!
Exit Function
End If
Select Case iMode
Case 0 SenFe_StealData = .ResponseBody
Case 1
If sBase<>Then
SenFe_StealData = BytesToBstr(.ResponseBody, sBase)
Else
SenFe_StealData = .ResponseText
End If
Case 2 SenFe_StealData = .getResponseHeader(Set-Cookie)
Case Else SenFe_StealData = .getAllResponseHeaders()
End Select
End With
End Function
'************************************************ *******************************
'Function: encoding conversion
'Parameters: sBody - the content to be converted
' sCset - encoding
'************************************************ *******************************
Function BytesToBstr(sBody, sCset)
With oAdos
.Type = 1
.Mode = 3
.Open
.Write sBody
.Position = 0
.Type = 2
.Charset = sCset
BytesToBstr = .ReadText
.Close
End With
End Function