共享代码:Asp抓取页面（自动识别网页编码）

Anlige 2008-06-05 06:02:20

简单的Asp抓取页面代码，取页面编码的正则可能写的不太好，呵呵~
和大家分享了~~
http://blog.ii-home.cn



<%

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

%>

...全文

230 12 打赏收藏转发到动态举报

写回复

用AI写文章

12 条回复

切换为时间正序

请发表友善的回复…

发表回复

JavaCostar001 2010-07-03

打赏
举报

接点分，哈哈

door1234 2008-06-11

打赏
举报

观看

ztafei 2008-06-11

打赏
举报

接点分

Jack_Senlan 2008-06-10

打赏
举报

那天试用一下

gingerkang 2008-06-05

打赏
举报

[Quote=引用 7 楼 Edwingu 的回复:]
谢谢分享,JF
[/Quote]

Edwingu 2008-06-05

打赏
举报

谢谢分享,JF

风沙不去驼铃声 2008-06-05

打赏
举报

学习一下

gb_m4gic 2008-06-05

打赏
举报

学习，顶。

wangbo_wb 2008-06-05

打赏
举报

yanniu008 2008-06-05

打赏
举报

windwl 2008-06-05

打赏
举报

接点分

Anlige 2008-06-05

打赏
举报

修改下下面的函数,以前有个小bug-调用完后会把str的值给改了，导致tmp1,tmp2的值都变了



'函数名: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