asp 友情链接检查工具源码下载

YPE html PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.***w3.org/TR/REC-html40/loose.dtd">

友情链接检查工具下载
If not isEmpty(Request.Querystring("d")) Then
dm = Request.Querystring("d")

Set obj = Server.CreateObject("liuganExt.friendLink")
arr = obj.getLinks(dm)
linkArr = arr(0)
linkCount = arr(1)
pagecount = arr(2)

'功能实现
If not isEmpty(Request.Querystring("f")) Then
fn = Request.Querystring("f")
u = Request.Querystring("u")

set re = new RegExp
re.pattern = "http://(*[^/]+)**.*"
If re.test(u) Then
dm2 = re.execute(u)(0).subMatches(0)
Else
Response.Write("格式错误1")
Response.End
End If
set re = nothing

If fn="wl" Then
dm2 = dm
End If

execute("rt=obj."&fn&"("""&dm2&""","""&u&""")")
set obj = nothing
Response.Write(rt)
Response.End
End If

'页面
page = Request.Querystring("p")
If page"" Then
page = int(page)
Else
page = 1
End If
offset = (page-1)*10 +1
limit = offset +9

linkList = ""

For k=offset To limit
If k>UBound(linkArr) Then
Exit For
End If

linkUrl = linkArr(k)(0)
linkText = linkArr(k)(1)

set re = new RegExp
re.pattern = "http://(*[^/]+)**.*"
If re.test(linkUrl) Then
linkDomain = re.execute(linkUrl)(0).subMatches(0)
Else
linkDomain = "域名格式错误"
End If
set re = nothing

linkList = linkList & "

"&gs(linkUrl,25)&" ("&linkText&")"
linkList = linkList & ""
linkList = linkList & " | "
linkList = linkList & " | "&obj.pr(linkDomain,none)&""
linkList = linkList & " " & vbCrLf
linkList = linkList & ""

Next

'分页列表
pageList = "

"

set re = nothing
set obj = nothing

End If

Function gs(str,strlen)
dim l,t,c, i
strlen = strlen + 2
l = len(str)
t = 0
for i = 1 to l
c = Abs(Asc(Mid(str,i,1)))
if c > 255 then
t = t + 2
else
t = t + 1
end if
if t >= strlen then
gs = left(str,i-2)&"..."
exit for
else
gs = str
end if
next
End function
%>
"%>

"" Then%>