|
- 帖子
- 33
- 积分
- 49
- 威望
- 65
- 金钱
- 55
- 在线时间
- 0 小时
|
4楼
发表于 2008-7-21 00:57
| 只看该作者
这个是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 |
|
