'************************************************* *******************************
'Function(公有)
'名稱： 遠端抓取函數
'作用： 利用XMLHTTP遠端抓取數據
'參數： sMethod --- 傳送方式
' sUrl ------ 目標位址
' iMode ----- 返回內容類型：0為二進制，1為文本，2為cookie，3為文件頭資訊
' sBase ----- 設定編碼
' sReferer -- 設定來源
' sCookie --- 設定cookie
' sLanguage - 設定語言
' sData ----- 設定要傳送的參數
' sContent -- 設定接收資料類型
' sAgent ---- 設定瀏覽器
' sEncoding - 設定gzip壓縮
' sAccept --- 設定文件類型
'************************************************* *******************************
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
'設定頁面來源
If sReferer<> Then
.SetRequestHeader Referer, sReferer
Else
.SetRequestHeader Referer, Split(sUrl, /)(2)
End If
If sCookie<> Then .SetRequestHeader Cookie, sCookie '設定Cookie
If sLanguage<> Then .SetRequestHeader Accept-Language, sLanguage '設定語言
If sData<> Then .SetRequestHeader Content-Length, Len(sData) '設定資料長度
If sContent<> Then .SetRequestHeader Content-Type, sContent '設定接受資料類型
If sAgent<> Then .SetRequestHeader User-Agent, sAgent '設定瀏覽器
If sEncoding<> Then .SetRequestHeader Accept-Encoding, sEncoding '設定gzip壓縮
If sAccept<> Then .SetRequestHeader Accept, sAccept '文件類型
.Send sData
'While .ReadyState <> 4
' .WaitForResponse 1000
'Wend
If .ReadyState<>4 Or .Status<>200 Then
SenFe_StealData = 無法取到資料！
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
'************************************************* *******************************
'作用： 編碼轉換
'參數： sBody - 要轉換的內容
' sCset - 編碼
'************************************************* *******************************
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