asp實現網站友情鏈接檢查程序的代碼

ASP查詢網頁的友情鏈接數量和具體的鏈接網址,本例沒有排除二級（及以上）的域名，沒有判斷重復的外鏈,需要的可以自己加強一下。 vIEw source print? 01 <form action="">URL:<input name="url_" /><input type="submit"name="submit" value="查詢" /></form> 02 <% 03     If Request("url_")<>"" Then 04         SenFe_GetUrl Request("url_") 05     End If 06     Sub SenFe_GetUrl(sUrl) 07         Dim sContent, sDomian, oTempReg, I, oMatches, cMatch, sUrl_ 08         sUrl = LCase(sUrl) 09         If Left(sUrl, 7)="http://" Then 10             sDomian = Mid(sUrl, 8) 11         Else 12             sDomian = sUrl 13             sUrl = "http://" & Url 14         End If 15         If InStr(sDomian, "/") Then sDomian = Split(sDomian, "/")(0) 16         sContent = SenFe_GetData(sUrl) 17         Set oTempReg = New RegExp 18         With oTempReg 19             .IgnoreCase = True 20             .Global = True 21             .Pattern = "(http:(\/\/|\\\\)(([\w\/\\\+\-~`@:%])+\.)+([\w\/\\\.\=\?\+\-~`@\’:!%#]|(&)|&)+)" 22                 Set oMatches = .Execute(sContent) 23                 For Each cMatch In oMatches 24                 sUrl_ = LCase(cMatch.Value) 25                 If InStr(sUrl_, sDomian)=0 Then 26                     Response.Write(sUrl_ & "<br />" & VbCrLf) 27                 End If 28                 Next 29         End With 30         Set oTempReg = Nothing 31     End Sub 32     Function SenFe_GetData(sUrl) 33         Dim oXMLHttp : Set oXMLHttp = Server.CreateObject("Msxml2.ServerXMLHTTP") 34         With oXMLHttp 35             .Open "GET",sUrl,False 36             .SetRequestHeader "Referer",sUrl 37             .Send 38             SenFe_GetData = SenFe_BytesToBstr(.ResponseBody,"GB2312") 39         End With 40         Set oXMLHttp = Nothing 41     End Function 42     Function SenFe_BytesToBstr(sBody, sCset) 43         Dim oADOS : Set oADOS = Server.CreateObject("Adodb.Stream") 44         With oADOS 45             .Type = 1 46             .Mode = 3 47             .Open 48             .Write sBody 49             .Position = 0 50             .Type = 2 51             .Charset = sCset 52             SenFe_BytesToBstr = .ReadText 53             .Close 54         End With 55         Set oADOS = Nothing 56     End Function 57 %>