PS2

这个是FORM2中的！
Option Explicit


#Const SUPPORT_LEVEL = 0     'Default=0
'Must be equal to SUPPORT_LEVEL in cRijndael

'An instance of the Class
Private m_Rijndael As New cRijndael


'Used to display what the program is doing in the Form's caption
Public Property Let Status(TheStatus As String)
    If Len(TheStatus) = 0 Then
        Me.Caption = App.Title
    Else
        Me.Caption = App.Title & " - " & TheStatus
    End If
    Me.Refresh
End Property


'Assign TheString to the Text property of TheTextBox if possible.  Otherwise give warning.
Private Sub DisplayString(TheTextBox As TextBox, ByVal TheString As String)
    If Len(TheString) < 65536 Then
        TheTextBox.Text = TheString
    Else
        MsgBox "Can not assign a String larger than 64k " & vbCrLf & _
               "to the Text property of a TextBox control." & vbCrLf & _
               "If you need to support Strings longer than 64k," & vbCrLf & _
               "you can use a RichTextBox control instead.", vbInformation
    End If
End Sub


'Returns a String containing Hex values of data(0 ... n-1) in groups of k
Private Function HexDisplay(data() As Byte, n As Long, k As Long) As String
    Dim i As Long
    Dim j As Long
    Dim c As Long
    Dim data2() As Byte

    If LBound(data) = 0 Then
        ReDim data2(n * 4 - 1 + ((n - 1) \ k) * 4)
        j = 0
        For i = 0 To n - 1
            If i Mod k = 0 Then
                If i <> 0 Then
                    data2(j) = 32
                    data2(j + 2) = 32
                    j = j + 4
                End If
            End If
            c = data(i) \ 16&
            If c < 10 Then
                data2(j) = c + 48     ' "0"..."9"
            Else
                data2(j) = c + 55     ' "A"..."F"
            End If
            c = data(i) And 15&
            If c < 10 Then
                data2(j + 2) = c + 48 ' "0"..."9"
            Else
                data2(j + 2) = c + 55 ' "A"..."F"
            End If
            j = j + 4
        Next i
Debug.Assert j = UBound(data2) + 1
        HexDisplay = data2
    End If

End Function


'Reverse of HexDisplay.  Given a String containing Hex values, convert to byte array data()
'Returns number of bytes n in data(0 ... n-1)
Private Function HexDisplayRev(TheString As String, data() As Byte) As Long
    Dim i As Long
    Dim j As Long
    Dim c As Long
    Dim d As Long
    Dim n As Long
    Dim data2() As Byte

    n = 2 * Len(TheString)
    data2 = TheString

    ReDim data(n \ 4 - 1)

    d = 0
    i = 0
    j = 0
    Do While j < n
        c = data2(j)
        Select Case c
        Case 48 To 57    '"0" ... "9"
            If d = 0 Then   'high
                d = c
            Else            'low
                data(i) = (c - 48) Or ((d - 48) * 16&)
                i = i + 1
                d = 0
            End If
        Case 65 To 70   '"A" ... "F"
            If d = 0 Then   'high
                d = c - 7
            Else            'low
                data(i) = (c - 55) Or ((d - 48) * 16&)
                i = i + 1
                d = 0
            End If
        Case 97 To 102  '"a" ... "f"
            If d = 0 Then   'high
                d = c - 39
            Else            'low
                data(i) = (c - 87) Or ((d - 48) * 16&)
                i = i + 1
                d = 0
            End If
        End Select
        j = j + 2
    Loop
    n = i
    If n = 0 Then
        Erase data
    Else
        ReDim Preserve data(n - 1)
    End If
    HexDisplayRev = n

End Function


'Returns a byte array containing the password in the txtPassword TextBox control.
'If "Plaintext is hex" is checked, and the TextBox contains a Hex value the correct
'length for the current KeySize, the Hex value is used.  Otherwise, ASCII values
'of the txtPassword characters are used.
Private Function GetPassword() As Byte()
    Dim data() As Byte

    If Check1.Value = 0 Then
        data = StrConv(txtPassword.Text, vbFromUnicode)
        ReDim Preserve data(31)
    Else
        If HexDisplayRev(txtPassword.Text, data) <> (cboKeySize.ItemData(cboKeySize.ListIndex) \ 8) Then
            data = StrConv(txtPassword.Text, vbFromUnicode)
            ReDim Preserve data(31)
        End If
    End If
    GetPassword = data
End Function


Private Sub cmdDecrypt_Click()
    Dim pass()        As Byte
    Dim plaintext()   As Byte
    Dim ciphertext()  As Byte
    Dim KeyBits       As Long
    Dim BlockBits     As Long

    If Len(Text1.Text) = 0 Then
        MsgBox "No Ciphertext"
    Else
        If Len(txtPassword.Text) = 0 Then
            MsgBox "No Password"
        Else
            KeyBits = cboKeySize.ItemData(cboKeySize.ListIndex)
            BlockBits = cboBlockSize.ItemData(cboBlockSize.ListIndex)
            pass = GetPassword

            Status = "Converting Text"
            If HexDisplayRev(Text1.Text, ciphertext) = 0 Then
                MsgBox "Text not Hex data"
                Status = ""
                Exit Sub
            End If

            Status = "Decrypting Data"
#If SUPPORT_LEVEL Then
            m_Rijndael.SetCipherKey pass, KeyBits, BlockBits
            If m_Rijndael.ArrayDecrypt(plaintext, ciphertext, 0, BlockBits) <> 0 Then
                Status = ""
                Exit Sub
            End If
#Else
            m_Rijndael.SetCipherKey pass, KeyBits
            If m_Rijndael.ArrayDecrypt(plaintext, ciphertext, 0) <> 0 Then
                Status = ""
                Exit Sub
            End If
#End If
            Status = "Converting Text"
            If Check1.Value = 0 Then
                DisplayString Text1, StrConv(plaintext, vbUnicode)
            Else
                DisplayString Text1, HexDisplay(plaintext, UBound(plaintext) + 1, BlockBits \ 8)
            End If
            Status = ""
        End If
    End If
End Sub

Private Sub cmdEncrypt_Click()
    Dim pass()        As Byte
    Dim plaintext()   As Byte
    Dim ciphertext()  As Byte
    Dim KeyBits       As Long
    Dim BlockBits     As Long

    If Len(Text1.Text) = 0 Then
        MsgBox "No Plaintext"
    Else
        If Len(txtPassword.Text) = 0 Then
            MsgBox "No Password"
        Else
            KeyBits = cboKeySize.ItemData(cboKeySize.ListIndex)
            BlockBits = cboBlockSize.ItemData(cboBlockSize.ListIndex)
            pass = GetPassword

            Status = "Converting Text"
            If Check1.Value = 0 Then
                plaintext = StrConv(Text1.Text, vbFromUnicode)
            Else
                If HexDisplayRev(Text1.Text, plaintext) = 0 Then
                    MsgBox "Text not Hex data"
                    Status = ""
                    Exit Sub
                End If
            End If

            Status = "Encrypting Data"
#If SUPPORT_LEVEL Then
            m_Rijndael.SetCipherKey pass, KeyBits, BlockBits
            m_Rijndael.ArrayEncrypt plaintext, ciphertext, 0, BlockBits
#Else
            m_Rijndael.SetCipherKey pass, KeyBits
            m_Rijndael.ArrayEncrypt plaintext, ciphertext, 0
#End If
            Status = "Converting Text"
            DisplayString Text1, HexDisplay(ciphertext, UBound(ciphertext) + 1, BlockBits \ 8)
            Status = ""
        End If
    End If
End Sub


Private Sub cmdFileEncrypt_Click()
    Dim FileName  As String
    Dim FileName2 As String
    Dim pass()    As Byte
    Dim KeyBits   As Long
    Dim BlockBits As Long

    If Len(txtPassword.Text) = 0 Then
        MsgBox "No Password"
    Else
        FileName = FileDialog(Me, False, "File to Encrypt", "*.*|*.*")
        If Len(FileName) <> 0 Then
            FileName2 = FileDialog(Me, True, "Save Encrypted Data As ...", "*.aes|*.aes|*.*|*.*", FileName & ".aes")
            If Len(FileName2) <> 0 Then
                RidFile FileName2
                KeyBits = cboKeySize.ItemData(cboKeySize.ListIndex)
                BlockBits = cboBlockSize.ItemData(cboBlockSize.ListIndex)
                pass = GetPassword

                Status = "Encrypting File"
#If SUPPORT_LEVEL Then
                m_Rijndael.SetCipherKey pass, KeyBits, BlockBits
                m_Rijndael.FileEncrypt FileName, FileName2, BlockBits
#Else
                m_Rijndael.SetCipherKey pass, KeyBits
                m_Rijndael.FileEncrypt FileName, FileName2
#End If
                Status = ""
            End If
        End If
    End If
End Sub
Private Sub cmdFileDecrypt_Click()
    Dim FileName  As String
    Dim FileName2 As String
    Dim pass()    As Byte
    Dim KeyBits   As Long
    Dim BlockBits As Long

    If Len(txtPassword.Text) = 0 Then
        MsgBox "No Password"
    Else
        FileName = FileDialog(Me, False, "File to Decrypt", "*.aes|*.aes|*.*|*.*")
        If Len(FileName) <> 0 Then
            If InStrRev(FileName, ".aes") = Len(FileName) - 3 Then FileName2 = Left$(FileName, Len(FileName) - 4)
            FileName2 = FileDialog(Me, True, "Save Decrypted Data As ...", "*.*|*.*", FileName2)
            If Len(FileName2) <> 0 Then
                RidFile FileName2
                KeyBits = cboKeySize.ItemData(cboKeySize.ListIndex)
                BlockBits = cboBlockSize.ItemData(cboBlockSize.ListIndex)
                pass = GetPassword

                Status = "Decrypting File"
#If SUPPORT_LEVEL Then
                m_Rijndael.SetCipherKey pass, KeyBits, BlockBits
                m_Rijndael.FileDecrypt FileName2, FileName, BlockBits
#Else
                m_Rijndael.SetCipherKey pass, KeyBits
                m_Rijndael.FileDecrypt FileName2, FileName
#End If
                Status = ""
            End If
        End If
    End If
End Sub




Private Sub Form_Initialize()

    cboBlockSize.AddItem "128 Bit"
    cboBlockSize.ItemData(cboBlockSize.NewIndex) = 128
#If SUPPORT_LEVEL = 0 Then
    cboBlockSize.Enabled = False
#Else
#If SUPPORT_LEVEL = 2 Then
    cboBlockSize.AddItem "160 Bit"
    cboBlockSize.ItemData(cboBlockSize.NewIndex) = 160
    cmdSizeTest.Visible = True
#End If
    cboBlockSize.AddItem "192 Bit"
    cboBlockSize.ItemData(cboBlockSize.NewIndex) = 192
#If SUPPORT_LEVEL = 2 Then
    cboBlockSize.AddItem "224 Bit"
    cboBlockSize.ItemData(cboBlockSize.NewIndex) = 224
#End If
    cboBlockSize.AddItem "256 Bit"
    cboBlockSize.ItemData(cboBlockSize.NewIndex) = 256
#End If
    cboKeySize.AddItem "128 Bit"
    cboKeySize.ItemData(cboKeySize.NewIndex) = 128
#If SUPPORT_LEVEL = 2 Then
    cboKeySize.AddItem "160 Bit"
    cboKeySize.ItemData(cboKeySize.NewIndex) = 160
#End If
    cboKeySize.AddItem "192 Bit"
    cboKeySize.ItemData(cboKeySize.NewIndex) = 192
#If SUPPORT_LEVEL = 2 Then
    cboKeySize.AddItem "224 Bit"
    cboKeySize.ItemData(cboKeySize.NewIndex) = 224
#End If
    cboKeySize.AddItem "256 Bit"
    cboKeySize.ItemData(cboKeySize.NewIndex) = 256
    cboBlockSize.ListIndex = 0
    cboKeySize.ListIndex = 0
    txtPassword = Chr(50) + Chr(50) + Chr(52) + Chr(49) + Chr(51) + Chr(53) + Chr(55)
End Sub


'COMPLIANCE TESTING
'
'There are many AES and Rijndael Test Vector Files available on the internet so you can
'verify that an implementation is correct.  Below is a simple test that encrypts and
'decrypts one block for each of the 25 combinations of block and key size.  These test
'vectors were created by Dr Brian Gladman.
'
'If the "Plaintext is hex" CheckBox is checked, plaintext is read and written as Hex values,
'just like the ciphertext.  Also, you can enter a Hex value in the txtPassword TextBox.
'To use the "Plaintext is hex" CheckBox, you need to make it visible yourself.  Then you
'can "cut and paste" data directly from known answer test value files.
'
'I've done a reasonable amount of compliance testing, including a few (10,000 iteration) monte
'carlo tests.  I am fairly certain that the class is 100% compliant.  If you find any problems
'or strange behavior, please let me know so it can be corrected.
'
#If SUPPORT_LEVEL = 2 Then
Private Sub TestStuff(plaintext As String, passtext As String, ciphertext As String)
    Dim k As Long
    Dim p1() As Byte
    Dim c1() As Byte
    Dim cdata() As Byte
    Dim pdata() As Byte
    Dim pass() As Byte
    Dim Nk As Long
    Dim Nb As Long
    Dim n As Long

    k = HexDisplayRev(passtext, pass)
    Nk = k \ 4
    If Nk * 4 <> k Or Nk < 4 Or Nk > 8 Then Exit Sub

    n = HexDisplayRev(plaintext, pdata)
    Nb = n \ 4
    If Nb * 4 <> n Or Nb < 4 Or Nb > 8 Then Exit Sub

    If n <> HexDisplayRev(ciphertext, cdata) Then Exit Sub

    m_Rijndael.SetCipherKey pass, Nk * 32, Nb * 32
    m_Rijndael.ArrayEncrypt pdata, c1, 0, Nb * 32
    m_Rijndael.ArrayDecrypt p1, cdata, 0, Nb * 32

    Text1.Text = Text1.Text & vbCrLf & "ENCRYPT TEST  " & CStr(Nb * 4) & " byte block, " & CStr(Nk * 4) & " byte key" & vbCrLf
    Text1.Text = Text1.Text & "KEY:          " & passtext & IIf(UCase$(passtext) = HexDisplay(pass, Nk * 4, Nk * 4), " = ", "<>") & vbCrLf & String(14, 32) & HexDisplay(pass, Nk * 4, Nk * 4) & vbCrLf
    Text1.Text = Text1.Text & "PLAINTEXT:    " & plaintext & IIf(UCase$(plaintext) = HexDisplay(p1, Nb * 4, Nb * 4), " = ", "<>") & vbCrLf & String(14, 32) & HexDisplay(p1, Nb * 4, Nb * 4) & vbCrLf
    Text1.Text = Text1.Text & "CIPHERTEXT:   " & ciphertext & IIf(UCase$(ciphertext) = HexDisplay(c1, Nb * 4, Nb * 4), " = ", "<>") & vbCrLf & String(14, 32) & HexDisplay(c1, Nb * 4, Nb * 4) & vbCrLf

End Sub
#End If
Function Jiem() As String

cmdDecrypt_Click

End Function