-
设置
VBA
编码保护
Sub SetProtect()
Dim FileName As String
FileName =
nFilename(
文件（
*.xls & *.xla
）
,*.xls;*.xla
破解
If
FileName = CStr(False) Then
Exit Sub
Else
VBAPassword FileName, True
End If
End Sub
Private Function
VBAPassword(FileName As String, Optional Protect
As Boolean = False)
If
Dir(FileName) =
Exit Function
Else
FileCopy FileName, FileName
&
End If
Dim
GetData As String * 5
Open FileName
For Binary As #1
Dim CMGs As
Long
Dim DPBo As Long
For i = 1 To LOF(1)
Get
#1, i, GetData
If GetData =
If
GetData =
Next
If CMGs = 0 Then
MsgBox
请先对
VBA
编码设置一个保护密码
...
提示
Exit Function
End If
If Protect =
False Then
Dim St As String * 2
Dim s20 As
String * 1
'
取得一个
0D0A
十六进制字串
Get #1, CMGs -
2, St
'
取得一
个
20
十六制字串
Get
#1, DPBo + 16, s20
'
替换加密部份机码
For
i = CMGs To DPBo Step 2
Put #1, i, St
Next
'
加入不配对符号
If
(DPBo - CMGs) Mod 2 <> 0 Then
Put #1, DPBo + 1, s20
End
If
MsgBox
文件解密成功
....
..
提示
Else
Dim
MMs As String * 5
MMs =
Put #1, CMGs,
MMs
MsgBox
对文件特殊加密成功
.
.....
提示
End
If
Close #1
End Function
'
移除
VBA
编码保护
Sub MoveProtect()
Dim
FileName As String
FileName =
nFilename(
文件（
*.xls & *.xla
）
,*.xls;*.xla
破
解
If FileName =
CStr(False) Then
Exit Sub
Else
VBAPassword FileName,
False
End If
End Sub
'
设置
VBA
编码保护
Sub SetProtect()
Dim FileName As String
FileName =
nFilename(
文件（
*.xls & *.xla
）
,*.xls;*.xla
破
解
If FileName =
CStr(False) Then
Exit Sub
Else
VBAPassword FileName,
True
End If
End Sub
Private Function VBAPassword(FileName
As String, Optional Protect As Boolean = False)
If Dir(FileName) =
Exit
Function
Else
FileCopy
FileName, FileName &
End If
Dim GetData As String * 5
Open FileName For Binary As #1
Dim CMGs As Long
Dim DPBo As
Long
For i = 1 To LOF(1)
Get
#1, i, GetData
If GetData =
If GetData =
Next
If CMGs = 0 Then
MsgBox
请先对
VBA
编码设置一个保护密码
...
提示
Exit
Function
End If
If Protect =
False Then
Dim St As String * 2
Dim s20 As String * 1
'
取得一个
0D0A
十六进制字串
< br>
Get #1, CMGs - 2, St
'
取得一个
20
十六制字串
< br>
Get #1, DPBo + 16, s20
'
替换加密部份机码
For i = CMGs To DPBo Step 2
Put #1, i, St
Next
'
加入不配对符号
If (DPBo - CMGs) Mod 2 <> 0 Then
Put #1, DPBo + 1, s20
End If
MsgBox
文件解密成功
....
..
提示
Else
Dim MMs As String * 5
MMs =
Put #1, CMGs, MMs
MsgBox
对文件特殊加密成功
......
提示
End If