📄 form1.frm
字号:
Height = 735
Left = -70850
TabIndex = 27
Top = 720
Width = 300
End
Begin VB.Label Label1
Caption = "加 密↓"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000080FF&
Height = 735
Left = -70850
TabIndex = 26
Top = 720
Width = 300
End
Begin VB.Image Image3
Height = 720
Left = -73160
Picture = "Form1.frx":1F72F
Top = 490
Width = 2280
End
Begin VB.Image Image7
Height = 1005
Left = -74640
Picture = "Form1.frx":229EA
Top = 1320
Visible = 0 'False
Width = 1095
End
Begin VB.Image Image1
Height = 735
Left = 420
Picture = "Form1.frx":23729
Top = 460
Width = 3705
End
Begin VB.Image Image9
Height = 1200
Left = -72840
Picture = "Form1.frx":2C5D3
Top = 600
Visible = 0 'False
Width = 1440
End
Begin VB.Image Image6
Height = 990
Left = -72480
Picture = "Form1.frx":2CA41
Top = 960
Visible = 0 'False
Width = 1245
End
Begin VB.Image Image5
Height = 990
Left = -74040
Picture = "Form1.frx":2DBCB
Top = 1440
Visible = 0 'False
Width = 1320
End
Begin VB.Label Label8
Alignment = 2 'Center
Caption = "Email:xiaofeng_tj@126.com"
BeginProperty Font
Name = "华文行楷"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 490
Left = -73400
TabIndex = 25
Top = 1290
Width = 2700
End
Begin VB.Image Image2
Height = 1020
Left = -74980
Picture = "Form1.frx":2F7E2
Top = 390
Width = 1185
End
Begin VB.Label Label2
Alignment = 2 'Center
Caption = "如有问题的话，请与开发商联系。地址见下："
ForeColor = &H000000C0&
Height = 255
Left = 240
TabIndex = 20
Top = 1420
Width = 4095
End
End
End
Attribute VB_Name = "xiaofeng"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public En_File_Path As String
Public De_File_Path As String
Public Password As String
Public New_password As String
Public Start_CHK As Integer
Private Sub Check1_Click()
End Sub
Private Sub Decrypt_Cmd_Click()
Dim Pwd_key As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Tmp As Integer
Dim Plat_Rnd(0 To 255) As Integer
Dim Plat_New(0 To 255) As Integer
Dim Plat_Final(0 To 255) As Integer
Dim P_Flag As Boolean
Dim B_Tmp As Byte
Dim FL_Tmp As Double
Dim P_FL As Double
' 判断文件是否存在
If File_exist(De_File_Path) = False Then
MsgBox "指定的文件不存在！", vbCritical + vbOKOnly, "错误"
De_File_Path = ""
Password = ""
Password_D.Text = ""
Password_D.Enabled = False
Decrypt_Src.Text = ""
Decrypt_Cmd.Enabled = False
Exit Sub
End If
' 计算Randomize Key
Password = Password_D.Text
New_password = Change_password(Password)
If Len(New_password) = Len(Password) Then
Pwd_key = CInt(Right(New_password, 1))
Else
Pwd_key = Abs(Len(New_password) - Len(Password)) + CInt(Right(New_password, 1))
End If
' 制作第一个轮盘
For k = 0 To 255
Plat_New(k) = k
Next k
j = 0
For i = 1 To Len(New_password)
k = CInt(Mid(New_password, i, 1))
While j < 256
If j + k < 256 Then
Tmp = Plat_New(j)
Plat_New(j) = Plat_New(j + k)
Plat_New(j + k) = Tmp
End If
j = j + k
Wend
Next i
' **********制作第二个轮盘**********
Rnd (-1)
Randomize Pwd_key
i = 0
While (i < 255)
j = Int(Rnd(1) * 256)
P_Flag = True
For k = 0 To i
If Plat_Rnd(k) = j Then P_Flag = False
Next k
If P_Flag = True Then
Plat_Rnd(i) = j
i = i + 1
End If
Wend
Plat_Rnd(255) = 0
' 制作第三个轮盘
For i = 0 To 255
Plat_Final(i) = Plat_Rnd(Plat_New(i))
Next i
' 文件操作
If De_Settings.Value = 1 Then FileCopy De_File_Path, De_File_Path & ".Eni"
Open De_File_Path For Binary As #1
P_FL = FileLen(De_File_Path)
For FL_Tmp = 1 To P_FL
Get #1, FL_Tmp, B_Tmp
i = 0
While Plat_Final(i) <> CInt(B_Tmp)
i = i + 1
Wend
Put #1, FL_Tmp, CByte(i)
xiaofeng.Caption = "解密中... " & CStr(CInt(FL_Tmp * 100 / P_FL)) & "%"
Next FL_Tmp
Close #1
xiaofeng.Caption = "解密完成"
MsgBox "解密成功！", vbOKOnly, "提示"
En_File_Path = ""
Password = ""
Password_D.Text = ""
Password_D.Enabled = False
Decrypt_Src.Text = ""
Decrypt_Cmd.Enabled = False
End Sub
Private Sub Encrypt_Cmd_Click()
Dim Pwd_key As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Tmp As Integer
Dim Plat_Rnd(0 To 255) As Integer
Dim Plat_New(0 To 255) As Integer
Dim Plat_Final(0 To 255) As Integer
Dim P_Flag As Boolean
Dim B_Tmp As Byte
Dim FL_Tmp As Double
Dim P_FL As Double
' 判断文件是否存在
If File_exist(En_File_Path) = False Then
MsgBox "指定的文件不存在！", vbCritical + vbOKOnly, "错误"
En_File_Path = ""
Password = ""
Password_E.Text = ""
Password_Ver.Text = ""
Password_Ver.Enabled = False
Password_E.Enabled = False
Encrypt_Src.Text = ""
Encrypt_Cmd.Enabled = False
Exit Sub
End If
' 判断两次密码输入是否一致
If Password_E <> Password_Ver Then
MsgBox "密码输入错误，请重新输入！", vbCritical + vbOKOnly, "错误提示"
Exit Sub
End If
Password = Password_E.Text
New_password = Change_password(Password)
If Len(New_password) = Len(Password) Then
Pwd_key = CInt(Right(New_password, 1))
Else
Pwd_key = Abs(Len(New_password) - Len(Password)) + CInt(Right(New_password, 1))
End If
' 制作第一个轮盘
For k = 0 To 255
Plat_New(k) = k
Next k
j = 0
For i = 1 To Len(New_password)
k = CInt(Mid(New_password, i, 1))
While j < 256
If j + k < 256 Then
Tmp = Plat_New(j)
Plat_New(j) = Plat_New(j + k)
Plat_New(j + k) = Tmp
End If
j = j + k
Wend
Next i
' 制作第二个轮盘
Rnd (-1)
Randomize Pwd_key
i = 0
While (i < 255)
j = Int(Rnd(1) * 256)
P_Flag = True
For k = 0 To i
If Plat_Rnd(k) = j Then P_Flag = False
Next k
If P_Flag = True Then
Plat_Rnd(i) = j
i = i + 1
End If
Wend
Plat_Rnd(255) = 0
' 制作第三个轮盘
For i = 0 To 255
Plat_Final(i) = Plat_Rnd(Plat_New(i))
Next i
' 文件操作
If En_Settings.Value = 1 Then FileCopy En_File_Path, En_File_Path & ".Eni"
Open En_File_Path For Binary As #1
P_FL = FileLen(En_File_Path)
For FL_Tmp = 1 To P_FL
Get #1, FL_Tmp, B_Tmp
Put #1, FL_Tmp, CByte(Plat_Final(CInt(B_Tmp)))
xiaofeng.Caption = "加密进行中... " & CStr(CInt(FL_Tmp * 100 / P_FL)) & "%"
Next FL_Tmp
Close #1
xiaofeng.Caption = "加密完成"
MsgBox "加密成功！", vbOKOnly, "提示"
En_File_Path = ""
Password = ""
Password_E.Text = ""
Password_Ver.Text = ""
Password_Ver.Enabled = False
Password_E.Enabled = False
Encrypt_Src.Text = ""
Encrypt_Cmd.Enabled = False
End Sub
Private Sub Form_Load()
MMControl3.FileName = "复件 02 曲目 2.wma"
MMControl3.DeviceType = ""
MMControl3.Command = "open"
MMControl3.Command = "play"
SSTab1.TabEnabled(1) = True
SSTab1.TabEnabled(2) = True
CDialog.FileName = ""
En_File_Path = ""
De_File_Path = ""
Password = ""
End Sub
Private Sub Open_DFile_Click()
MMControl2.Command = "close"
MMControl2.DeviceType = ""
MMControl2.FileName = "解密.wav"
MMControl2.Command = "open"
MMControl2.Command = "play"
CDialog.FileName = ""
CDialog.DialogTitle = "请选择要解密的文件"
CDialog.Filter = "所有文件|*.*"
CDialog.Flags = cdlOFNHideReadOnly
CDialog.ShowOpen
If CDialog.FileName <> "" Then
De_File_Path = CDialog.FileName
CDialog.FileName = ""
Decrypt_Src = De_File_Path
Password_D.Enabled = True
End If
End Sub
Private Sub Open_EFile_Click()
MMControl1.Command = "close"
MMControl1.DeviceType = ""
MMControl1.FileName = "加密.wav"
MMControl1.Command = "open"
MMControl1.Command = "play"
CDialog.FileName = ""
CDialog.DialogTitle = "请选择要加密的文件"
CDialog.Filter = "所有文件|*.*"
CDialog.Flags = cdlOFNHideReadOnly
CDialog.ShowOpen
If CDialog.FileName <> "" Then
En_File_Path = CDialog.FileName
CDialog.FileName = ""
Encrypt_Src = En_File_Path
Password_E.Enabled = True
End If
End Sub
Private Sub Option1_Click()
'MMControl3.Command = "open"
MMControl3.Command = "play"
End Sub
Private Sub Option2_Click()
MMControl3.Command = "stop"
End Sub
Private Sub Password_D_Change()
If Len(Password_D) > 5 Then
Decrypt_Cmd.Enabled = True
Else
Decrypt_Cmd.Enabled = False
End If
End Sub
Private Sub Password_E_Change()
If Len(Password_E) > 5 Then
Password_Ver.Enabled = True
Else
Password_Ver.Text = ""
Password_Ver.Enabled = False
End If
End Sub
Private Sub Password_Ver_Change()
If Len(Password_Ver) > 5 Then
Encrypt_Cmd.Enabled = True
Else
Encrypt_Cmd.Enabled = False
End If
End Sub
Private Sub Show_pwd_Click()
If Show_pwd.Value = 0 Then
Password_E.PasswordChar = "*"
Password_Ver.PasswordChar = "*"
Else
Password_E.PasswordChar = ""
Password_Ver.PasswordChar = ""
End If
End Sub
Private Sub Timer1_Timer()
Static pickbmp As Integer
If pickbmp = 0 Then
Image2.Picture = Image5.Picture
pickbmp = 1
ElseIf pickbmp = 1 Then
Image2.Picture = Image6.Picture
pickbmp = 2
ElseIf pickbmp = 2 Then
Image2.Picture = Image7.Picture
pickbmp = 3
ElseIf pickbmp = 3 Then
Image2.Picture = Image8.Picture
pickbmp = 4
ElseIf pickbmp = 4 Then
Image2.Picture = Image9.Picture
pickbmp = 0
End If
End Sub
Private Sub Timer2_Timer()
xiaofeng.Caption = Now
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -