vbs或asp采集文章时网页编码问题_ASP教程-查字典教程网
vbs或asp采集文章时网页编码问题
vbs或asp采集文章时网页编码问题
发布时间:2016-12-29 来源:查字典编辑
摘要:'/*===================================================================...

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

'*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

相关阅读
推荐文章
猜你喜欢
附近的人在看
推荐阅读
拓展阅读
  • 大家都在看
  • 小编推荐
  • 猜你喜欢
  • 最新ASP教程学习
    热门ASP教程学习
    编程开发子分类