ASP取得地址URL中的*域名的函数
程序员文章站
2022-09-28 19:50:52
Private Function durl(url)Dim domext, s1, s2, re, matches, arrdom, dddomext = "comnetorgcn...
Private Function durl(url)
Dim domext, s1, s2, re, matches, arrdom, dd
domext = "comnetorgcnlaccinfohkbizmemobinametvasiakrdeorg.cnco.krcom.cnnet.cngov.cn"
arrdom = Split(domext, "")
durl = "": url = LCase(url)
If url = "" Or Len(url) = 0 Then Exit Function
url = Replace(Replace(url, "https://", ""), "https://", "")
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
Dim domext, s1, s2, re, matches, arrdom, dd
domext = "comnetorgcnlaccinfohkbizmemobinametvasiakrdeorg.cnco.krcom.cnnet.cngov.cn"
arrdom = Split(domext, "")
durl = "": url = LCase(url)
If url = "" Or Len(url) = 0 Then Exit Function
url = Replace(Replace(url, "https://", ""), "https://", "")
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
上一篇: 混得风生水起的太监,还让太后为他生了孩子