excel vba工程密码加密和破解

1. '0>注意保护版权，仅供学习使用。   
2.   
3. '1>一段极好的VBA保护密码破解程序测试WIN98+OFFICE97破解率100%   
4.   
5. '2>用以下代码对VBA加密保护后用offkey 6.5-7.0及Advanced VBA pASSWORD Recovery专业版均无法破解出保护程式码的密码   
6.   
7. '移除VBA编码保护   
8.   
9. Sub MoveProtect()   
10.   
11. Dim FileName As String   
12.   
13. FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla）,*.xls;*.xla", , "VBA破解")   
14.   
15. If FileName = CStr(False) Then   
16.   
17.      Exit Sub   
18.   
19. Else   
20.   
21.      VBAPassword FileName, False   
22.   
23. End If   
24.   
25. End Sub   
26.   
27. '设置VBA编码保护   
28.   
29. Sub SetProtect()   
30.   
31. Dim FileName As String   
32.   
33. FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla）,*.xls;*.xla", , "VBA破解")   
34.   
35. If FileName = CStr(False) Then   
36.   
37.      Exit Sub   
38.   
39. Else   
40.   
41.      VBAPassword FileName, True   
42.   
43. End If   
44.   
45. End Sub   
46.   
47. Private Function VBAPassword(FileName As String, Optional Protect As Boolean = False)   
48.   
49.     If Dir(FileName) = "" Then   
50.   
51.        Exit Function   
52.   
53.     Else   
54.   
55.        FileCopy FileName, FileName & ".bak"  
56.   
57.     End If   
58.   
59.     Dim GetData As String * 5   
60.   
61.     Open FileName For Binary As #1   
62.   
63.     Dim CMGs As Long   
64.   
65.     Dim DPBo As Long   
66.   
67.     For i = 1 To LOF(1)   
68.   
69.         Get #1, i, GetData   
70.   
71.         If GetData = "CMG=""" Then CMGs = i   
72.   
73.         If GetData = "[Host" Then DPBo = i - 2: Exit For   
74.   
75.     Next   
76.   
77.        
78.   
79.     If CMGs = 0 Then   
80.   
81.        MsgBox "请先对VBA编码设置一个保护密码...", 32, "提示"  
82.   
83.        Exit Function   
84.   
85.     End If   
86.   
87.        
88.   
89.     If Protect = False Then   
90.   
91.        Dim St As String * 2   
92.   
93.        Dim s20 As String * 1   
94.   
95.           
96.   
97.        '取得一个0D0A十六进制字串   
98.   
99.        Get #1, CMGs - 2, St   
100.   
101.        
102.   
103.        '取得一个20十六制字串   
104.   
105.        Get #1, DPBo + 16, s20   
106.   
107.        
108.   
109.        '替换加密部份机码   
110.   
111.        For i = CMGs To DPBo Step 2   
112.   
113.            Put #1, i, St   
114.   
115.        Next   
116.   
117.           
118.   
119.        '加入不配对符号   
120.   
121.        If (DPBo - CMGs) Mod 2 <> 0 Then   
122.   
123.           Put #1, DPBo + 1, s20   
124.   
125.        End If   
126.   
127.        MsgBox "文件解密成功......", 32, "提示"  
128.   
129.     Else   
130.   
131.        Dim MMs As String * 5   
132.   
133.        MMs = "DPB="""  
134.   
135.        Put #1, CMGs, MMs   
136.   
137.        MsgBox "对文件特殊加密成功......", 32, "提示"  
138.   
139.     End If   
140.   
141.     Close #1   
142.   
143. End Function