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)
Casehttp:/,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
Next
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