源码网商城,靠谱的源码在线交易网站 我的订单 购物车 帮助

源码网商城

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

  • 时间:2021-12-22 20:34 编辑: 来源: 阅读:
  • 扫一扫,手机访问
摘要:FormatRemoteUrl函数之asp实现格式化成当前网站完整的URL-将相对地址转换为绝对地址的代码
'================================================ '函数名:FormatRemoteUrl '作  用:格式化成当前网站完整的URL-将相对地址转换为绝对地址 '参  数: url ----Url字符串 '参  数: CurrentUrl ----当然网站URL '返回值:格式化取后的Url '================================================     Public Function FormatRemoteUrl(ByVal URL,ByVal CurrentUrl)         Dim strUrl         If Len(URL) < 2 Or Len(URL) > 255 Or Len(CurrentUrl) < 2 Then             FormatRemoteUrl = vbNullString             Exit Function         End If         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))             If InStr(9, CurrentUrl, "/") = 0 Then             strUrl = CurrentUrl         Else             strUrl = Left(CurrentUrl, InStr(9, CurrentUrl, "/") - 1)         End If         If strUrl = vbNullString Then strUrl = CurrentUrl         Select Case Left(LCase(URL), 6)             Case "http:/", "https:", "ftp://", "rtsp:/", "mms://"                 FormatRemoteUrl = URL                 Exit Function         End Select         If Left(URL, 1) = "/" Then             FormatRemoteUrl = strUrl & URL             Exit Function         End If         If Left(URL, 3) = "../" Then             Dim ArrayUrl             Dim ArrayCurrentUrl             Dim ArrayTemp()             Dim strTemp             Dim i, n             Dim c, l             n = 0             ArrayCurrentUrl = Split(CurrentUrl, "/")             ArrayUrl = Split(URL, "../")             c = UBound(ArrayCurrentUrl)             l = UBound(ArrayUrl) + 1             If c > l + 2 Then                 For i = 0 To c - l                     ReDim Preserve ArrayTemp(n)                     ArrayTemp(n) = ArrayCurrentUrl(i)                     n = n + 1                 Next                 strTemp = Join(ArrayTemp, "/")             Else                 strTemp = strUrl             End If             URL = Replace(URL, "../", vbNullString)             FormatRemoteUrl = strTemp & "/" & URL             Exit Function         End If         strUrl = Left(CurrentUrl, InStrRev(CurrentUrl, "/"))         FormatRemoteUrl = strUrl & Replace(URL, "./", vbNullString)         Exit Function     End Function    
  • 全部评论(0)
联系客服
客服电话:
400-000-3129
微信版

扫一扫进微信版
返回顶部