用VBA加密的excel怎么破解
求大神帮忙弄一下
先把VBA工程密码破解,然后查看工作表(簿)的密码。
Public Sub 破解VBA密码()
Dim Filename As String
'你要解保护的excel文件路径
Filename = Application.GetOpenFilename("excel文件(*.xls & *.xla & *.xlt),*.xls;*.xla;*.xlt", , "VBA破解")
If Dir(Filename) = "" Then
MsgBox "没找到相关文件,请重新设置。"
Exit Sub
Else
Dim newFilename As String
newFilename = Filename & Date & Hour(Now) & Minute(Now) & Second(Now) & ".bak"
FileCopy Filename, newFilename '备份文件。
End If
Dim GetData As String * 5
'Open 路径文件名 For 打开方式 [Access 可进行的操作] [限定的操作] As [#]文件号 [Len=记录或字符长度]
Open Filename For Binary As #1
Dim CMGs As Long
Dim DPBo As Long
For i = 1 To LOF(1)
'Get [#]已打开的文件号, [开始读出数据的记录号], 读出数据存放的变量名
Get #1, i, GetData
If GetData = "CMG=""" Then
CMGs = i
End If
If GetData = "[Host" Then
DPBo = i - 2
Exit For
End If
Next i
If CMGs = 0 Then
MsgBox Filename & vbNewLine & vbNewLine & "VBA编码没有保护密码!", 32, "提示"
Close #1
Kill newFilename '删除刚刚备份的文件
Exit Sub
End If
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 Filename & vbNewLine & vbNewLine & "文件解密成功!" & vbNewLine & vbNewLine & "原文件有备份!", 32, "提示"
Close #1
End Sub
你不如公布一下需要破解的文件,让大家都来试试
上一篇:MYSQL安装初始化时报错