ASP取得地址URL中的顶级域名的函数
2018-09-06 10:31
  Private Function durl(url)
Dim domext, s1, s2, re, matches, arrdom, dd
arrdom = Split(domext, )
durl = : url = LCase(url)
If url = Or Len(url) = 0 Then Exit Function
url = Replace(Replace(url, 
s1 = InStr(url, :) - 1 过滤掉端口
If s1 < 0 Then s1 = InStr(url, /) - 1 过滤掉/后面的字符
If s1 > 0 Then url = Left(url, s1)
s2 = Split(url, .)(UBound(Split(url, .)))
If InStr(domext, s2) = 0 Then
 durl = url
Else
 For dd = 0 To UBound(arrdom)
 If InStr(url, . arrdom(dd)) > 0 Then
 durl = Replace(url, . arrdom(dd) , )
 If InStr(durl, .) = 0 Then
 durl = url
 Else
 durl = Split(durl, .)(UBound(Split(durl, .))) . arrdom(dd)
 End If
 End If
 Next
End If
End Function