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]代码     

001Sub 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

009End Sub

010'设置VBA编码保护

011Sub 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

019End Sub

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

021If Dir(FileName) = "" Then

022   Exit Function

023Else

024   FileCopy FileName, FileName & ".bak"

025End If

026Dim GetData As String * 5

027Open FileName For Binary As #1

028Dim CMGs As Long

029Dim DPBo As Long

030For 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

034Next

035 

036If CMGs = 0 Then

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

038   Exit Function

039End If

040 

041If 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, "提示"

061Else

062   Dim MMs As String * 5

063   MMs = "DPB="""

064   Put #1, CMGs, MMs

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

066End If

067Close #1

068End Function

069 

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

071 

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

073 

074Private Sub CommandButton1_Click()

075 

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

077 

078End Sub

079 

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

081 

082Private Sub VBAPassword()

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

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

085If Dir(Filename) = "" Then

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

087Exit Sub

088Else

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

090End If

091 

092Dim GetData As String * 5

093Open Filename For Binary As #1

094Dim CMGs As Long

095Dim DPBo As Long

096For i = 1 To LOF(1)

097Get #1, i, GetData

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

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

100Next

101 

102If CMGs = 0 Then

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

104Exit Sub

105End If

106 

107If Protect = False Then

108Dim St As String * 2

109Dim s20 As String * 1

110 

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

112Get #1, CMGs - 2, St

113 

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

115Get #1, DPBo + 16, s20

116 

117'替换加密部份机码

118For i = CMGs To DPBo Step 2

119Put #1, i, St

120Next

121 

122'加入不配对符号

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

124Put #1, DPBo + 1, s20

125End If

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

127End If

128Close #1

129End Sub

130 

131 

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

133 

134 

135Private Sub VBAPassword()

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

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

138 

139If Dir(Filename) = "" Then

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

141Exit Sub

142Else

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

144End If

145 

146Dim GetData As String * 5

147Open Filename For Binary As #1

148Dim CMGs As Long

149Dim DPBo As Long

150For i = 1 To LOF(1)

151Get #1, i, GetData

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

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

154Next

155 

156If CMGs = 0 Then

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

158Exit Sub

159End If

160 

161 

162Dim St As String * 2

163Dim s20 As String * 1

164 

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

166Get #1, CMGs - 2, St

167 

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

169Get #1, DPBo + 16, s20

170 

171'替换加密部份机码

172For i = CMGs To DPBo Step 2

173Put #1, i, St

174Next

175 

176'加入不配对符号

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

178Put #1, DPBo + 1, s20

179End If

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

181 

182Close #1

183End Sub

184 

185'VBA代码引用自:

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