ASP UrlEncode 的实现(不会有乱码)

作者: 来源: 日期:2010-4-16
Function AspUrlDecode(strValue)
    Dim varAry, varElement, objStream, lngLoop, Flag
    strValue = Replace(strValue, "+", " ")
    varAry = Split(strValue, "%")
    Flag = varAry(0) = ""
    Set objStream = Server.CreateObject("ADODB.Stream")
    With objStream
            .Type = 2
            .Mode = 3
            .Open
            For Each varElement In varAry
                If varElement <> Empty Then
                    If Len(varElement) >= 2 And Flag Then
                        .WriteText ChrB(CInt("&H" & Left(varElement, 2)))
                        For lngLoop = 3 To Len(varElement)
                            .WriteText ChrB(Asc(Mid(varElement, lngLoop, 1)))
                        Next
                    Else
                        For lngLoop = 1 To Len(varElement)
                            .WriteText ChrB(Asc(Mid(varElement, lngLoop, 1)))
                        Next
                        Flag = True
                    End If
                End If
            Next
            .WriteText Chr(0)
            .Position = 0
            AspUrlDecode = Replace(ConvUnicode(.ReadText), Chr(0), "", 1, -1, 0)
            On Error Resume Next
            .Close
            Set objStream = Nothing
    End With
End Function
 
 
Function ConvUnicode(ByVal strData)
    Dim rs, stm, bytAry, intLen
    If Len(strData & "") > 0 Then
        strData = MidB(strData, 1)
        intLen = LenB(strData)
        Set rs = Server.CreateObject("ADODB.Recordset")
        Set stm = Server.CreateObject("ADODB.Stream")
        With rs
            .Fields.Append "X", 205, intLen
            .Open
            .AddNew
            rs(0).AppendChunk strData & ChrB(0)
            .Update
            bytAry = rs(0).GetChunk(intLen)
        End With
        With stm
            .Type = 1
            .Open
            .Write bytAry
            .Position = 0
            .Type = 2
            .Charset = "utf-8"
            ConvUnicode = .ReadText
        End With
    End If
    On Error Resume Next
    stm.Close
    Set stm = Nothing
    rs.Close
    Set rs = Nothing
End Function
相关文章