vbs或asp采集文章时网页编码问题

也想出现在这里？点击联系我~

'/*=========================================================================

'*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.zzvips.com/")

CallgetHTTPPage("http://www.aspku.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