如何删除MS Access VB项目的密码?



我有一个MS Access数据库,其中包含一个受密码保护的VB项目。密码未知。Access 数据库本身没有密码,所以我可以打开它:我只是无法在 VBE 中展开 VB 项目树。

如果这是Excel,那将是一件简单的事情。绕过Excel VB项目密码的优秀指南可以在Stack Overflow上找到:有没有办法破解Excel VBA项目的密码?

虽然上面引用的答案中的代码似乎不是特定于应用程序的,但我无法让它与 Access 一起使用。我相信这是因为在Excel中,同一个应用程序对象可以包含多个工作簿,因此即使一个工作簿的VB项目受密码保护,您也可以从另一个工作簿中的模块运行此代码 - 并且保护删除将应用于应用程序中的所有工作簿。

但是,在 Access 中,应用程序对象一次只保存一个当前数据库。我看不到在同一应用程序中打开多个数据库的方法。我尝试的是在新应用程序中创建一个新的 Access VB 项目:根据 Excel 答案插入密码删除模块;然后从该 VB 项目中,执行一个创建新的 Access 应用程序的子,并将受保护的数据库加载到其中 - 在运行取消保护脚本之前。然而,这没有奏效。该脚本似乎无法跨应用程序的单独实例工作 - 即使它们在运行时都被识别。

在我的工作环境中,我无法安装新软件,也无法访问十六进制编辑器。因此,有没有办法破解MS Access VB项目密码?

澄清

关于提供代码示例,我是Stack Exchange的长期用户,并且非常熟悉新用户在"你能帮我吗?"的情况下提出问题的问题,而没有实际显示他们的代码:但是问题并不总是需要包含代码。

如果有帮助,我一直在尝试如下:

Sub DoVBA()
Dim app As Application
Dim filepath As String
'filepath = Application.CurrentProject.Path & "CCD-QAF_v0.6.mdb"
filepath = Application.CurrentProject.Path & "CCD-QAF_v0.6_OC2016.accdb"
'
Set app = New Application
app.Visible = True
app.OpenCurrentDatabase filepath
unprotected ' Calls sub which works in Excel
End Sub
Sub unprotected()
If Hook Then
MsgBox "VBA Project is unprotected!", vbInformation, "*****"
End If
End Sub

.. 然后在不同的模块中:

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

以上内容是从链接问题中的 Excel 示例中复制的,该示例在 Excel 中完美运行 - 但在 Access 中没有任何作用。这可能是因为在 Excel 中,您可以在一个工作簿中运行此代码 - 该工作簿作用于同一 Excel 应用程序中运行的所有其他工作簿。但是,Access 只允许每个应用程序一个数据库。

只需直接在HeX编辑器中打开.accdb文件即可。 其余部分类似于 Excel 指令。

更改 DPB=...字符串到 DPx=...

(必须在十六进制编辑器中调整 3 个位置,在 excel 示例中只能在一个位置进行调整(

最新更新