frmmain.frm

自己写的多种加密算法 供有心人学习、解密

'随机数加密====================================
Private Sub RndEncrypt()
    Dim RndNum As Long '生成随机数的个数
    Dim i As Long '计数器
    Dim n As Long '数据读写指针
    Dim m As Long '数据读写指针
    Dim RndData As Long '临时存放随机数
    Dim tmpData As Long '临时存放源文件读入数据
    Dim ByteData As Byte '处理文件尾余下的几个字节
    Dim FileSize As Long '源文件的大小
    Dim FileName As String * 255 '源文件的文件名
    Run = True
    RndNum = Val(InputBox("请输入生成随机数的个数", "随机数加密", "40"))
    DLG.Filter = "超级加密文件(*.ser)|*.ser"
    DLG.FileName = "SuperEn1.ser"
    DLG.ShowSave
    Randomize
    lblState.Caption = "加密中"
    Open txtSrcE For Binary As #1
    Open DLG.FileName For Binary As #2
    '记录加密方式,源文件长度
    ByteData = 0
    Put 2, , ByteData
    FileSize = LOF(1)
    Put 2, , FileSize
    '生成并记录随机数
    n = 6: m = 6
    Put 2, n, RndNum
    For i = 1 To RndNum
        RndData = Int(Rnd * (2 ^ 31 - 1))
        n = n + 4
        Put 2, n, RndData
    Next i
    '源数据异或随机数,并记录
    Do While n + 4 - RndNum * 4 - 1 - 5 < FileSize - 4
        If m = RndNum * 4 + 6 Then m = 6
        m = m + 4: n = n + 4
        Get 1, , tmpData
        Get 2, m, RndData
        tmpData = tmpData Xor RndData
        Put 2, n, tmpData
        '显示进度
        Dim ProNum As Long, CurByte As Long
        CurByte = n - RndNum * 4 - 9
        ProNum = (100 * CurByte) \ FileSize
        If ProNum Mod 10 = 0 Then
            lblPro.Caption = CStr(ProNum) & "%"
            DoEvents
        End If
    Loop
    '因为以上操作以4个字节的Long类型为基本单位
    '而文件长度不一定被4整除
    '所以文件尾会产生零头
    '下面的代码处理文件尾
    n = n + 4
    For i = 1 To FileSize - (n - 4 - RndNum * 4 - 1 - 5)
        Get 1, , ByteData
        Put 2, n + i - 1, ByteData
    Next i
    '取得并记录文件名
    Dim s() As String
    s = Split(txtSrcE, "\")
    FileName = s(UBound(s))
    Put 2, , FileName
    '----------------
    Close 2: Close 1
    lblState.Caption = "加密完成"
    lblPro.Caption = ""
    MsgBox "文件加密完成！" & vbCrLf & "加密文件已另存为:" & vbCrLf & DLG.FileName
    lblState.Caption = "无"
    Run = False
End Sub
'随机数解密====================================
Private Sub RndDecrypt()
    Run = True
    Dim RndNum As Long '随机数的个数
    Dim i As Long '计数器
    Dim n As Long '数据读写指针
    Dim m As Long '数据读写指针
    Dim RndData As Long '临时存放随机数
    Dim tmpData As Long '临时存放源文件读入数据
    Dim ByteData As Byte '处理文件尾余下的几个字节
    Dim FileSize As Long '源文件的大小
    Dim FileName As String * 255 '源文件的文件名
    Open txtSrcD For Binary As #1
        Get 1, 2, FileSize
        Get 1, 6, RndNum
        Get 1, 9 + RndNum * 4 + FileSize + 1, FileName
    Close 1
    DLG.Filter = "所有文件(*.*)|*.*"
    DLG.FileName = FileName
    DLG.ShowSave
    lblState.Caption = "解密中"
    Open txtSrcD For Binary As #1
    Open DLG.FileName For Binary As #2
        m = 6
        n = RndNum * 4 + 5 + 1
        '加密时异或得到的数据,与随机数再异或一次
        '得到的是源数据,并记录下来
        Do While n + 4 + 4 - 1 < 9 + RndNum * 4 + FileSize - 4
            If m = RndNum * 4 + 6 Then m = 6
            n = n + 4: m = m + 4
            Get 1, m, RndData
            Get 1, n, tmpData
            tmpData = tmpData Xor RndData
            Put 2, , tmpData
            '显示进度
            Dim ProNum As Long, CurByte As Long
            CurByte = n - RndNum * 4 - 6
            ProNum = (100 * CurByte) \ FileSize
            If ProNum Mod 10 = 0 Then
                lblPro.Caption = CStr(ProNum) & "%"
                DoEvents
            End If
        Loop
        '处理文件尾部零头
        n = n + 4
        For i = 1 To 9 + RndNum * 4 + FileSize - (n - 1)
            Get 1, n + i - 1, ByteData
            Put 2, , ByteData
        Next i
    Close 2: Close 1
    lblState.Caption = "解密完成"
    lblPro.Caption = ""
    MsgBox "文件解密完成！" & vbCrLf & "还原文件已另存为:" & vbCrLf & DLG.FileName
    lblState.Caption = "无"
    Run = False
End Sub

'密码加密====================================
Private Sub PasswordEncrypt()
    Dim PW As String '存放密码
    Dim AscData() As Integer '存放密码中各字符的AscII码
    Dim tmpAscData() As Integer 'AscData倒装后的数组
    Dim tmpData As Long '源数据
    Dim i As Long '计数器
    Dim n As Long '数据读写指针
    Dim ByteData As Byte '处理文件尾余下的几个字节
    Dim FileSize As Long '源文件的大小
    Dim MySize As Long '程序部分的大小
    Dim EditorSize As Long 'Editor.exe文件的大小
    Dim FileName As String * 255 '源文件的文件名
    Dim b As Boolean '决定AscData是否倒装的变量
    Dim Indec As Boolean '是否开启防破解功能
    On Error Resume Next
    Run = True
    lblState.Caption = "加密中"
    DLG.Filter = "超级加密自解密文件(*.exe)|*.exe"
    DLG.FileName = "SuperEn1.exe"
    DLG.ShowSave
    '设置密码
    Load frmDlg
    With frmDlg
        .lblIntr.Move 8, 12: .lblIntr.Caption = "请输入密码:"
        .txtMain.Move 8, 32: .txtMain.PasswordChar = "*": .txtMain.Text = ""
        .cmdOK.Move 256, 8, 65, 25: .cmdCancel.Move 256, 32, 65, 25
        .ChkIndec.Move 147, 10
        .Show 1
        PW = .txtMain
        Indec = .ChkIndec.Value
        Unload frmDlg
    End With
    If Len(PW) = 0 Then Exit Sub
    '取得密码中各字符的AscII码及其倒装结果
    ReDim AscData(Len(PW) - 1)
    For i = 0 To Len(PW) - 1
        AscData(i) = Asc(Mid(PW, i + 1, 1))
    Next i
    ReDim tmpAscData(Len(PW) - 1)
    For i = 0 To Len(PW) - 1
        tmpAscData(i) = AscData(Len(PW) - 1 - i)
    Next i
    Kill DLG.FileName
    '复制自解密源
    FileCopy GetAppPath & "AutoDecrypt\PasswordDecrypt.exe", DLG.FileName
    Open txtSrcE For Binary As #1
    Open DLG.FileName For Binary As #2
    n = LOF(2) + 1 '把指针定位到文件尾
    MySize = LOF(2)
    '放入Editor.exe文件
    Open GetAppPath & "AutoDecrypt\Editor.exe" For Binary As #3
        EditorSize = LOF(3)
        Do While n - 1 < MySize + EditorSize
            Get 3, , ByteData
            Put 2, n, ByteData
            n = n + 1
        Loop
    Close 3
    '记录加密方式,源文件长度,Editor.exe文件长度
    ByteData = 1
    Put 2, n, ByteData
    FileSize = LOF(1)
    Put 2, , FileSize
    n = 6
    '异或加密
    Do
        For i = 0 To Len(PW) - 1
            If n - 1 - 5 >= FileSize - 4 Then Exit Do
            Get 1, , tmpData
            If b Then tmpData = tmpData Xor tmpAscData(i) ^ 2 Else: tmpData = tmpData Xor AscData(i) ^ 2
            Put 2, , tmpData
            n = n + 4
        Next i
        b = Not b
        '显示进度
        Dim ProNum As Long, CurByte As Long
        CurByte = n - 5
        ProNum = (100 * CurByte) \ FileSize
        If ProNum Mod 10 = 0 Then
            lblPro.Caption = CStr(ProNum) & "%"
            DoEvents
        End If
    Loop
    '处理文件尾
    For i = 1 To FileSize - (n - 1 - 5)
        Get 1, , ByteData
        Put 2, , ByteData
    Next i
    '取得并记录文件名
    Dim s() As String
    s = Split(txtSrcE, "\")
    FileName = s(UBound(s))
    Put 2, , FileName
    '记录程序部分的大小
    Put 2, , MySize
    Put 2, , EditorSize
    If Indec Then '添加值为零的四个字节,作为防破解开启标志
        i = 0: Put 2, , i
    End If
    '----------------
    Close 2: Close 1
    lblState.Caption = "加密完成"
    lblPro.Caption = ""
    MsgBox "文件加密完成！" & vbCrLf & "自解密文件已另存为:" & vbCrLf & DLG.FileName
    lblState.Caption = "无"
    Run = False
End Sub