asp urldecode函数 支持英文操作系统下的中文decode

Private 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



 



Public 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 = "gb2312"



            ConvUnicode = .ReadText



        End With



    End If



    On Error Resume Next



    stm.Close



    Set stm = Nothing



    rs.Close



    Set rs = Nothing



End Function