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

时间：2021-08-29 00:15:18
  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 
标签：

相关文章