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

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

（编辑：银川站长网）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!