如何撤消修复VBA密码?

时间:2018-04-10 17:38:38

标签: excel vba excel-vba

我使用了Đức Thanh Nguyễn提供的修补程序来解决Is there a way to crack the password on an Excel VBA Project?上的密码问题。不幸的是,这使我的机器处于不再保护所有新Excel文件的VBA的状态!这是他的代码:

在第1单元中:

Option Explicit

Private Const PAGE_EXECUTE_READWRITE = &H40

Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As Long, Source As Long, ByVal Length As Long)

Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Long, _
    ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long

Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long

Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, _
    ByVal lpProcName As String) As Long

Private Declare Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA"     (ByVal hInstance As Long, _
    ByVal pTemplateName As Long, ByVal hWndParent As Long, _
    ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer

Dim HookBytes(0 To 5) As Byte
Dim OriginBytes(0 To 5) As Byte
Dim pFunc As Long
Dim Flag As Boolean

Private Function GetPtr(ByVal Value As Long) As Long
    GetPtr = Value
End Function

Public Sub RecoverBytes()
    If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 6
End Sub

Public Function Hook() As Boolean
Dim TmpBytes(0 To 5) As Byte
Dim p As Long
Dim OriginProtect As Long

Hook = False

pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")


If VirtualProtect(ByVal pFunc, 6, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then

    MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6
    If TmpBytes(0) <> &H68 Then

        MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6

        p = GetPtr(AddressOf MyDialogBoxParam)

        HookBytes(0) = &H68
        MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4
        HookBytes(5) = &HC3

        MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 6
        Flag = True
        Hook = True
    End If
End If
End Function

Private Function MyDialogBoxParam(ByVal hInstance As Long, _
    ByVal pTemplateName As Long, ByVal hWndParent As Long, _
    ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer
If pTemplateName = 4070 Then
    MyDialogBoxParam = 1
Else
    RecoverBytes
    MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
                       hWndParent, lpDialogFunc, dwInitParam)
    Hook
End If
End Function

在第2单元中:

Sub unprotected()
    If Hook Then
        MsgBox "VBA Project is unprotected!", vbInformation, "*****"
    End If
End Sub

我尝试的是在If例程中注释MyDialogBoxParam语句的第一个子句,使每个传递都经历RecoverBytes步骤以及随后的两个步骤。没运气。谁能帮忙???谢谢!

2 个答案:

答案 0 :(得分:1)

事实证明我的验证存在缺陷。我正在创建一个全新的启用宏的Excel文件,并测试代码中的密码是否保持不变。事实证明,如果你把密码放在一个完全没有添加代码的宏启用Excel文件中(可能根本没有对Excel文件进​​行任何更改,我不确定),密码和保护不会坚持在保留密码和保护标志之前,您必须在代码中添加一些内容。叹息...

感谢所有帮助过的人!

答案 1 :(得分:-1)

重新启动计算机应解决问题 (通常应该是“任何”无法解释的问题的第一个故障排除步骤。)

另外,下次使用this method破解Office密码......