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

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