執行模塊,整個程序的流程。由上至下的走..先看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
Regexp正則表達式:http://baike.baidu.com/view/682097.htm
原創文章如轉載，請注明：轉載自心動吧黑客BLOG [ http://www.abcxd.com/abcxd/ ]
本文鏈接地址：http://www.abcxd.com/abcxd/abcxdArticle/asp/msxml2serverxmlhttp.html