香港虚拟主机
本站公告
新闻资讯
虚拟主机帮助
域名帮助
服务器帮助
邮箱帮助
建站帮助
网站推广帮助
VPS帮助
特色主机帮助
网站备案专题
会员帮助信息
代理帮助信息
成功案例
我司获香港虚拟主机排行榜十…
香港虚拟主机金秋促销活动正…
百度整治给SEO带来了新的希望
百度同时收录网站带WWW和不带…
百度对原创内容的判断标准 如…
如何建设网站 网站建设三步曲
如何挑选老域名 老域名有那些…
域名常见故障与分析
虚拟主机基本参数介绍
交换链接的技巧 谈一下选择交…
您现在的位置: 江南数联 >> 帮助中心 >> 建站帮助 >> 正文

Asp抓取页面(自动识别网页编码)

  作者:admin    来源:本站原创    点击次数:29     更新时间:2012-8-27 6:36:35  
     
 
关注石头有礼
 
 

Asp抓取页面(自动识别网页编码)

VBScript code

<%
on error resume next
time1=timer
dim reg,vUrl,VBody,temp1,temp2,code,time1,time2,title
vUrl=trim(request.form("url"))
reg="\<meta.+ charset= {0,}([^\""| |\>|\/]*).+\/{0,1}\>"
if vUrl<>"" then
  VBody=GetResStr(trim(request.form("url")))
  temp1=VBody:temp2=VBody
  code=GetCode(temp1,reg)
  title=GetCode(temp2,"\<title\>(.*)\<\/title\>")
else
  vUrl="http://"
end if
time2=timer
%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>抓取页面</title>
<%if err.number<>0 then%>
<script language="javascript">alert('发生错误!\n您输入的URL为\"<%=vUrl%>\"\n请检查您输入的URL是否合法!');</script>
<%end if%>
</head>
<body style="font-size:12px;margin:20px 0 0 20px;">
<form name="geturl" action="test.asp" method="post">
请输入合法URL(必须以http://开头):<br /><input name="url" type="text" size=60 value="<%=vUrl%>"/><br />
<input type="submit" value="抓取" /><br />
</form>
所用时间:<font color=green><%=formatnumber((time2-time1)*1000,2)%>MS</font> <br />
页面标题:<font color=green><%=title%></font> 页面编码:<font color=green><%=code%></font> <br />
<textarea cols=150 rows=30><%=VBody%></textarea>
</body>
</html>

<%
function GetResStr(URL)
dim ResBody,ResStr,PageCode
Set Http=server.createobject("msxml2.serverxmlhttp.3.0")
Http.setTimeouts 10000, 10000, 10000, 10000
Http.open "GET",URL,False
Http.Send()
If Http.Readystate =4 Then
  If Http.status=200 Then
    ResStr=http.responseText
    ResBody=http.responseBody
    PageCode=GetCode(ResStr,reg)
    GetResStr=BytesToBstr(http.responseBody,PageCode)
  End If
End If
End Function

'函数名:BytesToBstr
'作用:转换二进制数据为字符
'参数:Body-二进制数据,Cset-文本编码方式
Function BytesToBstr(Body,Cset)
  Dim Objstream
  Set Objstream = Server.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

'函数名:GetCode
'作用:转换二进制为字符
'参数:str-待查询字符串,regstr-正则表达式
Function GetCode(str,regstr)
Dim Reg
set Reg= new RegExp
Reg.IgnoreCase = True
Reg.MultiLine = True
Reg.Pattern =regstr
Set Cols = Reg.Execute(str)
str=Cols(0).SubMatches(0)
GetCode=str
end function
%> 修改下下面的函数,以前有个小bug-调用完后会把str的值给改了,导致tmp1,tmp2的值都变了
VBScript code
'函数名:GetCode
'作用:转换二进制为字符
'参数:str-待查询字符串,regstr-正则表达式
Function GetCode(str,regstr)
Dim Reg,serStr
set Reg= new RegExp
Reg.IgnoreCase = True
Reg.MultiLine = True
Reg.Pattern =regstr
if Reg.test(str) then '若查询到匹配项
   Set Cols = Reg.Execute(str)
   serStr=Cols(0).SubMatches(0) '使用匹配到的第一个匹配项
else '否则给个默认值gb2312,有点省懒法,如果页面没给出编码格式,想知道确实有点麻烦
   serStr="gb2312"
end if
GetCode=serStr
end function

本章关健词:江南数联 域名注册 海外虚拟主机 G享虚拟主机 国内虚拟主机 企业邮箱 网站建设 自助建站 400电话申请 微聚商

 
  版权申请:Asp抓取页面(自动识别网页编码)出自江南数联dns06.com未经授权请勿转载!  
 
  • 上一篇帮助:

  • 下一篇帮助:
  •  
         

    扫一扫关注公众号有礼
    Copyright@2004-2015 江南数联 版权所有未经授权请勿复制!
    《中华人民共和国增值电信业务经营许可证》ISP证编号:皖B2-20080036 湘B2-20160056
    公司全称:永州石头网络技术有限公司(运营部)
    地址: 中国·湖南省永州市育才路158号 服务热线:400 616 9260
    安徽公司:安徽仁科信息技术有限公司 地址:合肥万和新城广场A-608 
    关注词:网站空间虚拟空间空间域名域名空间域名主机网站空间哪家好网站空间多少钱