'================================================== '函數名：GetHttpPage '作 用：獲取網頁源碼 '參 數：HttpUrl ------網頁地址 '================================================== Function GetHttpPage(HttpUrl) If IsNull(HttpUrl)=True Or Len(HttpUrl)<18 Or HttpUrl="$False$" Then GetHttpPage="$False$" Exit Function End If Dim Http Set Http=server.createobject("MSX" & "ML2.XM" & "LHT" & "TP") Http.open "GET",HttpUrl,False Http.Send() If Http.Readystate<>4 then Set Http=Nothing GetHttpPage="$False$" Exit function End if GetHTTPPage=bytesToBSTR(Http.responseBody,"GB2312") GetHTTPPage=replace(replace(GetHTTPPage , vbCr,""),vbLf,"") Set Http=Nothing If Err.number<>0 then Err.Clear End If End Function
'================================================== '函數名：BytesToBstr '作 用：將獲取的源碼轉換為中文 '參 數：Body ------要轉換的變量 '參 數：Cset ------要轉換的類型 '================================================== Function BytesToBstr(Body,Cset) Dim Objstream Set Objstream = Server.CreateObject("ad" & "odb.str" & "eam") objstream.Type = 1 objstream.Mode =3 objstream.Open objstream.Write body objstream.Position = 0 objstream.Type = 2 objstream.Charset = Cset BytesToBstr = objstream.ReadText objstream.Close set objstream = nothing End Function
'================================================== '函數名：PostHttpPage '作 用：登錄 '================================================== Function PostHttpPage(RefererUrl,PostUrl,PostData) Dim xmlHttp Dim RetStr Set xmlHttp = CreateObject("Msx" & "ml2.XM" & "LHT" & "TP") xmlHttp.Open "POST", PostUrl, False XmlHTTP.setRequestHeader "Content-Length",Len(PostData) xmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" xmlHttp.setRequestHeader "Referer", RefererUrl xmlHttp.Send PostData If Err.Number <> 0 Then Set xmlHttp=Nothing PostHttpPage = "$False$" Exit Function End If PostHttpPage=bytesToBSTR(xmlHttp.responseBody,"GB2312") Set xmlHttp = nothing End Function
'================================================== '函數名：UrlEncoding '作 用：轉換編碼 '================================================== Function UrlEncoding(DataStr) Dim StrReturn,Si,ThisChr,InnerCode,Hight8,Low8 StrReturn = "" For Si = 1 To Len(DataStr) ThisChr = Mid(DataStr,Si,1) If Abs(Asc(ThisChr)) < &HFF Then StrReturn = StrReturn & ThisChr Else InnerCode = Asc(ThisChr) If InnerCode < 0 Then InnerCode = InnerCode + &H10000 End If Hight8 = (InnerCode And &HFF00)/ &HFF Low8 = InnerCode And &HFF StrReturn = StrReturn & "%" & Hex(Hight8) & "%" & Hex(Low8) End If Next UrlEncoding = StrReturn End Function
