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