MSXML2.ServerXMLHTTP

执行模块,整个程序的流程。由上至下的走..先看GetResStr(URL) 他首先打开网页.然后将网站的html下载回来后.然后再用正则表达来处理你需要的值。而这里演示的是直接取得他的标题..最后将值转换一下。然后输出到浏览器。。整个流程就如此了,有的服务器可能不支持msxml。所以也无法获得值。最后会返回一个gb2312

示例图:

源码:

 1 <%   
 2 Response.Clear  
 3 On Error Resume Next  
 4 response.Buffer=false  
 5 err.clear  
 6 server.ScriptTimeout=9999999  
 7   
 8 '执行模块,整个程序的流程。由上至下的走..先看GetResStr(URL) 他首先打开网页.然后将网站的html下载回来后.  
 9 '然后再用正则表达来处理你需要的值。而这里演示的是直接取得他的标题..  
10 '最后将值转换一下。然后输出到浏览器。。整个流程就如此了  
11 dim reg,vUrl,pUrl,VBody,title  
12 vUrl="http://www.baidu.com" '更换网站地址  
13 reg="\<meta.+ charset= {0,}([^\"" \>\/]*).+\/{0,1}\>"  
14   if vUrl<>"" then  '取得网站标题  
15       VBody=GetResStr(vUrl)  
16       title=GetCode(VBody,"\<title\>(.*)\<\/title\>")  
17   else  
18       vUrl="地址取不到"  
19   end if  
20   if err.number<>0 then   
21      response.write "标题出错"  
22   else  
23      if title<>"" then  
24        response.write title  
25      else  
26        response.write "标题为空"  
27       end if  
28   end if  
29 response.End()  
30   
31   
32 '函数名:GetResStr  
33 '作用:获取指定URL的HTML代码  
34 '参数:URL-要获取的URL  
35 function GetResStr(URL)  
36 err.clear  
37 dim ResBody,ResStr,PageCode,ReturnStr  
38 Set Http=server.createobject("msxml2.serverxmlhttp.3.0") '先创建一个serverxmlhttp对像.并指明他是3.0版本的..可以省去  
39 Http.setTimeouts 10000, 10000, 10000, 10000 '设置超时时间  
40 Http.open "GET",URL,False '以上已设置后。就打开网址。参数1:提交方式,url地址,异步执行 一般选择异步执行  
41 Http.Send() '调用Send方法发送XML数据  
42 If Http.Readystate =4 Then '文档已经解析完毕，客户端可以接受返回消息  
43   If Http.status=200 Then '接收返回的错误  
44     ResStr=http.responseText '接收返回的信息..(源代码一般)  
45     ResBody=http.responseBody '以html方式返回消息  
46     PageCode=GetCode(ResStr,reg) '用正则表达式。将网站返回的title值进行匹配。如果有就返回。。否则返回gbk2312  
47     ReturnStr=BytesToBstr(http.responseBody,PageCode) '需要将其转换一下..  
48     GetResStr=ReturnStr '返回值  
49   End If   
50 End If   
51 End Function  
52   
53   
54 '函数名:BytesToBstr  
55 '作用:转换二进制数据为字符  
56 '参数:Body-二进制数据,Cset-文本编码方式  
57 Function BytesToBstr(Body,Cset)   
58   Dim Objstream   
59   Set Objstream = Server.CreateObject("adodb.stream") '创建一个字符流....  
60   objstream.Type = 1  '返回的数据类型 adTypeBinary  =1 adTypeText  =2  
61   objstream.Mode =3   '指定或返加模式  
62   objstream.Open  '指定打开模式，可不指定，可选参数如下：  
63   objstream.Write body   
64   objstream.Position = 0   
65   objstream.Type = 2   
66   objstream.Charset =Cset   
67   BytesToBstr = objstream.ReadText '返回他的内容  
68   objstream.Close   
69   set objstream = nothing   
70 End Function  
71    
72 '函数名:GetCode  
73 '作用:转换二进制为字符  
74 '参数:str-待查询字符串,regstr-正则表达式  
75 Function GetCode(str,regstr)  
76 Dim Reg,serStr  
77 set Reg= new RegExp '先创建一个正则表达式..  
78 Reg.IgnoreCase = True '设置是否区分字符大小写  
79 Reg.MultiLine = True  '多行方式保存  
80 Reg.Pattern =regstr '查找html中有没有 \<meta.+ charset= {0,}([^\"" \>\/]*).+\/{0,1}\> 匹配  
81 if Reg.test(str) then '若查询到匹配项  
82    Set Cols = Reg.Execute(str)  
83    serStr=Cols(0).SubMatches(0) '使用匹配到的第一个匹配项  
84 else '否则给个默认值gb2312,有点省懒法，如果页面没给出编码格式，想知道确实有点麻烦  
85    serStr="gb2312"  
86 end if  
87 GetCode=serStr  
88 end function  
89   
90 %>

注:源程序一部代码是从网上找回来的。经过自己的注释后。并稍微的修改了一下以加强记忆.如有侵犯到你的版权请与我联系

其他资料附录

ADODB组件的资料:http://www.abcxd.com/abcxd/abcxdArticle/asp/ADODB.html

Regexp正则表达式:http://baike.baidu.com/view/682097.htm

原创文章如转载，请注明：转载自心动吧黑客BLOG [ http://www.abcxd.com/abcxd/ ]

本文链接地址：http://www.abcxd.com/abcxd/abcxdArticle/asp/msxml2serverxmlhttp.html