'/*=========================================================================    
' * Intro       研究網頁編碼很長時間了，因為最近要設計一個友情鏈接檢測的VBS腳本，而與你鏈接的人的頁面很可能是各種編碼，以前采取的方法是：如果用GB2312查不到再用UTF-8查，再找不到證明對方沒有給你做鏈接雖然不是100%正確，但也差不多了，這兩種編碼用的人比較多，偶然間在收藏夾里的一個地址看到的一個思路，終于可以在采集文章時自動判斷網頁的編碼了。因為研究過程中這個問題困擾很久，雖然現在覺得簡單了，想必很多人還在找，所以把這三個函數貼出來。    
' * FileName    GetWebCodePage.vbs    
' * Author      yongfa365    
' * Version     v2.0    
' * WEB         http://www.yongfa365.com    
' * Email       yongfa365[at]qq.com    
' * FirstWrite  http://www.yongfa365.com/Item/GetWebCodePage.vbs.html    
' * MadeTime    2008-01-29 20:55:46    
' * LastModify  2008-01-30 20:55:46    
' *==========================================================================*/    

   
Call getHTTPPage("http://www.baidu.com/")    
Call getHTTPPage("http://www.google.com/")    
Call getHTTPPage("http://www.yongfa365.com/")    
Call getHTTPPage("http://www.jfrwli.cn/")    
Call getHTTPPage("http://www.aspku.net/")    

   
'得到匹配的內容，返回數組    
'getContents(表達式，字符串，是否返回引用值)    
'msgbox getContents("a(.+?)b", "a23234b ab a67896896b sadfasdfb" ,True)(0)    

Function getContents(patrn, strng , yinyong)    
'by www.yongfa365.com 轉載請保留鏈接，以便最終用戶及時得到最新更新信息    
    On Error Resume Next   
    Set re = New RegExp   
    re.Pattern = patrn    
    re.IgnoreCase = True   
    re.Global = True   
    Set Matches = re.Execute(strng)    
    If yinyong Then   
        For i = 0 To Matches.Count -1    
            If Matches(i).Value<>"" Then RetStr = RetStr & Matches(i).SubMatches(0) & "柳永法"   
        Next   
    Else   
        For Each oMatch in Matches    
            If oMatch.Value<>"" Then RetStr = RetStr & oMatch.Value & "柳永法"   
        Next   
    End If   
    getContents = Split(RetStr, "柳永法")    
End Function   

Function getHTTPPage(url)    
    On Error Resume Next   
    Set xmlhttp = CreateObject("MSXML2.XMLHTTP")    
    xmlhttp.Open "Get", url, False   
    xmlhttp.Send    
    If xmlhttp.Status<>200 Then Exit Function   
    GetBody = xmlhttp.ResponseBody    
    '柳永法(www.yongfa365.com)在此的思路是,先根據返回的字符串找，找文件頭，如果還沒有的話就用GB2312,一般都能直接匹配出編碼。    
    '在返回的字符串里看，雖然中文是亂碼，但不影響我們取其編碼，    
    GetCodePage = getContents("charset=[""']*([^"",']+)", xmlhttp.ResponseText , True)(0)    
    '在頭文件里看編碼    
     If Len(GetCodePage)<3 Then GetCodePage = getContents("charset=[""']*([^"",']+)", xmlhttp.getResponseHeader("Content-Type") , True)(0)    
    If Len(GetCodePage)<3 Then GetCodePage = "gb2312"   
    Set xmlhttp = Nothing   
    '下邊這句在正式使用時要屏蔽掉    
    WScript.Echo url & "-->" & GetCodePage    
    getHTTPPage = BytesToBstr(GetBody, GetCodePage)    
End Function   

   
Function BytesToBstr(Body, Cset)    
    On Error Resume Next   
    Dim objstream    
    Set objstream = 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