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