des.txt

对文件的加解密 应用ＤＥＳ算法可以对问件夹等

Option Explicit
'处理明文要用到的变量
Dim FileGroup() As Integer                  '明文按64位分组后被存入其中
Dim xxx, yyy As Integer                     '分别表示FileGroup()或ChangeSmallGroup中的行列数
Dim ChangeSmallGroup() As Integer           '明文初始置换IP后被存入其中
Dim GroupFileRMR() As Integer               '将各个64位明文右侧32位存入其中
Dim GroupFileLML() As Integer               '将各个64位明文左侧32位存入其中
Dim RLToFE() As Integer                     '将R按48位扩展后存入其中
'处理密钥要用到的变量
Dim InitMiYao(63) As Integer                '设置随机取得的密钥，并保存以备解密时需要
Dim CDNumber(15, 55) As Integer             '16次循环、56位数据（56位密钥做左循环时会用到）
Dim MiddleNumberTwo(55) As Integer          '将64位随机密钥转换成56位后存于此数组中
Dim CDToFE(15, 47) As Integer               '将16组子密钥每组扩展到48位后存于此数组中,16组
'明文和密钥相互作用要用到的变量
Dim CD_Xor_RL() As Integer                  '将48位子密钥同48位明文异或处理后存入其中——三维数组
Dim CD_Xor_RLtoRMR() As Integer             '通过S盒子并以32位输出
Dim CD_Xor_RLtoRMRtoP() As Integer          'S盒子输出后的最终转化结果
'输出结果
Dim TheFinalResult() As Integer               '最终输出结果
'其他变量
Dim changeyn As Boolean
Dim filename As String

Private Sub getMiYao()                      '随机获取密钥过程
Dim i As Integer
Randomize
For i = 0 To 63 Step 1
    If Rnd * 10 <= 5 Then
        InitMiYao(i) = 0
    Else
        InitMiYao(i) = 1
    End If
Next i
End Sub
Private Sub changeMiYao()                   '将密钥转换成56位过程
Dim BasicNumber(55) As Integer
Dim MiddleNumberOne(63) As Integer
Dim X, Y As Integer
BasicNumber(0) = 57: BasicNumber(1) = 49: BasicNumber(2) = 41: BasicNumber(3) = 33
BasicNumber(4) = 25: BasicNumber(5) = 17: BasicNumber(6) = 9: BasicNumber(7) = 1
BasicNumber(8) = 58: BasicNumber(9) = 50: BasicNumber(10) = 42: BasicNumber(11) = 34
BasicNumber(12) = 26: BasicNumber(13) = 18: BasicNumber(14) = 10: BasicNumber(15) = 2
BasicNumber(16) = 59: BasicNumber(17) = 51: BasicNumber(18) = 43: BasicNumber(19) = 35
BasicNumber(20) = 27: BasicNumber(21) = 19: BasicNumber(22) = 11: BasicNumber(23) = 3
BasicNumber(24) = 60: BasicNumber(25) = 52: BasicNumber(26) = 44: BasicNumber(27) = 36
BasicNumber(28) = 63: BasicNumber(29) = 55: BasicNumber(30) = 47: BasicNumber(31) = 39
BasicNumber(32) = 31: BasicNumber(33) = 23: BasicNumber(34) = 15: BasicNumber(35) = 7
BasicNumber(36) = 62: BasicNumber(37) = 54: BasicNumber(38) = 46: BasicNumber(39) = 38
BasicNumber(40) = 30: BasicNumber(41) = 22: BasicNumber(42) = 14: BasicNumber(43) = 6
BasicNumber(44) = 61: BasicNumber(45) = 53: BasicNumber(46) = 45: BasicNumber(47) = 37
BasicNumber(48) = 29: BasicNumber(49) = 21: BasicNumber(50) = 13: BasicNumber(51) = 5
BasicNumber(52) = 28: BasicNumber(53) = 20: BasicNumber(54) = 12: BasicNumber(55) = 4
For X = 0 To 63 Step 1
    MiddleNumberOne(X) = InitMiYao(X)                                 '数组MiddleNumberOne(x)充当中间值
Next X
    MiddleNumberTwo(0) = MiddleNumberOne(BasicNumber(0) - 1)
For Y = 1 To 55 Step 1
    If (Y Mod 7) Then                                                 '除掉8个奇偶校验位
        MiddleNumberTwo(Y) = MiddleNumberOne(BasicNumber(Y) - 1)      '56位输出被存入数组MiddleNumberTwo(y)
    End If
Next Y
txtdisplay.Text = txtdisplay.Text + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "将密钥转换为56位如下：" + Chr(13) + Chr(10) + "**************************************************" + Chr(13) + Chr(10)
For Y = 0 To 55 Step 1
    If (Y Mod 7) = 0 Then
        txtdisplay.Text = txtdisplay.Text + Chr(13) + Chr(10)
    End If
    txtdisplay.Text = txtdisplay.Text + Str(MiddleNumberTwo(Y))
Next Y
End Sub
Private Sub LeftTurnsOfCD()                                             '56位密钥左右数据组的左循环过程
Dim X, Y, xy As Integer                                                 'x横坐标数y纵坐标数
Dim numC1, numC2, numD1, numD2 As Integer                                'num为中间值
Dim MiddleNumberForMiddleNumberTwo(55) As Integer                       '数组MiddleNumberForMiddleNumberTwo(55)为中间变量
For Y = 0 To 55 Step 1
    MiddleNumberForMiddleNumberTwo(Y) = MiddleNumberTwo(Y)
Next Y
X = 0
Y = 0
For X = 0 To 15 Step 1
    Select Case X
        Case 0, 1, 8, 15
            numC1 = MiddleNumberForMiddleNumberTwo(0)
            For Y = 0 To 26 Step 1
                CDNumber(X, Y) = MiddleNumberForMiddleNumberTwo(Y + 1)
            Next Y
            CDNumber(X, 27) = numC1
            numD1 = MiddleNumberForMiddleNumberTwo(28)
            For Y = 28 To 54 Step 1
                CDNumber(X, Y) = MiddleNumberForMiddleNumberTwo(Y + 1)
            Next Y
            CDNumber(X, 55) = numD1
        Case Else
            numC1 = MiddleNumberForMiddleNumberTwo(0)
            numC2 = MiddleNumberForMiddleNumberTwo(1)
            For Y = 0 To 25 Step 1
                CDNumber(X, Y) = MiddleNumberForMiddleNumberTwo(Y + 2)
            Next Y
            CDNumber(X, 26) = numC1
            CDNumber(X, 27) = numC2
            numD1 = MiddleNumberForMiddleNumberTwo(28)
            numD2 = MiddleNumberForMiddleNumberTwo(29)
            For Y = 28 To 53 Step 1
                CDNumber(X, Y) = MiddleNumberForMiddleNumberTwo(Y + 2)
            Next Y
            CDNumber(X, 54) = numD1
            CDNumber(X, 55) = numD2
    End Select
    For xy = 0 To 55 Step 1
        MiddleNumberForMiddleNumberTwo(xy) = CDNumber(X, xy)
    Next xy
Next X
txtdisplay.Text = txtdisplay.Text + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "16个子密钥生成结果如下：" + Chr(13) + Chr(10) + "**************************************************" + Chr(13) + Chr(10)
For X = 0 To 15 Step 1
    txtdisplay.Text = txtdisplay.Text + Chr(13) + Chr(10) + "第" + Str(X + 1) + "个子密钥" + Chr(13) + Chr(10)
    For Y = 0 To 55 Step 1
        If (Y Mod 8) = 0 Then
            txtdisplay.Text = txtdisplay.Text + Chr(13) + Chr(10)
        End If
        txtdisplay.Text = txtdisplay.Text + Str(CDNumber(X, Y))
    Next Y
Next X
End Sub


Private Sub CDTogetherToFE()                     '将每组子密钥合并，再分别扩展到48位
Dim FEBasicNumber(47) As Integer
Dim MiddleNumberFE(55) As Integer
Dim fex, fey As Integer
FEBasicNumber(0) = 14: FEBasicNumber(1) = 17: FEBasicNumber(2) = 11: FEBasicNumber(3) = 24: FEBasicNumber(4) = 1
FEBasicNumber(5) = 5: FEBasicNumber(6) = 3: FEBasicNumber(7) = 28: FEBasicNumber(8) = 15: FEBasicNumber(9) = 6
FEBasicNumber(10) = 21: FEBasicNumber(11) = 10: FEBasicNumber(12) = 23: FEBasicNumber(13) = 19
FEBasicNumber(14) = 12: FEBasicNumber(15) = 4: FEBasicNumber(16) = 26: FEBasicNumber(17) = 8
FEBasicNumber(18) = 16: FEBasicNumber(19) = 7: FEBasicNumber(20) = 27: FEBasicNumber(21) = 20
FEBasicNumber(22) = 13: FEBasicNumber(23) = 2: FEBasicNumber(24) = 41: FEBasicNumber(25) = 52
FEBasicNumber(26) = 31: FEBasicNumber(27) = 37: FEBasicNumber(28) = 47: FEBasicNumber(29) = 55
FEBasicNumber(30) = 30: FEBasicNumber(31) = 40: FEBasicNumber(32) = 51: FEBasicNumber(33) = 45
FEBasicNumber(34) = 33: FEBasicNumber(35) = 48: FEBasicNumber(36) = 44: FEBasicNumber(37) = 49
FEBasicNumber(38) = 39: FEBasicNumber(39) = 56: FEBasicNumber(40) = 34: FEBasicNumber(41) = 53
FEBasicNumber(42) = 46: FEBasicNumber(43) = 42: FEBasicNumber(44) = 50: FEBasicNumber(45) = 36
FEBasicNumber(46) = 29: FEBasicNumber(47) = 32
For fex = 0 To 15 Step 1
    For fey = 0 To 55 Step 1
        MiddleNumberFE(fey) = CDNumber(fex, fey)
    Next fey
    For fey = 0 To 47 Step 1
        CDToFE(fex, fey) = MiddleNumberFE(FEBasicNumber(fey) - 1)
    Next fey
Next fex
txtdisplay.Text = txtdisplay.Text + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "将每组子密钥左右部分合并，再分别扩展到48位：" + Chr(13) + Chr(10) + "**************************************************" + Chr(13) + Chr(10)
For fex = 0 To 15 Step 1
    txtdisplay.Text = txtdisplay.Text + Chr(13) + Chr(10) + "第" + Str(fex + 1) + "个48位子密钥" + Chr(13) + Chr(10)
    For fey = 0 To 47 Step 1
        If (fey Mod 6) = 0 Then
            txtdisplay.Text = txtdisplay.Text + Chr(13) + Chr(10)
        End If
        txtdisplay.Text = txtdisplay.Text + Str(CDToFE(fex, fey))
    Next fey
Next fex