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

asp 友情链接检查工具源码下载
<%
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 & ""&linkDomain&"" & 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
%>
<%=""%>