Rem 函数名：GetHttpPage
Rem 作 用：获取网页源码
Rem 参 数：HttpUrl ------网页地址
Rem ==================================================
Function GetHttpPage(HttpUrl)
If IsNull(HttpUrl)=True Or Len(HttpUrl)<18 Or HttpUrl="$Falsequot; Then
GetHttpPage="$Falsequot;
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="$Falsequot;
Exit function
End if
GetHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
Set Http=Nothing
If Err.number<>0 then
Err.Clear
End If
End Function
Rem ==================================================
Rem 函数名：BytesToBstr
Rem 作 用：将获取的源码转换为中文
Rem 参 数：Body ------要转换的变量
Rem 参 数：Cset ------要转换的类型
Rem ==================================================
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
Rem ==================================================
Rem 函数名：UrlEncoding
Rem 作 用：转换编码
Rem ==================================================
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
Rem ==================================================
Rem 函数名：GetBody
Rem 作 用：截取字符串
Rem 参 数：ConStr ------将要截取的字符串
Rem 参 数：StartStr ------开始字符串
Rem 参 数：OverStr ------结束字符串
Rem 参 数：IncluL ------是否包含StartStr
Rem 参 数：IncluR ------是否包含OverStr
Rem ==================================================
Function GetBody(ConStr,StartStr,OverStr,IncluL,IncluR)
If ConStr="$Falsequot; or ConStr="" or IsNull(ConStr)=True Or StartStr="" or IsNull(StartStr)=True Or OverStr="" or IsNull(OverStr)=True Then(责任编辑：admin) |