FormatRemoteUrl函数之asp实现格式化成当前网站完整的URL-将相对地址转换为绝对地址的代码

'================================================

'函数名：FormatRemoteUrl

'作用：格式化成当前网站完整的URL-将相对地址转换为绝对地址

'参数：url----Url字符串

'参数：CurrentUrl----当然网站URL

'返回值：格式化取后的Url

'================================================

PublicFunctionFormatRemoteUrl(ByValURL,ByValCurrentUrl)

DimstrUrl

IfLen(URL)<2OrLen(URL)>255OrLen(CurrentUrl)<2Then

FormatRemoteUrl=vbNullString

ExitFunction

EndIf

CurrentUrl=Trim(Replace(Replace(Replace(Replace(Replace(CurrentUrl,"'",vbNullString),"""",vbNullString),vbNewLine,vbNullString),"","/"),"|",vbNullString))

URL=Trim(Replace(Replace(Replace(Replace(Replace(URL,"'",vbNullString),"""",vbNullString),vbNewLine,vbNullString),"","/"),"|",vbNullString))

IfInStr(9,CurrentUrl,"/")=0Then

strUrl=CurrentUrl

Else

strUrl=Left(CurrentUrl,InStr(9,CurrentUrl,"/")-1)

EndIf

IfstrUrl=vbNullStringThenstrUrl=CurrentUrl

SelectCaseLeft(LCase(URL),6)

Case"http:/","https:","ftp://","rtsp:/","mms://"

FormatRemoteUrl=URL

ExitFunction

EndSelect

IfLeft(URL,1)="/"Then

FormatRemoteUrl=strUrl&URL

ExitFunction

EndIf

IfLeft(URL,3)="../"Then

DimArrayUrl

DimArrayCurrentUrl

DimArrayTemp()

DimstrTemp

Dimi,n

Dimc,l

n=0

ArrayCurrentUrl=Split(CurrentUrl,"/")

ArrayUrl=Split(URL,"../")

c=UBound(ArrayCurrentUrl)

l=UBound(ArrayUrl)+1

Ifc>l+2Then

Fori=0Toc-l

ReDimPreserveArrayTemp(n)

ArrayTemp(n)=ArrayCurrentUrl(i)

n=n+1

strTemp=Join(ArrayTemp,"/")

Else

strTemp=strUrl

EndIf

URL=Replace(URL,"../",vbNullString)

FormatRemoteUrl=strTemp&"/"&URL

ExitFunction

EndIf

strUrl=Left(CurrentUrl,InStrRev(CurrentUrl,"/"))

FormatRemoteUrl=strUrl&Replace(URL,"./",vbNullString)

ExitFunction

EndFunction