Excel VBA工程密码破解

本文介绍了一种破解Excel VBA工程密码的方法,并提供了一个VBA程序实现。该程序能够解除或设置VBA项目的保护密码,适用于需要恢复丢失密码的情况。

今天一个朋友让我看一个Excel的VBA程序。说是里面的工程打不开,需要密码让帮忙破解一下。

后来上网查找了一些相关的VBA工程保护内容。做了一个破解密码的VBA程序。把主要的列出来吧

ContractedBlock.gifExpandedBlockStart.gifCode
 1'移除VBA编码保护
 2Sub MoveProtect()
 3    Dim FileName As String
 4    FileName = Application.GetOpenFilename("Excel文件(*.xls & *.xla),*.xls;*.xla", , "VBA破解")
 5    If FileName = CStr(FalseThen
 6       Exit Sub
 7    Else
 8       VBAPassword FileName, False
 9    End If
10End Sub
11
12'设置VBA编码保护
13Sub SetProtect()
14    Dim FileName As String
15    FileName = Application.GetOpenFilename("Excel文件(*.xls & *.xla),*.xls;*.xla", , "VBA破解")
16    If FileName = CStr(FalseThen
17       Exit Sub
18    Else
19       VBAPassword FileName, True
20    End If
21End Sub
22
23Private Function VBAPassword(FileName As String, Optional Protect As Boolean = False)
24      If Dir(FileName) = "" Then
25         Exit Function
26      Else
27         FileCopy FileName, FileName & ".bak"
28      End If
29
30      Dim GetData As String * 5
31      Open FileName For Binary As #1
32      Dim CMGs As Long
33      Dim DPBo As Long
34      For i = 1 To LOF(1)
35          Get #1, i, GetData
36          If GetData = "CMG=""" Then CMGs = i
37          If GetData = "[Host" Then DPBo = i - 2Exit For
38      Next
39     
40      If CMGs = 0 Then
41         MsgBox "请先对VBA编码设置一个保护密码"32"提示"
42         Exit Function
43      End If
44     
45      If Protect = False Then
46         Dim St As String * 2
47         Dim s20 As String * 1
48        
49         '取得一个0D0A十六进制字串
50         Get #1, CMGs - 2, St
51     
52         '取得一个20十六制字串
53         Get #1, DPBo + 16, s20
54     
55         '替换加密部份机码
56         For i = CMGs To DPBo Step 2
57             Put #1, i, St
58         Next
59        
60         '加入不配对符号
61         If (DPBo - CMGs) Mod 2 <> 0 Then
62            Put #1, DPBo + 1, s20
63         End If
64         MsgBox "文件解密成功"32"提示"
65      Else
66         Dim MMs As String * 5
67         MMs = "DPB="""
68         Put #1, CMGs, MMs
69         MsgBox "对文件特殊加密成功"32"提示"
70      End If
71      Close #1
72End Function
73

 

其实OFFICE这套东西的密码都算是比较好破解的。 尤其是ACCESS的密码。简直和没有一样。呵呵~~!

转载于:https://www.cnblogs.com/smallvv/archive/2009/06/12/1502008.html

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值