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


            '================================================== '函数名：DefiniteUrl '作  用：将相对地址转换为绝对地址 '参  数：PrimitiveUrl ------要转换的相对地址 '参  数：ConsultUrl ------当前网页地址 '================================================== Function DefiniteUrl(Byval PrimitiveUrl,Byval ConsultUrl)    Dim ConTemp,PriTemp,Pi,Ci,PriArray,ConArray    If PrimitiveUrl="" or ConsultUrl="" or PrimitiveUrl="$False$" or ConsultUrl="$False$" Then       DefiniteUrl="$False$"       Exit Function    End If    If Left(Lcase(ConsultUrl),7)<>"http://" Then       ConsultUrl= "http://" & ConsultUrl    End If    ConsultUrl=Replace(ConsultUrl,"\","/")    ConsultUrl=Replace(ConsultUrl,"://",":\\")    PrimitiveUrl=Replace(PrimitiveUrl,"\","/")    If Right(ConsultUrl,1)<>"/" Then       If Instr(ConsultUrl,"/")>0 Then          If Instr(Right(ConsultUrl,Len(ConsultUrl)-InstrRev(ConsultUrl,"/")),".")>0 then             Else             ConsultUrl=ConsultUrl & "/"          End If       Else          ConsultUrl=ConsultUrl & "/"       End If    End If    ConArray=Split(ConsultUrl,"/")    If Left(LCase(PrimitiveUrl),7) = "http://" then       DefiniteUrl=Replace(PrimitiveUrl,"://",":\\")    ElseIf Left(PrimitiveUrl,1) = "/" Then       DefiniteUrl=ConArray(0) & PrimitiveUrl    ElseIf Left(PrimitiveUrl,2)="./" Then       PrimitiveUrl=Right(PrimitiveUrl,Len(PrimitiveUrl)-2)       If Right(ConsultUrl,1)="/" Then             DefiniteUrl=ConsultUrl & PrimitiveUrl       Else          DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & PrimitiveUrl       End If    ElseIf Left(PrimitiveUrl,3)="../" then       Do While Left(PrimitiveUrl,3)="../"          PrimitiveUrl=Right(PrimitiveUrl,Len(PrimitiveUrl)-3)          Pi=Pi+1       Loop                   For Ci=0 to (Ubound(ConArray)-1-Pi)          If DefiniteUrl<>"" Then             DefiniteUrl=DefiniteUrl & "/" & ConArray(Ci)          Else             DefiniteUrl=ConArray(Ci)          End If       Next       DefiniteUrl=DefiniteUrl & "/" & PrimitiveUrl    Else       If Instr(PrimitiveUrl,"/")>0 Then          PriArray=Split(PrimitiveUrl,"/")          If Instr(PriArray(0),".")>0 Then             If Right(PrimitiveUrl,1)="/" Then                DefiniteUrl="http:\\" & PrimitiveUrl             Else                If Instr(PriArray(Ubound(PriArray)-1),".")>0 Then                    DefiniteUrl="http:\\" & PrimitiveUrl                Else                   DefiniteUrl="http:\\" & PrimitiveUrl & "/"                End If             End If                Else             If Right(ConsultUrl,1)="/" Then                   DefiniteUrl=ConsultUrl & PrimitiveUrl             Else                DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & PrimitiveUrl             End If          End If       Else          If Instr(PrimitiveUrl,".")>0 Then             If Right(ConsultUrl,1)="/" Then                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                   DefiniteUrl="http:\\" & PrimitiveUrl & "/"                Else                   DefiniteUrl=ConsultUrl & PrimitiveUrl                End If             Else                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                   DefiniteUrl="http:\\" & PrimitiveUrl & "/"                Else                   DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & "/" & PrimitiveUrl                End If             End If          Else             If Right(ConsultUrl,1)="/" Then                DefiniteUrl=ConsultUrl & PrimitiveUrl & "/"             Else                DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & "/" & PrimitiveUrl & "/"             End If                   End If       End If    End If    If Left(DefiniteUrl,1)="/" then      DefiniteUrl=Right(DefiniteUrl,Len(DefiniteUrl)-1)    End if    If DefiniteUrl<>"" Then       DefiniteUrl=Replace(DefiniteUrl,"//","/")       DefiniteUrl=Replace(DefiniteUrl,":\\","://")    Else       DefiniteUrl="$False$"    End If End Function