查询网页的友情链接数量和具体的链接网址,本例没有排除二级(及以上)的域名,没有判断重复的外链,需要的可以自己加强一下.
以下是ASP源代码:
<form action="">URL:<input name="url_" /><input type="submit" name="submit" value="查询" /></form>
<%
If Request("url_")<>"" Then
SenFe_GetUrl Request("url_")
End If
Sub SenFe_GetUrl(sUrl)
Dim sContent, sDomian, oTempReg, I, oMatches, cMatch, sUrl_
sUrl = LCase(sUrl)
If Left(sUrl, 7)="http://" Then
sDomian = Mid(sUrl, 8)
Else
sDomian = sUrl
sUrl = "http://" & Url
End If
If InStr(sDomian, "/") Then sDomian = Split(sDomian, "/")(0)
sContent = SenFe_GetData(sUrl)
Set oTempReg = New RegExp
With oTempReg
.IgnoreCase = True
.Global = True
.Pattern = "(http:(\/\/|\\\\)(([\w\/\\\+\-~`:%])+\.)+([\w\/\\\.\=\?\+\-~`\’:!%#]|(&)|&)+)"
Set oMatches = .Execute(sContent)
For Each cMatch In oMatches
sUrl_ = LCase(cMatch.Value)
If InStr(sUrl_, sDomian)=0 Then
Response.Write(sUrl_ & "<br />" & VbCrLf)
End If
Next
End With
Set oTempReg = Nothing
End Sub
Function SenFe_GetData(sUrl)
Dim oXmlHttp : Set oXmlHttp = Server.CreateObject("Msxml2.ServerXMLHTTP")
With oXmlHttp
.Open "GET",sUrl,False
.SetRequestHeader "Referer",sUrl
.Send
SenFe_GetData = SenFe_BytesToBstr(.ResponseBody,"GB2312")
End With
Set oXmlHttp = Nothing
End Function
Function SenFe_BytesToBstr(sBody, sCset)
Dim oAdos : Set oAdos = Server.CreateObject("Adodb.Stream")
With oAdos
.Type = 1
.Mode = 3
.Open
.Write sBody
.Position = 0
.Type = 2
.Charset = sCset
SenFe_BytesToBstr = .ReadText
.Close
End With
Set oAdos = Nothing
End Function
%>