vbs或asp采集文章时网页编码问题
2023-06-13 09:14:01 时间
"/*=========================================================================
" * 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
" * 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
相关文章
- 比较 MySQL 与 ASP 的区别(mysql和asp)
- .net安装 Linux 上的 ASP.NET 环境(linux安装asp)
- 3.0Linux系统中运行ASP 3.0的实践(linux运行asp)
- ASP连接MySQL编码入门实战(asp链接mysql代码)
- ASP和宝塔MySQL之间的稳固连接(asp连接宝塔mysql)
- ASP实现MySQL数据库连接及编写代码(asp连接mysql代码)
- ASP连接MySQL实现更高效率数据库管理(asp读mysql)
- ASP操作Oracle 轻松实现查询驱动结果(asp查询oracle)
- ASP程序使用Oracle数据库实现智能化管理(asp 操作oracle)
- ASP编程入门进阶(二十):ADO组件之删除数据记录
- 比较不错的asp模板引终极讲解(WEB开发之ASP模式)
- asp.netServer.MapPath方法注意事项
- asp之自动闭合HTML/ubb标签函数附简单注释
- asp随机字符串函数
- asp.net实现防迅雷等下载工具盗链
- asp.net开发的一些常用技巧
- ASP.NET常用文件上传方法
- asp.net无法获取的内部内容,因为该内容不是文本的解决方法
- ASP.NETPage函数调用顺序解析
- asp.net中动态改变网页标题的代码
- ASP.NETjQuery实例10动态修改hyperlink的URL值
- asp.net中水印的具体实现代码
- asp.net网页里面为什么找不到CS文件
- 使用asp.net改变网页上图片颜色比如灰色变彩色