<%

‘==================================================

‘函数名：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(“MSXML2.XMLHTTP”)

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″)

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(“adodb.stream”)

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(“Msxml2.XMLHTTP”)

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

‘==================================================

‘函数名：GetBody

‘作 用：截取字符串

‘参 数：ConStr ——将要截取的字符串

‘参 数：StartStr ——开始字符串

‘参 数：OverStr ——结束字符串

‘参 数：IncluL ——是否包含StartStr

‘参 数：IncluR ——是否包含OverStr

‘==================================================

Function GetBody(ConStr,StartStr,OverStr,IncluL,IncluR)

If ConStr=”$False$” or ConStr=”" or IsNull(ConStr)=True Or StartStr=”" or IsNull(StartStr)=True Or OverStr=”" or IsNull(OverStr)=True Then

GetBody=”$False$”

Exit Function

End If

Dim ConStrTemp

Dim Start,Over

ConStrTemp=Lcase(ConStr)

StartStr=Lcase(StartStr)

OverStr=Lcase(OverStr)

Start = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare)

If Start<=0 then

GetBody=”$False$”

Exit Function

Else

If IncluL=False Then

Start=Start+LenB(StartStr)

End If

End If

Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare)