'================================================== '函数名：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
