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


            '================================================ '函数名：FormatRemoteUrl '作  用：格式化成当前网站完整的URL-将相对地址转换为绝对地址 '参  数： url ----Url字符串 '参  数： CurrentUrl ----当然网站URL '返回值：格式化取后的Url '================================================     Public Function FormatRemoteUrl(ByVal URL,ByVal CurrentUrl)         Dim strUrl         If Len(URL) < 2 Or Len(URL) > 255 Or Len(CurrentUrl) < 2 Then             FormatRemoteUrl = vbNullString             Exit Function         End If         CurrentUrl = Trim(Replace(Replace(Replace(Replace(Replace(CurrentUrl, "'", vbNullString), """", vbNullString), vbNewLine, vbNullString), "\", "/"), "|", vbNullString))         URL = Trim(Replace(Replace(Replace(Replace(Replace(URL, "'", vbNullString), """", vbNullString), vbNewLine, vbNullString), "\", "/"), "|", vbNullString))             If InStr(9, CurrentUrl, "/") = 0 Then             strUrl = CurrentUrl         Else             strUrl = Left(CurrentUrl, InStr(9, CurrentUrl, "/") - 1)         End If         If strUrl = vbNullString Then strUrl = CurrentUrl         Select Case Left(LCase(URL), 6)             Case "http:/", "http:", "ftp://", "rtsp:/", "mms://"                 FormatRemoteUrl = URL                 Exit Function         End Select         If Left(URL, 1) = "/" Then             FormatRemoteUrl = strUrl & URL             Exit Function         End If         If Left(URL, 3) = "../" Then             Dim ArrayUrl             Dim ArrayCurrentUrl             Dim ArrayTemp()             Dim strTemp             Dim i, n             Dim c, l             n = 0             ArrayCurrentUrl = Split(CurrentUrl, "/")             ArrayUrl = Split(URL, "../")             c = UBound(ArrayCurrentUrl)             l = UBound(ArrayUrl) + 1             If c > l + 2 Then                 For i = 0 To c - l                     ReDim Preserve ArrayTemp(n)                     ArrayTemp(n) = ArrayCurrentUrl(i)                     n = n + 1                 Next                 strTemp = Join(ArrayTemp, "/")             Else                 strTemp = strUrl             End If             URL = Replace(URL, "../", vbNullString)             FormatRemoteUrl = strTemp & "/" & URL             Exit Function         End If         strUrl = Left(CurrentUrl, InStrRev(CurrentUrl, "/"))         FormatRemoteUrl = strUrl & Replace(URL, "./", vbNullString)         Exit Function     End Function