登陆
浏览模式: 标准 | 列表 Tag: 采集

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

转(柳永法)

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: 编码问题, 采集, 采集编码

Delphi 针对Net程序翻页

好东西呀 丢上来了以后我会再次用到就不用瞎翻了用Post提交数据

大鸟哥说ContentType很重要哩

Delphi代码
  1. Var   
  2.   Url :String;   
  3.   TAction :TStringStream;   
  4. begin  
  5.   Url :='XXXXXXXXXXXXX?Dis_Province=11';   
  6.   TAction :=TStringStream.Create('');   
  7.   IdAntiFreeze1.OnlyWhenIdle :=False;   
  8.   TAction.WriteString('__EVENTTARGET=DropDownList_Page&DropDownList_Page=3');   
  9.   IdHTTP1.Request.SetHeaders;   
  10.   IdHTTP1.Request.Referer :=Url;   
  11.   IdHTTP1.Request.ContentType :='application/x-www-form-urlencoded';   
  12.   ShowMessage(IdHTTP1.Post(Url,TAction));   
  13. end;  

Tags: net, 翻页, 采集

歌词采集工具【发布】

歌词采集工具 Kupig专属SQL版

程序已经固定了入库的数据库了-_-#给奇奇写的专门来入他的Kupig.com的

采集速度很快哦 入库也相当的快!!!只要丢入一个专辑地址 输入你目前的专辑地址点确定就能轻松入库

图片附件:
felix_001.gif

大小: 13.51 K
尺寸: 400 x 85
浏览: 974 次
点击打开新窗口浏览全图

图片附件:
felix_002.gif

大小: 24.15 K
尺寸: 110 x 92
浏览: 1029 次
点击打开新窗口浏览全图

附件:lrccatch.rar (507.01 K, 下载次数:1238)

Tags: 歌词采集, 工具, 发布, 采集

YYmp3音乐采集器

本软件适合[音乐站长]或[喜欢把音乐下载到硬盘上的朋友]  有意者可以留言购买

特色:软件能轻松采集专辑里面的全部歌曲![破防盗链]

比如输入谢霆锋专辑地址 程序解析地址 把歌手里面的所有专辑解析再解析每个歌曲

然后点采集...请稍等片刻程序自动将你的设定的 音乐文件给下载到你的硬盘里面!

图片附件:
felix_001.gif

大小: 17.25 K
尺寸: 80 x 92
浏览: 1615 次
点击打开新窗口浏览全图

Tags: 采集, 音乐, 下载, 批量下载