柠檬铺

asp查询网页的友情链接数量和具体的链接网址，本例没有排除二级（及以上）的域名，没有判断重复的外链，需要的可以自己加强一下。 view sourceprint?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 %>