日期:2010-01-21  浏览次数:20869 次

'==================================================
'函数名: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"