[ASPX]VBS、aspx下的base64加密与解密算法的示例代码

[ASPX]VBS、aspx下的base64加密与解密算法的示例代码

<%'基于VBS、ASP的Base64 Encode 和 Base64 Decode   
Dim sc   
Set sc = CreateObject("MSScriptControl.ScriptControl")   
sc.Language = "JScript"   
   
Dim tmpStr, tmpResult   
tmpStr = "··ASCII第···一次以规范标准的型态发表是在1967年,1234567890-=`~！·#￥%……—*（）——+~!@#$%^&*()_+[]{};'\:""|,./<>?《》？：“|{}，。/；‘、][ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺ最后一次更新则是在1986年,至今为止共定义了128个字符,其中33个字符无法显示(这是以现今操作系统为依归,但在DOS模式··"   
tmpResult = vbsBase64Encode(StringToByteArray(tmpStr))   
Response.write "编码： " & tmpResult & "<BR>"   
tmpResult = ByteArrayToString(vbsBase64Decode(tmpResult))   
Response.write "解码：" & tmpResult & "<BR>"   
Response.write "原串：" & tmpStr & "<BR>"   
   
If tmpStr <> tmpResult Then   
    Response.write "结果不同"   
Else   
    Response.write "结果相同"   
End If   
   
'编码   
Function vbsBase64Encode(byteArray)   
    Dim last2byte : last2byte = 3   
    Dim last4byte : last4byte = 15   
    Dim last6byte : last6byte = 63   
    Dim lead6byte : lead6byte = 252   
    Dim lead4byte : lead4byte = 240   
    Dim lead2byte : lead2byte = 192   
    Dim encodeTable : encodeTable = Split("A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,0,1,2,3,4,5,6,7,8,9,+,/", ",")   
    Dim objectStr : objectStr = ""   
    Dim num   
    num = 0   
    Dim currentByte   
    currentByte = 0   
    Dim i   
    For i = 0 to ubound(byteArray)   
        numnum = num mod 8   
        do while(num < 8)   
            Select Case num   
             Case 0   
                currentByte = byteArray(i) and lead6byte   
                currentByte = uRShift(currentByte, 2)   
             Case 2   
                currentByte = byteArray(i) and last6byte   
             Case 4   
                currentByte = byteArray(i) and last4byte   
                currentByte = LShift(currentByte, 2)   
                If ((i + 1) <= ubound(byteArray)) Then   
                    currentBytecurrentByte = currentByte or uRShift(byteArray(i + 1) and lead2byte, 6)   
                End If   
             Case 6   
                currentByte = byteArray(i) and last2byte   
                currentByte = LShift(currentByte, 4)   
                If ((i + 1) <= ubound(byteArray)) Then   
                    currentBytecurrentByte = currentByte or uRShift(byteArray(i + 1) and lead4byte, 4)   
                End If   
            End Select   
            objectStrobjectStr = objectStr & encodeTable(currentByte)   
            numnum = num + 6   
        Loop   
    Next   
    If (Len(objectStr) mod 4 <> 0) Then   
        For i = (4 - Len(objectStr) mod 4) to 1 step - 1   
            objectStrobjectStr = objectStr & "="   
        Next   
    End If   
    vbsBase64Encode = objectStr   
End Function   
'转载请说明来源于：http://blog.csdn.net/aminfo/article/details/70478053   
'解码   
Function vbsBase64Decode(str)   
    Dim delta   
    Dim ALPHABET : ALPHABET = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"   
    If Right(str, 2) = "==" Then   
        delta = 2   
    ElseIf Right(str, 1) = "=" Then   
        delta = 1   
    Else   
        delta = 0   
    End If   
    Redim buffer(Len(str) * 3 / 4 - delta)   
    Dim mask : mask = &HFF   
    Dim index : index =0   
    Dim i, c0, c1, c2, c3   
    For i = 1 to Len(str) step 4   
        c0 = Instr(ALPHABET, mid(str, i, 1)) - 1   
        c1 = Instr(ALPHABET, mid(str, i + 1, 1)) - 1   
        buffer(index) = (LShift(c0, 2) or RShift(c1, 4)) and mask   
        If buffer(index)>127 Then   
            buffer(index) = buffer(index) - 256   
        End If   
        indexindex = index + 1   
        If(index >= ubound(buffer)) Then   
            Exit For   
        End If   
           
        c2 = Instr(ALPHABET, mid(str, i + 2, 1)) - 1   
        buffer(index) = (LShift(c1, 4) or RShift(c2, 2)) and mask   
        If buffer(index)>127 Then   
            buffer(index) = buffer(index) - 256   
        End If   
        indexindex = index + 1   
        If(index >= ubound(buffer)) Then   
            Exit For   
        End If   
           
        c3 = Instr(ALPHABET, mid(str, i + 3, 1)) - 1   
        buffer(index) = (LShift(c2, 6) or c3) and mask   
        If buffer(index)>127 Then   
            buffer(index) = buffer(index) - 256   
        End If   
        indexindex = index + 1   
    Next   
    vbsBase64Decode = buffer   
End Function   
       
Function LShift(Value, Shift)   
    LShift = sc.Eval(Value & "<<" & Shift)   
End Function   
   
Function RShift(Value, Shift)   
    RShift = sc.Eval(Value & ">>" & Shift)   
End Function   
   
Function uLShift(Value, Shift)   
    uLShift = sc.Eval(Value & "<<<" & Shift)   
End Function   
   
Function uRShift(Value, Shift)   
    uRShift = sc.Eval(Value & ">>>" & Shift)   
End Function   
'转载请说明来源于：http://blog.csdn.net/aminfo/article/details/70478053   
'------------------------------------------   
Function ArrayAdd(byteArray1, byteArray2)   
    Dim i, tmpStr   
    tmpStr = ""   
    For i = 0 to ubound(byteArray1)   
        If i>0 Then   
            tmpStrtmpStr = tmpStr & ","   
        End If   
        tmpStrtmpStr = tmpStr & byteArray1(i)   
    Next   
    For i = 0 to ubound(byteArray2)   
        tmpStrtmpStr = tmpStr & "," & byteArray2(i)   
    Next   
    ArrayAdd = Split(tmpStr, ",")   
End Function   
   
'Bin字符串转数组   
Function BinToByteArray(szInput)   
    Dim i, byteArray, wch, nAsc   
    byteArray = ""   
    For i=1 To Len(szInput)   
        wch = Mid(szInput, i, 1)   
        nAsc = AscW(wch)   
        'Response.write "<BR>wch = " &  nAsc   
        If nAsc>127 Then   
            byteArraybyteArray = byteArray & "," & (nAsc - 256)   
        Else   
            byteArraybyteArray = byteArray & "," & nAsc   
        End If   
    Next   
    If Left(byteArray, 1) = "," Then   
        byteArray = Right(byteArray, Len(byteArray) - 1)   
    End If   
    BinToByteArray = Split(byteArray, ",")   
End Function   
   
'字符串转数组   
Function StringToByteArray(szInput)   
    Dim i, byteArray, wch, nAsc   
    byteArray = ""   
    For i=1 To Len(szInput)   
        wch = Mid(szInput, i, 1)   
        nAsc = AscW(wch)   
        If nAsc < 0 Then   
            nAscnAsc = nAsc + 65536   
        End If     
        If (nAsc And &HFF80) = 0 Then   
            byteArraybyteArray = byteArray & "," & AscW(wch)   
        Else   
            If (nAsc And &HF000) = 0 Then   
                byteArraybyteArray = byteArray & "," &  Cint("&H" & Hex(((nAsc \ 2 ^ 6)) Or &HC0)) - 256 & "," & Cint("&H" & Hex(nAsc And &H3F Or &H80))-256   
            Else   
                byteArraybyteArray = byteArray & "," &  Cint("&H" & Hex((nAsc \ 2 ^ 12) Or &HE0)) - 256 & "," & Cint("&H" & Hex((nAsc \ 2 ^ 6) And &H3F Or &H80)) - 256 & "," & Cint("&H" & Hex(nAsc And &H3F Or &H80)) - 256   
            End If   
        End If   
    Next   
    If Left(byteArray, 1) = "," Then   
        byteArray = Right(byteArray, Len(byteArray) - 1)   
    End If   
    StringToByteArray = Split(byteArray, ",")   
End Function   
'转载请说明来源于：http://blog.csdn.net/aminfo/article/details/70478053   
'数组转字符串   
Function ByteArrayToString(sArray)   
    Dim i, tStr, byte1, byte2, byte3   
    tStr = ""   
    For i = 0 to ubound(sArray)   
        If sArray(i)>0 and sArray(i)<128 Then   
            tStrtStr = tStr & Chr(sArray(i))   
        Else   
            If i < ubound(sArray) - 1 Then   
                byte1 = ((sArray(i) + 256) And &H3F) * &H40   
                If byte1<2048 Then   
                    byte1 = ((sArray(i) + 256) And &H3F) * &H40   
                    byte2 = (sArray(i + 1) + 256) And &H3F   
                    tStrtStr = tStr & chrW(byte1 or byte2)   
                    ii = i + 1   
                Else   
                    byte1 = ((sArray(i) + 256) And &H0F) * &H1000   
                    byte2 = ((sArray(i + 1) + 256) And &H3F) * &H40   
                    byte3 = (sArray(i + 2) + 256) And &H3F   
                    tStrtStr = tStr & chrW(byte1 or byte2 or byte3)   
                    ii = i + 2                  
                End If   
            End If   
        End If   
    Next   
    ByteArrayToString = tStr   
End Function%>   

来源于：http://blog.csdn.NET/aminfo/article/details/70478053