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

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

2019-10-09 14:23asp代码网 ASP教程

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