'================================================ '函数名：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:/", "https:", "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

　　推荐阅读

　　asp之字符串函数示例

asp之字符串函数示例用字符串函数对字符串进行截头去尾、大小写替换等操作。 函数语法功能LenLen(string|varname)返回字符串内字符的数目，或是存储一变量所需的字节数。TrimTrim(string)将字符串前后的空格去掉Lt>>>详细阅读

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

地址：http://www.17bianji.com/kaifa2/ASP/32431.html

 1/2    1