研究網頁編碼很久了，因為最近要設計一個友情連結偵測的VBS腳本，而與你連結的人的頁面很可能是各種編碼'/*============= ==================================================== ==========
' * 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.cbdcn.com/)
Call getHTTPPage(http://www.csdn.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