DefiniteUrl asp将相对地址转换为绝对地址的代码

1. '==================================================  
2. '函数名：DefiniteUrl  
3. '作  用：将相对地址转换为绝对地址  
4. '参  数：PrimitiveUrl ------要转换的相对地址  
5. '参  数：ConsultUrl ------当前网页地址  
6. '==================================================  
7. Function DefiniteUrl(Byval PrimitiveUrl,Byval ConsultUrl)  
8.    Dim ConTemp,PriTemp,Pi,Ci,PriArray,ConArray  
9.    If PrimitiveUrl="" or ConsultUrl="" or PrimitiveUrl="$False$" or ConsultUrl="$False$" Then  
10.       DefiniteUrl="$False$"  
11.       Exit Function  
12.    End If  
13.    If Left(Lcase(ConsultUrl),7)<>"http://" Then  
14.       ConsultUrl= "http://" & ConsultUrl  
15.    End If  
16.    ConsultUrl=Replace(ConsultUrl,"\","/")  
17.    ConsultUrl=Replace(ConsultUrl,"://",":\\")  
18.    PrimitiveUrl=Replace(PrimitiveUrl,"\","/")  
19.  
20.    If Right(ConsultUrl,1)<>"/" Then  
21.       If Instr(ConsultUrl,"/")>0 Then  
22.          If Instr(Right(ConsultUrl,Len(ConsultUrl)-InstrRev(ConsultUrl,"/")),".")>0 then     
23.          Else  
24.             ConsultUrl=ConsultUrl & "/"  
25.          End If  
26.       Else  
27.          ConsultUrl=ConsultUrl & "/"  
28.       End If  
29.    End If  
30.    ConArray=Split(ConsultUrl,"/")  
31.  
32.    If Left(LCase(PrimitiveUrl),7) = "http://" then  
33.       DefiniteUrl=Replace(PrimitiveUrl,"://",":\\")  
34.    ElseIf Left(PrimitiveUrl,1) = "/" Then  
35.       DefiniteUrl=ConArray(0) & PrimitiveUrl  
36.    ElseIf Left(PrimitiveUrl,2)="./" Then  
37.       PrimitiveUrl=Right(PrimitiveUrl,Len(PrimitiveUrl)-2)  
38.       If Right(ConsultUrl,1)="/" Then     
39.          DefiniteUrl=ConsultUrl & PrimitiveUrl  
40.       Else  
41.          DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & PrimitiveUrl  
42.       End If  
43.    ElseIf Left(PrimitiveUrl,3)="../" then  
44.       Do While Left(PrimitiveUrl,3)="../"  
45.          PrimitiveUrl=Right(PrimitiveUrl,Len(PrimitiveUrl)-3)  
46.          Pi=Pi+1  
47.       Loop              
48.       For Ci=0 to (Ubound(ConArray)-1-Pi)  
49.          If DefiniteUrl<>"" Then  
50.             DefiniteUrl=DefiniteUrl & "/" & ConArray(Ci)  
51.          Else  
52.             DefiniteUrl=ConArray(Ci)  
53.          End If  
54.       Next  
55.       DefiniteUrl=DefiniteUrl & "/" & PrimitiveUrl  
56.    Else  
57.       If Instr(PrimitiveUrl,"/")>0 Then  
58.          PriArray=Split(PrimitiveUrl,"/")  
59.          If Instr(PriArray(0),".")>0 Then  
60.             If Right(PrimitiveUrl,1)="/" Then  
61.                DefiniteUrl="http:\\" & PrimitiveUrl  
62.             Else  
63.                If Instr(PriArray(Ubound(PriArray)-1),".")>0 Then   
64.                   DefiniteUrl="http:\\" & PrimitiveUrl  
65.                Else  
66.                   DefiniteUrl="http:\\" & PrimitiveUrl & "/"  
67.                End If  
68.             End If        
69.          Else  
70.             If Right(ConsultUrl,1)="/" Then     
71.                DefiniteUrl=ConsultUrl & PrimitiveUrl  
72.             Else  
73.                DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & PrimitiveUrl  
74.             End If  
75.          End If  
76.       Else  
77.          If Instr(PrimitiveUrl,".")>0 Then  
78.             If Right(ConsultUrl,1)="/" Then  
79.                If right(LCase(PrimitiveUrl),3)=".cn" or right(LCase(PrimitiveUrl),3)="com" or right(LCase(PrimitiveUrl),3)="net" or right(LCase(PrimitiveUrl),3)="org" Then  
80.                   DefiniteUrl="http:\\" & PrimitiveUrl & "/"  
81.                Else  
82.                   DefiniteUrl=ConsultUrl & PrimitiveUrl  
83.                End If  
84.             Else  
85.                If right(LCase(PrimitiveUrl),3)=".cn" or right(LCase(PrimitiveUrl),3)="com" or right(LCase(PrimitiveUrl),3)="net" or right(LCase(PrimitiveUrl),3)="org" Then  
86.                   DefiniteUrl="http:\\" & PrimitiveUrl & "/"  
87.                Else  
88.                   DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & "/" & PrimitiveUrl  
89.                End If  
90.             End If  
91.          Else  
92.             If Right(ConsultUrl,1)="/" Then  
93.                DefiniteUrl=ConsultUrl & PrimitiveUrl & "/"  
94.             Else  
95.                DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & "/" & PrimitiveUrl & "/"  
96.             End If           
97.          End If  
98.       End If  
99.    End If  
100.    If Left(DefiniteUrl,1)="/" then  
101.      DefiniteUrl=Right(DefiniteUrl,Len(DefiniteUrl)-1)  
102.    End if  
103.    If DefiniteUrl<>"" Then  
104.       DefiniteUrl=Replace(DefiniteUrl,"//","/")  
105.       DefiniteUrl=Replace(DefiniteUrl,":\\","://")  
106.    Else  
107.       DefiniteUrl="$False$"  
108.    End If  
109. End Function