注册 登陆
浏览模式: 标准 | 列表 Tag: 编码问题

Asp采集文章时网页编码问题

Written by 小锋 on 08-06-12 11:14 AM

转(柳永法)

ASP/Visual Basic代码
  1. '/*=========================================================================      
  2. ' * Intro       研究网页编码很长时间了，因为最近要设计一个友情链接检测的VBS脚本，而与你链接的人的页面很可能是各种编码，以前采取的方法是：如果用GB2312查不到再用UTF-8查，再找不到证明对方没有给你做链接虽然不是100%正确，但也差不多了，这两种编码用的人比较多，偶然间在收藏夹里的一个地址看到的一个思路，终于可以在采集文章时自动判断网页的编码了。因为研究过程中这个问题困扰很久，虽然现在觉得简单了，想必很多人还在找，所以把这三个函数贴出来。      
  3. ' * FileName    GetWebCodePage.vbs      
  4. ' * Author      yongfa365      
  5. ' * Version     v2.0      
  6. ' * WEB         http://www.yongfa365.com      
  7. ' * Email       yongfa365[at]qq.com      
  8. ' * FirstWrite  http://www.yongfa365.com/Item/GetWebCodePage.vbs.html      
  9. ' * MadeTime    2008-01-29 20:55:46      
  10. ' * LastModify  2008-01-30 20:55:46      
  11. ' *==========================================================================*/      
  12.      
  13.      
  14. Call getHTTPPage("http://www.baidu.com/")      
  15. Call getHTTPPage("http://www.google.com/")      
  16. Call getHTTPPage("http://www.yongfa365.com/")      
  17. Call getHTTPPage("http://www.cbdcn.com/")      
  18. Call getHTTPPage("http://www.csdn.net/")      
  19.      
  20.      
  21. '得到匹配的内容，返回数组      
  22. 'getContents(表达式，字符串，是否返回引用值)      
  23. 'msgbox getContents("a(.+?)b", "a23234b ab a67896896b sadfasdfb" ,True)(0)      
  24.      
  25. Function getContents(patrn, strng , yinyong)      
  26. 'by www.yongfa365.com 转载请保留链接，以便最终用户及时得到最新更新信息      
  27.     On Error Resume Next     
  28.     Set re = New RegExp     
  29.     re.Pattern = patrn      
  30.     re.IgnoreCase = True     
  31.     re.Global = True     
  32.     Set Matches = re.Execute(strng)      
  33.     If yinyong Then     
  34.         For i = 0 To Matches.Count -1      
  35.             If Matches(i).Value<>"" Then RetStr = RetStr & Matches(i).SubMatches(0) & "柳永法"     
  36.         Next     
  37.     Else     
  38.         For Each oMatch in Matches      
  39.             If oMatch.Value<>"" Then RetStr = RetStr & oMatch.Value & "柳永法"     
  40.         Next     
  41.     End If     
  42.     getContents = Split(RetStr, "柳永法")      
  43. End Function     
  44.      
  45. Function getHTTPPage(url)      
  46.     On Error Resume Next     
  47.     Set xmlhttp = CreateObject("MSXML2.XMLHTTP")      
  48.     xmlhttp.Open "Get", url, False     
  49.     xmlhttp.Send      
  50.     If xmlhttp.Status<>200 Then Exit Function     
  51.     GetBody = xmlhttp.ResponseBody      
  52.     '柳永法(www.yongfa365.com)在此的思路是,先根据返回的字符串找，找文件头，如果还没有的话就用GB2312,一般都能直接匹配出编码。      
  53.     '在返回的字符串里看，虽然中文是乱码，但不影响我们取其编码，      
  54.     GetCodePage = getContents("charset=[""']*([^"",']+)", xmlhttp.ResponseText , True)(0)      
  55.     '在头文件里看编码      
  56.      If Len(GetCodePage)<3 Then GetCodePage = getContents("charset=[""']*([^"",']+)", xmlhttp.getResponseHeader("Content-Type") , True)(0)      
  57.     If Len(GetCodePage)<3 Then GetCodePage = "gb2312"     
  58.     Set xmlhttp = Nothing     
  59.     '下边这句在正式使用时要屏蔽掉      
  60.     WScript.Echo url & "-->" & GetCodePage      
  61.     getHTTPPage = BytesToBstr(GetBody, GetCodePage)      
  62. End Function     
  63.      
  64.      
  65. Function BytesToBstr(Body, Cset)      
  66.     On Error Resume Next     
  67.     Dim objstream      
  68.     Set objstream = CreateObject("adodb.stream")      
  69.     objstream.Type = 1      
  70.     objstream.Mode = 3      
  71.     objstream.Open     
  72.     objstream.Write Body      
  73.     objstream.Position = 0      
  74.     objstream.Type = 2      
  75.     objstream.Charset = Cset      
  76.     BytesToBstr = objstream.ReadText      
  77.     objstream.Close     
  78.     Set objstream = Nothing     
  79. End Function     
  80.   
  81. '/*=========================================================================   
  82. ' * Intro       研究网页编码很长时间了，因为最近要设计一个友情链接检测的VBS脚本，而与你链接的人的页面很可能是各种编码，以前采取的方法是：如果用GB2312查不到再用UTF-8查，再找不到证明对方没有给你做链接虽然不是100%正确，但也差不多了，这两种编码用的人比较多，偶然间在收藏夹里的一个地址看到的一个思路，终于可以在采集文章时自动判断网页的编码了。因为研究过程中这个问题困扰很久，虽然现在觉得简单了，想必很多人还在找，所以把这三个函数贴出来。   
  83. ' * FileName    GetWebCodePage.vbs   
  84. ' * Author      yongfa365   
  85. ' * Version     v2.0   
  86. ' * WEB         http://www.yongfa365.com   
  87. ' * Email       yongfa365[at]qq.com   
  88. ' * FirstWrite  http://www.yongfa365.com/Item/GetWebCodePage.vbs.html   
  89. ' * MadeTime    2008-01-29 20:55:46   
  90. ' * LastModify  2008-01-30 20:55:46   
  91. ' *==========================================================================*/   
  92.   
  93.   
  94. Call getHTTPPage("http://www.baidu.com/")   
  95. Call getHTTPPage("http://www.google.com/")   
  96. Call getHTTPPage("http://www.yongfa365.com/")   
  97. Call getHTTPPage("http://www.cbdcn.com/")   
  98. Call getHTTPPage("http://www.csdn.net/")   
  99.   
  100.   
  101. '得到匹配的内容，返回数组   
  102. 'getContents(表达式，字符串，是否返回引用值)   
  103. 'msgbox getContents("a(.+?)b", "a23234b ab a67896896b sadfasdfb" ,True)(0)   
  104.   
  105. Function getContents(patrn, strng , yinyong)   
  106. 'by www.yongfa365.com 转载请保留链接，以便最终用户及时得到最新更新信息   
  107.     On Error Resume Next  
  108.     Set re = New RegExp   
  109.     re.Pattern = patrn   
  110.     re.IgnoreCase = True  
  111.     re.Global = True  
  112.     Set Matches = re.Execute(strng)   
  113.     If yinyong Then  
  114.         For i = 0 To Matches.Count -1   
  115.             If Matches(i).Value<>"" Then RetStr = RetStr & Matches(i).SubMatches(0) & "柳永法"  
  116.         Next  
  117.     Else  
  118.         For Each oMatch in Matches   
  119.             If oMatch.Value<>"" Then RetStr = RetStr & oMatch.Value & "柳永法"  
  120.         Next  
  121.     End If  
  122.     getContents = Split(RetStr, "柳永法")   
  123. End Function  
  124.   
  125. Function getHTTPPage(url)   
  126.     On Error Resume Next  
  127.     Set xmlhttp = CreateObject("MSXML2.XMLHTTP")   
  128.     xmlhttp.Open "Get", url, False  
  129.     xmlhttp.Send   
  130.     If xmlhttp.Status<>200 Then Exit Function  
  131.     GetBody = xmlhttp.ResponseBody   
  132.     '柳永法(www.yongfa365.com)在此的思路是,先根据返回的字符串找，找文件头，如果还没有的话就用GB2312,一般都能直接匹配出编码。   
  133.     '在返回的字符串里看，虽然中文是乱码，但不影响我们取其编码，   
  134.     GetCodePage = getContents("charset=[""']*([^"",']+)", xmlhttp.ResponseText , True)(0)   
  135.     '在头文件里看编码   
  136.      If Len(GetCodePage)<3 Then GetCodePage = getContents("charset=[""']*([^"",']+)", xmlhttp.getResponseHeader("Content-Type") , True)(0)   
  137.     If Len(GetCodePage)<3 Then GetCodePage = "gb2312"  
  138.     Set xmlhttp = Nothing  
  139.     '下边这句在正式使用时要屏蔽掉   
  140.     WScript.Echo url & "-->" & GetCodePage   
  141.     getHTTPPage = BytesToBstr(GetBody, GetCodePage)   
  142. End Function  
  143.   
  144.   
  145. Function BytesToBstr(Body, Cset)   
  146.     On Error Resume Next  
  147.     Dim objstream   
  148.     Set objstream = CreateObject("adodb.stream")   
  149.     objstream.Type = 1   
  150.     objstream.Mode = 3   
  151.     objstream.Open   
  152.     objstream.Write Body   
  153.     objstream.Position = 0   
  154.     objstream.Type = 2   
  155.     objstream.Charset = Cset   
  156.     BytesToBstr = objstream.ReadText   
  157.     objstream.Close   
  158.     Set objstream = Nothing  
  159. End Function  

Tags: 编码问题, 采集, 采集编码

Filed under: ASP 0 Comments 2977 Views