Excel VBA密码破解工具（VBA实现）

http://www.oschina.net/code/snippet_54124_15443

使用UltreEdit之类的十六进制编辑程序打开.XLS文件，在文本模式下查找“[Host Extender Info]”(也可只查Host)，切换到十六进制模式，将前面的“DBP＝"XXXXXXX...”的DBP关键字改成CBP，将“GC＝ "XXXXXXX...”的GC关键字改成CC，使Excel不能识别此二项！存盘即可！！！ 
用Excel打开此文件，忽略错误提示，进入VBA编辑器，嘿嘿，密码没有了！做一次存盘操作即可修复错误提示。 
Access的VBA工程密码采用无法破解！ 

==> 经过测试，的确可以清除密码，但同时内容原有的VB代码也不再了。并且存盘操作后，进入VBA 后仍会报错误。

－－－－－－－－－－－－－ 

==> 经测试，以下首段代码运行后，的确可以去除VBA 的保护密码。

在很多地方我都说过，Excel VBA的工程密码是很脆弱的，其实吧里很早就有一篇这样的贴子，我也将其整理为加载宏不过还是有很多朋友在问：）。现将主程序的源代码也整理于此。如果不 懂VBA的朋友，也可以去下载我整理的加载宏（点击下载，需要注册）。 
'1>一段极好的VBA保护密码破解程序测试WIN98+OFFICE97破解率100% 
'2>用以下代码对VBA加密保护后用offkey 6.5-7.0及Advanced VBA pASSWORD Recovery专业版均无法破解出保护程式码的密码 
'移除VBA编码保护

标签： <无>

代码片段(1)[全屏查看所有代码]

1. [代码][ASP/Basic]代码     

001	Sub MoveProtect()

002	Dim FileName As String

003	FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla）,*.xls;*.xla", ,"VBA破解")

004	If FileName = CStr(False) Then

005

Exit Sub

006

Else

007	VBAPassword FileName, False

008

End If

009

End Sub

010	'设置VBA编码保护

011	Sub SetProtect()

012	Dim FileName As String

013	FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla）,*.xls;*.xla", ,"VBA破解")

014	If FileName = CStr(False) Then

015

Exit Sub

016

Else

017	VBAPassword FileName, True

018

End If

019

End Sub

020	Private Function VBAPassword(FileName As String, Optional Protect As Boolean = False)

021	If Dir(FileName) = "" Then

022	Exit Function

023

Else

024	FileCopy FileName, FileName & ".bak"

025

End If

026	Dim GetData As String * 5

027	Open FileName For Binary As #1

028	Dim CMGs As Long

029	Dim DPBo As Long

030	For i = 1 To LOF(1)

031	Get #1, i, GetData

032	If GetData = "CMG=""" Then CMGs = i

033	If GetData = "[Host" Then DPBo = i - 2: Exit For

034

Next

035

036	If CMGs = 0 Then

037	MsgBox "请先对VBA编码设置一个保护密码...", 32, "提示"

038	Exit Function

039

End If

040

041	If Protect = False Then

042	Dim St As String * 2

043	Dim s20 As String * 1

044

045	'取得一个0D0A十六进制字串

046	Get #1, CMGs - 2, St

047

048	'取得一个20十六制字串

049	Get #1, DPBo + 16, s20

050

051

'替换加密部份机码

052	For i = CMGs To DPBo Step 2

053	Put #1, i, St

054

Next

055

056

'加入不配对符号

057	If (DPBo - CMGs) Mod 2 <> 0 Then

058	Put #1, DPBo + 1, s20

059

End If

060	MsgBox "文件解密成功......", 32, "提示"

061

Else

062	Dim MMs As String * 5

063	MMs = "DPB="""

064	Put #1, CMGs, MMs

065	MsgBox "对文件特殊加密成功......", 32, "提示"

066

End If

067

Close #1

068	End Function

069

070	-------------------------------------------------------------------------------------

071

072	'在办公中我们常看到许多用宏(VBA)编写的EXCEL表格,而这些表格就如同一个数据库,我们可以选取或查询很多的数据,一般的这些数据是存放在一个隐藏的工作表中的,那么要如何显示这个隐藏的工作表呢?我们可以打开宏编辑器(ALT+F11),再安CTRL+R打开专案,这时弹出窗会有所有的这个EXCEL的工用表,这时你就可以看看那些是被隐藏的了,很多时候打开是需要密码的,用以下方法解密后,再将解密后文件打开,依同样方法在工作表标签中右键>>检视程式码>>复制以下代码>>按F8执行

073

074	Private Sub CommandButton1_Click()

075

076	Worksheets("这里为你要显示的工作表名称").Visible = True

077

078

End Sub

079

080	'关于破解EXCEL VBA工程密码的方法,以下代码非常有效,首先建一新EXCEL文件,在工作表标签处右点>>检视程式码>>复制以下代码>>按F8执行   在弹出窗中选你要你破解工程密码的EXCEL文件   >>再按F5执行即可.

081

082	Private Sub VBAPassword()

083	'你要解保护的Excel文件路径

084	Filename = Application.GetOpenFilename("Excel文件（*.xls & *.xla & *.xlt）,*.xls;*.xla;*.xlt", , "VBA破解")

085	If Dir(Filename) = "" Then

086	MsgBox "没找到相关文件,清重新设置。"

087

Exit Sub

088

Else

089	FileCopy Filename, Filename & ".bak" '备份文件。

090

End If

091

092	Dim GetData As String * 5

093	Open Filename For Binary As #1

094	Dim CMGs As Long

095	Dim DPBo As Long

096	For i = 1 To LOF(1)

097	Get #1, i, GetData

098	If GetData = "CMG=""" Then CMGs = i

099	If GetData = "[Host" Then DPBo = i - 2: Exit For

100

Next

101

102	If CMGs = 0 Then

103	MsgBox "请先对VBA编码设置一个保护密码...", 32, "提示"

104

Exit Sub

105

End If

106

107	If Protect = False Then

108	Dim St As String * 2

109	Dim s20 As String * 1

110

111	'取得一个0D0A十六进制字串

112	Get #1, CMGs - 2, St

113

114	'取得一个20十六制字串

115	Get #1, DPBo + 16, s20

116

117

'替换加密部份机码

118	For i = CMGs To DPBo Step 2

119	Put #1, i, St

120

Next

121

122

'加入不配对符号

123	If (DPBo - CMGs) Mod 2 <> 0 Then

124	Put #1, DPBo + 1, s20

125

End If

126	MsgBox "文件解密成功......", 32, "提示"

127

End If

128

Close #1

129

End Sub

130

131

132	'如果上面代码不能运行或出错,请用以下代码重试.

133

134

135	Private Sub VBAPassword()

136	'你要解保护的Excel文件路径

137	Filename = Application.GetOpenFilename("Excel文件（*.xls & *.xla & *.xlt）,*.xls;*.xla;*.xlt", , "VBA破解")

138

139	If Dir(Filename) = "" Then

140	MsgBox "没找到相关文件,清重新设置。"

141

Exit Sub

142

Else

143	FileCopy Filename, Filename & ".bak" '备份文件。

144

End If

145

146	Dim GetData As String * 5

147	Open Filename For Binary As #1

148	Dim CMGs As Long

149	Dim DPBo As Long

150	For i = 1 To LOF(1)

151	Get #1, i, GetData

152	If GetData = "CMG=""" Then CMGs = i

153	If GetData = "[Host" Then DPBo = i - 2: Exit For

154

Next

155

156	If CMGs = 0 Then

157	MsgBox "请先对VBA编码设置一个保护密码...", 32, "提示"

158

Exit Sub

159

End If

160

161

162	Dim St As String * 2

163	Dim s20 As String * 1

164

165	'取得一个0D0A十六进制字串

166	Get #1, CMGs - 2, St

167

168	'取得一个20十六制字串

169	Get #1, DPBo + 16, s20

170

171

'替换加密部份机码

172	For i = CMGs To DPBo Step 2

173	Put #1, i, St

174

Next

175

176

'加入不配对符号

177	If (DPBo - CMGs) Mod 2 <> 0 Then

178	Put #1, DPBo + 1, s20

179

End If

180	MsgBox "文件解密成功......", 32, "提示"

181

182

Close #1

183

End Sub

184

185	'VBA代码引用自:

186	'http://club.excelhome.net/thread-271464-1-1.html