将XMLHTTP组件写成类方便获取网页代码

'//VBS利用XMLHTTP组件写成类 @CODE BY Broly
'//声明：代码仅作学习研究之用。使用前请三思而行，产生不良后果均与本人无关！
Class GetPage
  Private mstrUrl,xmlHttp,objstream
  Public Property Let Url(strUrl)
    mstrUrl=strUrl
  End Property
  Public Function GetUTFPage()
    If mstrUrl="" Then Exit Function 
    Set xmlHttp=CreateObject("MSXML2.XMLHTTP")
    xmlHttp.open "GET",mstrUrl,false
    xmlHttp.send()
    If xmlHttp.readystate<>4 then
    Exit Function
    End If
    GetUTFPage=xmlHttp.responseText
    Set xmlHttp=Nothing
    If err.number<>0 then err.Clear
  End Function
  Public Function GetGBKPage()
    If mstrUrl="" Then Exit Function
    Set xmlHttp=CreateObject("MSXML2.XMLHTTP")
    xmlHttp.open "GET",mstrUrl,false
    xmlHttp.send()
    If xmlHttp.readystate<>4 then
    Exit Function
    End If
    GetGBKPage=BytesToBSTR(xmlHttp.responseBody,"GB2312")
    Set xmlHttp=nothing
    If err.number<>0 then err.Clear
    End Function
   Private Function BytesToBstr(body,Cset)
    Set objstream =CreateObject("adodb.stream")
    With objstream
      .Type = 1
      .Mode = 3
      .Open
      .Write body
      .Position = 0
      .Type = 2
      .Charset = Cset
      BytesToBstr = .ReadText
      .Close
    End with
    Set objstream = nothing
  End Function

End Class

使用方法：

1.编写VBScript代码时，添加以上表格。（建议放在代码开头）

2.此类包含一个Url属性，两个方法GetGBKPage和GetUTFPage

  现在主流的网页编码有GBK和UTF

     方法 GetGBKPage 获取网页编码为GBK的网页代码

     方法 GetGBKPage 获取网页编码为GBK的网页代码

3.通过次类可以方便获取网页代码。

注：暂时支持这个简单的功能，更多的以后有时间会完善。

                                                            —— Broly

                                                               2011.1.24

例：

Class GetPage
  Private mstrUrl,xmlHttp,objstream
  Public Property Let Url(strUrl)
    mstrUrl=strUrl
  End Property
  Public Function GetUTFPage()
    If mstrUrl="" Then Exit Function 
    Set xmlHttp=CreateObject("MSXML2.XMLHTTP")
    xmlHttp.open "GET",mstrUrl,false
    xmlHttp.send()
    If xmlHttp.readystate<>4 then
    Exit Function
    End If
    GetUTFPage=xmlHttp.responseText
    Set xmlHttp=Nothing
    If err.number<>0 then err.Clear
  End Function
  Public Function GetGBKPage()
    If mstrUrl="" Then Exit Function
    Set xmlHttp=CreateObject("MSXML2.XMLHTTP")
    xmlHttp.open "GET",mstrUrl,false
    xmlHttp.send()
    If xmlHttp.readystate<>4 then
    Exit Function
    End If
    GetGBKPage=BytesToBSTR(xmlHttp.responseBody,"GB2312")
    Set xmlHttp=nothing
    If err.number<>0 then err.Clear
    End Function
   Private Function BytesToBstr(body,Cset)
    Set objstream =CreateObject("adodb.stream")
    With objstream
      .Type = 1
      .Mode = 3
      .Open
      .Write body
      .Position = 0
      .Type = 2
      .Charset = Cset
      BytesToBstr = .ReadText
      .Close
    End with
    Set objstream = nothing
  End Function
End Class
Dim url,objPage,text
url="http://www.gougou.com/"
Set objPage=New GetPage
objPage.Url=url
text=objPage.GetGBKPage()
MsgBox text