FormatRemoteUrl函数之asp实现格式化成当前网站完整的URL-将相对地址转换为绝对地址的代码

时间:2021-08-29 00:15:06
  1. '================================================  
  2. '函数名:FormatRemoteUrl  
  3. '作  用:格式化成当前网站完整的URL-将相对地址转换为绝对地址  
  4. '参  数: url ----Url字符串  
  5. '参  数: CurrentUrl ----当然网站URL  
  6. '返回值:格式化取后的Url  
  7. '================================================  
  8.     Public Function FormatRemoteUrl(ByVal URL,ByVal CurrentUrl)  
  9.         Dim strUrl  
  10.         If Len(URL) < 2 Or Len(URL) > 255 Or Len(CurrentUrl) < 2 Then  
  11.             FormatRemoteUrl = vbNullString  
  12.             Exit Function  
  13.         End If  
  14.         CurrentUrl = Trim(Replace(Replace(Replace(Replace(Replace(CurrentUrl, "'", vbNullString), """", vbNullString), vbNewLine, vbNullString), "\", "/"), "|", vbNullString))  
  15.         URL = Trim(Replace(Replace(Replace(Replace(Replace(URL, "'", vbNullString), """", vbNullString), vbNewLine, vbNullString), "\", "/"), "|", vbNullString))      
  16.         If InStr(9, CurrentUrl, "/") = 0 Then  
  17.             strUrl = CurrentUrl  
  18.         Else  
  19.             strUrl = Left(CurrentUrl, InStr(9, CurrentUrl, "/") - 1)  
  20.         End If  
  21.  
  22.         If strUrl = vbNullString Then strUrl = CurrentUrl  
  23.         Select Case Left(LCase(URL), 6)  
  24.             Case "http:/""https:""ftp://""rtsp:/""mms://"  
  25.                 FormatRemoteUrl = URL  
  26.                 Exit Function  
  27.         End Select  
  28.  
  29.         If Left(URL, 1) = "/" Then  
  30.             FormatRemoteUrl = strUrl & URL  
  31.             Exit Function  
  32.         End If  
  33.  
  34.         If Left(URL, 3) = "../" Then  
  35.             Dim ArrayUrl  
  36.             Dim ArrayCurrentUrl  
  37.             Dim ArrayTemp()  
  38.             Dim strTemp  
  39.             Dim i, n  
  40.             Dim c, l  
  41.             n = 0  
  42.             ArrayCurrentUrl = Split(CurrentUrl, "/")  
  43.             ArrayUrl = Split(URL, "../")  
  44.             c = UBound(ArrayCurrentUrl)  
  45.             l = UBound(ArrayUrl) + 1  
  46.  
  47.             If c > l + 2 Then  
  48.                 For i = 0 To c - l  
  49.                     ReDim Preserve ArrayTemp(n)  
  50.                     ArrayTemp(n) = ArrayCurrentUrl(i)  
  51.                     n = n + 1  
  52.                 Next  
  53.                 strTemp = Join(ArrayTemp, "/")  
  54.             Else  
  55.                 strTemp = strUrl  
  56.             End If  
  57.             URL = Replace(URL, "../", vbNullString)  
  58.             FormatRemoteUrl = strTemp & "/" & URL  
  59.             Exit Function  
  60.         End If  
  61.         strUrl = Left(CurrentUrl, InStrRev(CurrentUrl, "/"))  
  62.         FormatRemoteUrl = strUrl & Replace(URL, "./", vbNullString)  
  63.         Exit Function  
  64.     End Function