用户登录  |  用户注册
首 页源码下载网络学院最新源码源码排行屏蔽广告
当前位置:新兴网络 > 网络学院 > 网页制作 > VBScript

根据网站地址与相对地址转换成绝对地址

减小字体 增大字体 作者:佚名  来源:本站整理  发布时间:2010-08-17 08:17:23
'调用示例:
S=FormatRemoteUrl("index.html","http://www.newxing.com/code/vb/123.html")
'转换后结果:http://www.newxing.com/code/vb/index.html

'------

S=FormatRemoteUrl("../index.html","http://www.newxing.com/code/vb/123.html")
'转换后结果:http://www.newxing.com/code/index.html

'------
S=FormatRemoteUrl("../../asp/index.html","http://www.newxing.com/code/vb/123.html")
'转换后结果:http://www.newxing.com/asp/index.html
VBScript code复制代码
'函数名:FormatRemoteUrl
'作  用:格式化成当前网站完整的URL-将相对地址转换为绝对地址
'参  数: url ----Url字符串
'参  数: CurrentUrl ----当然网站URL
'返回值:格式化取后的Url

Private 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

Tags:相对地址 绝对地址 网站地址 转换

作者:佚名
  • 好的评价 如果您觉得此文章好,就请您
      0%(0)
  • 差的评价 如果您觉得此文章差,就请您
      0%(0)

网络学院评论评论内容只代表网友观点,与本站立场无关!

   评论摘要(共 0 条,得分 0 分,平均 0 分) 查看完整评论