des.txt

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

End Sub

Private Function DecToBin(Nber As Integer) As String                 '十进制转化成二进制函数
Dim DivYu As String
Dim TooL As Integer
Static DivMo As Integer
If Nber = 0 Then
    DecToBin = "0000000000000000"
End If
If Nber = 1 Then
    DecToBin = "0000000000000001"
End If
DivMo = Nber
DivYu = Str(DivMo Mod 2)
Do While (DivMo <> 1) And (DivMo <> 0)
    DivYu = DivYu + Str(DivMo Mod 2)
    DivMo = DivMo \ 2
Loop
DivYu = DivYu + "1"
If Len(DivYu + "1") < 16 Then
    For TooL = 0 To (16 - Len(DivYu + "1")) Step 1
        DivYu = DivYu + "0"
    Next TooL
End If
DecToBin = StrReverse(DivYu)
End Function

Private Sub getNewFileToSmallGroup()                                '获取原文按64位分组过程
Dim i As Integer                                                    'i为循环变量，用来输出FileGroup()
Dim WaHaHa As Integer                                               'WaHaHa用来确定FileGroup()行的个数
Dim FileLength As Integer                                           'FielLength确定明文字符数目
Dim GroupNum As Integer                                             'GroupNum判断最后64位中是否需要按0扩展
Dim BinNum As Integer                                               'FileGroup()中行的变量
Dim CharNum As Integer                                              'CharNum标示明文字符顺序号
Dim XPiForFGroup As Integer                                         '同BinNum
Dim YPiForFileGroup As Integer                                      'FileGroup()中列的变量
Dim EightBit As Integer                                             '按8位运算变量
Dim QuZ As String
FileLength = Len(txtfile.Text)
GroupNum = FileLength Mod 4
WaHaHa = FileLength \ 4
Select Case GroupNum
    Case 0
        txtfile.Text = txtfile.Text + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "**************************************************" + Chr(13) + Chr(10) + "文本中的字符数为：" + Str(FileLength) + Chr(13) + Chr(10) + "，可按64位分为" + Str(WaHaHa) + Chr(10) + "组(若位数有不足则按0扩展)" + Chr(13) + Chr(10) + Chr(13) + Chr(10)
        ReDim FileGroup(WaHaHa - 1, 63)
        BinNum = 0
        Do While BinNum <= (WaHaHa - 1)
            For CharNum = 1 To FileLength Step 1
                For YPiForFileGroup = 0 To 63 Step 16
                    QuZ = Mid(txtfile.Text, CharNum, 1)
                    For EightBit = 0 To 15 Step 1
                            If QuZ = "" Then
                                QuZ = 0
                            End If
                            FileGroup(BinNum, YPiForFileGroup + EightBit) = Val(Mid$(DecToBin(Asc(QuZ)), EightBit + 1, 1))
                    Next EightBit
                    If CharNum Mod 4 Then
                        CharNum = CharNum + 1
                    End If
                Next YPiForFileGroup
                BinNum = BinNum + 1
            Next CharNum
        Loop
    Case Else
        txtfile.Text = txtfile.Text + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "**************************************************" + Chr(13) + Chr(10) + "文本中的字符数为：" + Str(FileLength) + "，可按64位分为" + Str(WaHaHa + 1) + "组" + Chr(13) + Chr(10) + Chr(13) + Chr(10)
        ReDim FileGroup(WaHaHa, 63)
        BinNum = 0
        Do While (BinNum <= WaHaHa)
            For CharNum = 1 To (FileLength + (4 - GroupNum)) Step 1
                For YPiForFileGroup = 0 To 63 Step 16
                    QuZ = Mid(txtfile.Text, CharNum, 1)
                    For EightBit = 0 To 15 Step 1
                            If CharNum = FileLength Then
                                FileGroup(BinNum, YPiForFileGroup + EightBit) = 0
                            End If
                            FileGroup(BinNum, YPiForFileGroup + EightBit) = Val(Mid$(DecToBin(Asc(QuZ)), EightBit + 1, 1))
                    Next EightBit
                    If CharNum Mod 4 Then
                        CharNum = CharNum + 1
                    End If
                Next YPiForFileGroup
                BinNum = BinNum + 1
            Next CharNum
        Loop
        For i = 16 * GroupNum - 1 To 63 Step 1
            FileGroup(WaHaHa, i) = 0
        Next i
        WaHaHa = WaHaHa + 1
End Select
For XPiForFGroup = 0 To (WaHaHa - 1) Step 1
    For YPiForFileGroup = 0 To 63 Step 1
        txtfile.Text = txtfile.Text + Str(FileGroup(XPiForFGroup, YPiForFileGroup))
        If YPiForFileGroup >= 63 Then
            txtfile.Text = txtfile.Text + Chr(13) + Chr(10) + Chr(13) + Chr(10)
        End If
    Next YPiForFileGroup
Next XPiForFGroup
txtfile.Text = txtfile.Text + Chr(13) + Chr(10) + "将明文转为二进制（64位一组）总位数是" + Str(WaHaHa * 64) + Chr(13) + Chr(10) + "**************************************************" + Chr(13) + Chr(10)
xxx = WaHaHa - 1
yyy = 63
End Sub
Private Sub changeGroupFile()                               '分组明文IP置换过程
Dim BasicNumberForSGF() As Variant
Dim MdlNumForSGF(63) As Integer
Dim MdNum As Integer
Dim Mdxxx, Mdyyy As Integer
ReDim ChangeSmallGroup(xxx, 63)
BasicNumberForSGF = Array(58, 50, 42, 34, 26, 18, 10, 2, 60, 52, 44, 36, 28, 20, 12, 4, 62, 54, 46, 38, 30, 22, 14, 6, 64, 56, 48, 40, 32, 24, 16, 8, 57, 49, 41, 33, 25, 17, 9, 1, 59, 51, 43, 35, 27, 19, 11, 3, 61, 53, 45, 37, 29, 21, 13, 5, 63, 55, 47, 39, 31, 23, 15, 7)
For MdNum = 0 To 63 Step 1
    MdlNumForSGF(MdNum) = BasicNumberForSGF(MdNum)
Next MdNum
For Mdxxx = 0 To xxx Step 1
    For Mdyyy = 0 To 63 Step 1
        ChangeSmallGroup(Mdxxx, Mdyyy) = FileGroup(Mdxxx, MdlNumForSGF(BasicNumberForSGF(Mdyyy) - 1) - 1)
    Next Mdyyy
Next Mdxxx
txtfile.Text = txtfile.Text + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "64位明文IP置换后的结果如下（" + Str(xxx + 1) + "组）：" + Chr(13) + Chr(10) + Chr(13) + Chr(10)
For Mdxxx = 0 To xxx Step 1
    txtfile.Text = txtfile.Text + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "第" + Str(Mdxxx + 1) + "组（64位）" + Chr(13) + Chr(10) + "**************************************************" + Chr(13) + Chr(10)
    For Mdyyy = 0 To yyy Step 1
        If Mdyyy Mod 8 = 0 Then
            txtfile.Text = txtfile.Text + Chr(13) + Chr(10)
        End If
        txtfile.Text = txtfile.Text + Str(ChangeSmallGroup(Mdxxx, Mdyyy))
    Next Mdyyy
Next Mdxxx
End Sub
Private Sub LetGroupFileToLRIn32()                          '将每组64位同时分成两半
Dim LGT32MX, LGT32MY As Integer
ReDim GroupFileRMR(xxx, 31)
ReDim GroupFileLML(xxx, 31)
For LGT32MX = 0 To xxx Step 1
    For LGT32MY = 0 To yyy Step 1
        If (LGT32MY <= 31) Then
            GroupFileRMR(LGT32MX, LGT32MY) = ChangeSmallGroup(LGT32MX, LGT32MY)
        Else
            GroupFileLML(LGT32MX, LGT32MY - 32) = ChangeSmallGroup(LGT32MX, LGT32MY - 32)
        End If
    Next LGT32MY
Next LGT32MX
txtfile.Text = txtfile.Text + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "分配各分组的L和R已经执行完毕！" + Chr(13) + Chr(10) + "************************************************************************************************************" + Chr(13) + Chr(10)
End Sub
Private Sub RLongerToFE()                                   '将每组的R按48位扩展
Dim BasicNumberForRLToFE() As Variant
Dim MdlNumForRLoFE(47) As Integer
Dim RLToFEMX, RLToFEMY As Integer
ReDim RLToFE(xxx, 47)
BasicNumberForRLToFE = Array(32, 1, 2, 3, 4, 5, 4, 5, 6, 7, 8, 9, 8, 9, 10, 11, 12, 13, 12, 13, 14, 15, 16, 17, 16, 17, 18, 19, 20, 21, 20, 21, 22, 23, 24, 25, 24, 25, 26, 27, 28, 29, 28, 29, 30, 31, 32, 1)
For RLToFEMX = 0 To 47 Step 1
    MdlNumForRLoFE(RLToFEMX) = BasicNumberForRLToFE(RLToFEMX)
Next RLToFEMX
For RLToFEMX = 0 To xxx Step 1
    For RLToFEMY = 0 To 47 Step 1
         RLToFE(RLToFEMX, RLToFEMY) = GroupFileRMR(RLToFEMX, MdlNumForRLoFE(BasicNumberForRLToFE(RLToFEMX) - 1) - 1)
    Next RLToFEMY
Next RLToFEMX
txtfile.Text = txtfile.Text + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "各分组的R按48位扩展已经执行完毕！" + Chr(13) + Chr(10) + "************************************************************************************************************" + Chr(13) + Chr(10)
End Sub