'/*=========================================================================
'*Intro研究网页编码很长时间了，因为最近要设计一个友情链接检测的VBS脚本，而与你链接的人的页面很可能是各种编码，以前采取的方法是：如果用GB2312查不到再用UTF-8查，再找不到证明对方没有给你做链接虽然不是100%正确，但也差不多了，这两种编码用的人比较多，偶然间在收藏夹里的一个地址看到的一个思路，终于可以在采集文章时自动判断网页的编码了。因为研究过程中这个问题困扰很久，虽然现在觉得简单了，想必很多人还在找，所以把这三个函数贴出来。
'*FileNameGetWebCodePage.vbs
'*Authoryongfa365
'*Versionv2.0
'*WEBhttp://www.yongfa365.com
'*Emailyongfa365[at]qq.com
'*FirstWritehttp://www.yongfa365.com/Item/GetWebCodePage.vbs.html
'*MadeTime2008-01-2920:55:46
'*LastModify2008-01-3020:55:46
'*==========================================================================*/
CallgetHTTPPage("http://www.baidu.com/")
CallgetHTTPPage("http://www.google.com/")
CallgetHTTPPage("http://www.yongfa365.com/")
CallgetHTTPPage("http://www.cbdcn.com/")
CallgetHTTPPage("http://www.csdn.net/")
'得到匹配的内容，返回数组
'getContents(表达式，字符串，是否返回引用值)
'msgboxgetContents("a(.+?)b","a23234baba67896896bsadfasdfb",True)(0)
FunctiongetContents(patrn,strng,yinyong)
'bywww.yongfa365.com转载请保留链接，以便最终用户及时得到最新更新信息
OnErrorResumeNext
Setre=NewRegExp
re.Pattern=patrn
re.IgnoreCase=True
re.Global=True
SetMatches=re.Execute(strng)
IfyinyongThen
Fori=0ToMatches.Count-1
IfMatches(i).Value<>""ThenRetStr=RetStr&Matches(i).SubMatches(0)&"柳永法"
Next
Else
ForEachoMatchinMatches
IfoMatch.Value<>""ThenRetStr=RetStr&oMatch.Value&"柳永法"
Next
EndIf
getContents=Split(RetStr,"柳永法")
EndFunction
FunctiongetHTTPPage(url)
OnErrorResumeNext
Setxmlhttp=CreateObject("MSXML2.XMLHTTP")
xmlhttp.Open"Get",url,False
xmlhttp.Send
Ifxmlhttp.Status<>200ThenExitFunction
GetBody=xmlhttp.ResponseBody
'柳永法(www.yongfa365.com)在此的思路是,先根据返回的字符串找，找文件头，如果还没有的话就用GB2312,一般都能直接匹配出编码。
'在返回的字符串里看，虽然中文是乱码，但不影响我们取其编码，
GetCodePage=getContents("charset=[""']*([^"",']+)",xmlhttp.ResponseText,True)(0)
'在头文件里看编码
IfLen(GetCodePage)<3ThenGetCodePage=getContents("charset=[""']*([^"",']+)",xmlhttp.getResponseHeader("Content-Type"),True)(0)
IfLen(GetCodePage)<3ThenGetCodePage="gb2312"
Setxmlhttp=Nothing
'下边这句在正式使用时要屏蔽掉
WScript.Echourl&"-->"&GetCodePage
getHTTPPage=BytesToBstr(GetBody,GetCodePage)
EndFunction
FunctionBytesToBstr(Body,Cset)
OnErrorResumeNext
Dimobjstream
Setobjstream=CreateObject("adodb.stream")
objstream.Type=1
objstream.Mode=3
objstream.Open
objstream.WriteBody
objstream.Position=0
objstream.Type=2
objstream.Charset=Cset
BytesToBstr=objstream.ReadText
objstream.Close
Setobjstream=Nothing
EndFunction