用VBA加密的excel怎么破解 - 爱问答

(爱问答)

用VBA加密的excel怎么破解

大神帮忙弄一下

先把VBA工程密码破解,然后查看工作表(簿)的密码。

用VBA加密的excel怎么破解

用VBA加密的excel怎么破解

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

你不如公布一下需要破解的文件,让大家都来试试

相关标签:破解excel

下一篇:用VB产生随机数如何保证产生的随机数各不相同

上一篇:MYSQL安装初始化时报错

热门标签:
excel 网盘 破解 word dll
最新更新:
微软重新评估新的Outlook的使用时机 联想推出搭载联发科Helio G80芯片组的Tab M9平板 英特尔创新大赛时间确定! 微软Edge浏览器在稳定渠道中推出Workspaces功能 英伟达RTX4060TiGPU推出MaxSun动漫主题! 谷歌地图为用户提供了街景服务! GameSir 在T4 Kaleid中推出了一款出色的控制器! 微软开始在Windows 11 中测试其画图应用程序的新深色模式! LG电子推出全球首款无线OLED电视 英伟达人工智能芯片崭露头角! Steam Deck可以玩什么游戏-Steam Deck价格限时优惠 雷蛇推出CobraPro鼠标 Kindle电子阅读器可以访问谷歌商店吗 Windows10如何加入组策略 window10图片查看器怎么没有了?