今天一个朋友让我看一个Excel的VBA程序。说是里面的工程打不开，需要密码让帮忙破解一下。
后来上网查找了一些相关的VBA工程保护内容。做了一个破解密码的VBA程序。把主要的列出来吧
Code
1
'移除VBA编码保护
2Sub MoveProtect()
3 Dim FileName As String
4 FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla）,*.xls;*.xla", , "VBA破解")
5 If FileName = CStr(False) Then
6 Exit Sub
7 Else
8 VBAPassword FileName, False
9 End If
10End Sub
11
12'设置VBA编码保护
13Sub SetProtect()
14 Dim FileName As String
15 FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla）,*.xls;*.xla", , "VBA破解")
16 If FileName = CStr(False) Then
17 Exit Sub
18 Else
19 VBAPassword FileName, True
20 End If
21End Sub
22
23Private Function VBAPassword(FileName As String, Optional Protect As Boolean = False)
24 If Dir(FileName) = "" Then
25 Exit Function
26 Else
27 FileCopy FileName, FileName & ".bak"
28 End If
29
30 Dim GetData As String * 5
31 Open FileName For Binary As #1
32 Dim CMGs As Long
33 Dim DPBo As Long
34 For i = 1 To LOF(1)
35 Get #1, i, GetData
36 If GetData = "CMG=""" Then CMGs = i
37 If GetData = "[Host" Then DPBo = i - 2: Exit For
38 Next
39
40 If CMGs = 0 Then
41 MsgBox "请先对VBA编码设置一个保护密码
", 32, "提示"
42 Exit Function
43 End If
44
45 If Protect = False Then
46 Dim St As String * 2
47 Dim s20 As String * 1
48
49 '取得一个0D0A十六进制字串
50 Get #1, CMGs - 2, St
51
52 '取得一个20十六制字串
53 Get #1, DPBo + 16, s20
54
55 '替换加密部份机码
56 For i = CMGs To DPBo Step 2
57 Put #1, i, St
58 Next
59
60 '加入不配对符号
61 If (DPBo - CMGs) Mod 2 <> 0 Then
62 Put #1, DPBo + 1, s20
63 End If
64 MsgBox "文件解密成功", 32, "提示"
65 Else
66 Dim MMs As String * 5
67 MMs = "DPB="""
68 Put #1, CMGs, MMs
69 MsgBox "对文件特殊加密成功", 32, "提示"
70 End If
71 Close #1
72End Function
73
其实OFFICE这套东西的密码都算是比较好破解的。 尤其是ACCESS的密码。简直和没有一样。呵呵~~！
