frmmain.frm

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

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmMain 
   Caption         =   "自解密文件"
   ClientHeight    =   945
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4920
   ControlBox      =   0   'False
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   63
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   328
   StartUpPosition =   2  '屏幕中心
   Begin MSComDlg.CommonDialog DLG 
      Left            =   5880
      Top             =   840
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   375
      Left            =   8160
      TabIndex        =   2
      Top             =   1200
      Width           =   975
   End
   Begin VB.TextBox txtMain 
      Height          =   270
      Left            =   4440
      TabIndex        =   0
      Text            =   "txtMain"
      Top             =   1200
      Width           =   3615
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Height          =   375
      Left            =   8160
      TabIndex        =   1
      Top             =   840
      Width           =   975
   End
   Begin VB.Label lblPro 
      AutoSize        =   -1  'True
      Caption         =   "100%"
      Height          =   180
      Left            =   2700
      TabIndex        =   4
      Top             =   360
      Visible         =   0   'False
      Width           =   360
   End
   Begin VB.Label lblIntr 
      AutoSize        =   -1  'True
      Caption         =   "请输入密码:"
      Height          =   180
      Left            =   1500
      TabIndex        =   3
      Top             =   360
      Width           =   990
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Indec As Boolean '是否开启防破解功能

'得到根目录路径
Private Function GetAppPath() As String
    If Right(App.Path, 1) = "\" Then
        GetAppPath = App.Path
    Else
        GetAppPath = App.Path & "\"
    End If
End Function

Private Sub Form_Load()
    Dim i As Long
    Dim MyFileName As String
    MyFileName = GetAppPath & App.EXEName & ".exe"
    Open MyFileName For Binary As #1
        Get 1, LOF(1) - 3, i '读最后四字节
        If i <= 0 Then
            Select Case i
            Case -3 '文件已被禁用
                MsgBox "防破解功能启动！" & vbCrLf & "此文件已被使用过三次！" & vbCrLf & "即将自杀！"
                Close 1: Call KillMe
            Case -4 '正在运行的是自解密源文件
                MsgBox "本程序仅供超级加密王软件内部使用！"
                End
            End Select
            Me.Tag = i
        End If
    Close 1
    
    MsgBox "超级加密王" & vbCrLf & "密码自解密型文件" & vbCrLf & "解密前必须输入密码"
    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
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If Indec Then
        '修改文件尾记录的被使用次数
        Dim s As String
        s = GetAppPath & App.EXEName & ".exe" & vbCrLf & CStr(Me.Tag)
        Clipboard.SetText s
        Shell GetAppPath & "Editor.exe"
        End
    End If
End Sub

Private Sub cmdCancel_Click()
    txtMain.Text = ""
    End
End Sub

Private Sub cmdOK_Click()
    If Len(txtMain) = 0 Then
        MsgBox "密码不能为空！"
    Else
        lblIntr.Caption = "工作进度:": txtMain.Visible = False
        cmdOK.Visible = False: cmdCancel.Visible = False
        lblIntr.Move 100, 24: lblPro.Move 180, 24
        lblPro.Caption = "": lblPro.Visible = True
        Call PasswordDecrypt
    End If
End Sub

Private Sub txtMain_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        Call cmdOK_Click
    End If
End Sub

Private Sub PasswordDecrypt()
    Dim PW As String '存放密码
    Dim AscData() As Integer '存放密码中各字符的AscII码
    Dim EnData As Long '加密数据
    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
    Dim MyFileName As String '本程序完整路径与文件名
    Dim FileName As String * 255 '源文件的文件名
    Dim b As Boolean '决定AscData是否倒装的变量
    Dim UsedTimes As Long '文件被使用次数
    MyFileName = GetAppPath & App.EXEName & ".exe"
    'MyFileName = GetAppPath & "superen1.exe"
    '读取首尾信息
    Open MyFileName For Binary As #1
        Get 1, LOF(1) - 3, i '读最后四字节
        If i > 0 Then '未开启防破解
            EditorSize = i
            Get 1, LOF(1) - 7, MySize
        Else '开启防破解
            Get 1, LOF(1) - 7, EditorSize
            Get 1, LOF(1) - 11, MySize
            Indec = True
            UsedTimes = Abs(i) + 1
        End If
        Get 1, MySize + EditorSize + 2, FileSize
        Get 1, MySize + EditorSize + 5 + FileSize + 1, FileName
    Close 1
    DLG.Filter = "所有文件(*.*)|*.*"
    DLG.FileName = FileName
    DLG.ShowSave
    PW = txtMain
    '取得密码中各字符的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
    Open MyFileName For Binary As #1
    Open DLG.FileName For Binary As #2
    n = 6
    Do
        For i = 0 To Len(PW) - 1
            If n - 1 - 5 >= FileSize - 4 Then Exit Do
            Get 1, MySize + EditorSize + n, 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 - 6
        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
    Close 2: Close 1
    Me.Hide
    MsgBox "文件解密完成！" & vbCrLf & "还原文件已保存为:" & vbCrLf & DLG.FileName
    '输出Editor.exe
    Open MyFileName For Binary As #1
    Open GetAppPath & "Editor.exe" For Binary As #2
        n = MySize + 1
        Do While n - 1 < MySize + EditorSize
            Get 1, n, ByteData
            Put 2, , ByteData
            n = n + 1
        Loop
    Close 2: Close 1
    Unload Me
End Sub

Private Sub KillMe() '自杀
    Dim PathName As String, BatName As String
    PathName = GetAppPath & App.EXEName & ".EXE"
    BatName = GetAppPath + "KillEXE.bat"
    Open BatName For Output As #1
    Print #1, ":START"
    Print #1, "del " & PathName
    Print #1, "if exist " & PathName & " GOTO START"
    Print #1, "del " & BatName
    Close #1
    Shell BatName, vbHide
    End
End Sub