编码的 MDB 表和内容

Posted 2023-05-06

【中文标题】编码的 MDB 表和内容

【英文标题】：Encoded MDB tables and contents

【发布时间】：2013-04-22 22:23:45

【问题描述】：

我有一个非常旧的 VB 16 位应用程序，它可以与 .MDB 文件一起使用，因为还有一个 .MDA 文件——因此我猜它是使用 access 2.0 制作的。需要把我们的表格、关系和内容拿出来。表格数据采用“丹麦语”语言。

我的老板确实有版权，但没有管理员用户名和密码。应用程序运行良好，这意味着应用程序能够连接到 MDB 文件并使用它。我在 Windows 7 32 位机器上运行它。

似乎数据库已编码。才知道他们使用 RC4 编码并且 .MDB 标头包含它的密钥。

有没有办法从编码的 .MDB 中获取表和数据。我已经尝试过我的 mdb 解锁工具，其中大多数都无法识别它是 .mdb，但该应用程序可以正常工作。

我迫切希望找到解决方案。非常感谢任何帮助。

【参考方案1】：

知道他们使用 RC4 编码并且 .MDB 标头包含用于 它。有没有办法从编码的 .MDB 中获取平板电脑和数据。

您必须使用对象模型代码从 Access 数据库文件中删除所有内容。这是从 损坏的 Access 数据库中提取数据的脚本：

   Function FilterDB(strFilePath As String)
   Dim objAccess As Object
   Dim strFolder As String
   Dim strCurrentFile As String
   Dim strCurrentObject As String
   Dim strFilteredDB As String

   Dim fs
   Dim Ref
   Dim f As Object
   Dim objtype As AcObjectType

   Dim objAllObjects As New Collection
   Dim objObjectGroup As Object
   Dim intObjType As Integer
   Dim i As Integer
   Dim j As Integer
   Dim intRefNum As Integer

   Dim RefItem As Reference
   Dim arrayRefs() As String

   Dim strErrMsg As String

   'Open the source database
   Set objAccess = CreateObject("Access.Application.10")

   On Error GoTo ErrorHandler

   objAccess.OpenCurrentDatabase strFilePath, False

   strFolder = Left(strFilePath, InStrRev(strFilePath, "\", Len(strFilePath)))
   strFilteredDB = Left(strFilePath, Len(strFilePath) - 4) & "filtered.mdb"

   With objAllObjects
       .Add objAccess.CurrentData.AllQueries
       .Add objAccess.CurrentProject.AllForms
       .Add objAccess.CurrentProject.AllReports
       .Add objAccess.CurrentProject.AllMacros
       .Add objAccess.CurrentProject.AllModules
       .Add objAccess.CurrentProject.AllDataAccessPages
   End With

   Set fs = CreateObject("Scripting.FileSystemObject")

   If Not fs.folderexists(strFolder & "\texttmp") Then
       fs.CreateFolder (strFolder & "\texttmp")
   End If

   For i = 1 To objAllObjects.Count

       If objAllObjects(i).Count > 0 Then
           For j = 0 To objAllObjects(i).Count - 1
              
              Set objObjectGroup = objAllObjects(i)
    
              strCurrentObject = objObjectGroup(j).Name
              intObjType = objObjectGroup(j).Type
              objAccess.SaveAsText intObjType, strCurrentObject, _
              strFolder & "texttmp\" & strCurrentObject & intObjType & ".txt"
         
           Next j
       End If
       
   Next i
    
   'Bring in All the references
   On Error Resume Next
         
   ReDim arrayRefs(objAccess.References.Count - 1, 2) As String
         
   For Each RefItem In objAccess.References()
       If Not IsError(RefItem.Name) Then
            
           arrayRefs(intRefNum, 0) = RefItem.Name
           arrayRefs(intRefNum, 1) = RefItem.FullPath
           intRefNum = intRefNum + 1
           
       End If
   Next RefItem

   On Error GoTo ErrorHandler
    
   Debug.Print ""
   objAccess.Quit
   Set objAccess = Nothing

   Set objAccess = CreateObject("Access.Application")

   objAccess.NewCurrentDatabase strFilteredDB

   'Finds the first occurrence of a text file in the
   'texttmp folder.
   strCurrentFile = Dir(strFolder & "\texttmp" & "\*.txt")
          
   'Count the files in the folder.
   Set f = fs.GetFolder(strFolder)
          
   'Check to see if the folder is empty.
   'If not, load in all the files from there
   If f.Files.Count <> 0 Then

   Do Until strCurrentFile = ""
      intObjType = Mid(strCurrentFile, Len(strCurrentFile) - 4, 1)
      objAccess.LoadFromText intObjType, _
      Left(strCurrentFile, Len(strCurrentFile) - 5), _
      strFolder & "\texttmp\" & strCurrentFile
      strCurrentFile = Dir
   Loop
   End If
          

   On Error Resume Next

   For i = 0 To UBound(arrayRefs())

       Set Ref = objAccess.References.AddFromFile(arrayRefs(i, 1))
       
   Next i

   MsgBox "Finished creating filtered file:" & Chr(10) _
   & objAccess.CurrentProject.FullName & "."

FunctionEnd:

   On Error Resume Next
   Set fs = CreateObject("Scripting.FileSystemObject")

   If fs.folderexists(strFolder & "\texttmp") Then
       fs.deletefolder (strFolder & "\texttmp")
   End If

   objAccess.Quit
   Set objAccess = Nothing
   Set f = Nothing

   Exit Function

ErrorHandler:

   Select Case Err.Number

       Case 58, 7866
       strErrMsg = "The path\file name " & strFilePath _
           & " may be incorrect or the " _
           & Chr(10) & " database is opened exclusively by someone else." _
           & Chr(10) & Chr(10) & _
           "Please insure your path and file name are correct " _
           & Chr(10) & "and the database is not open."

       Case 7865
       strErrMsg = "The follwing database:" & Chr(10) & Chr(10) _
           & strFilteredDB & Chr(10) & Chr(10) _
           & "already exists." _
           & Chr(10) & Chr(10) & _
           " Please rename, move, or delete it before running" _
           & "the FilterDB function."

       Case Else
       strErrMsg = "Access Error #" & Err.Number & Chr(10) & Chr(10) & _
       Err.Description
           
   End Select

   MsgBox strErrMsg

   GoTo FunctionEnd

   End Function

我今天不得不使用这个代码。您必须复制数据库，然后将上述代码粘贴到模块中，然后从即时窗口运行 mod.FilterDB("E:\PathToTheCopy.mdb")

【讨论】：

谢谢杰里米，我会试试的

嗨 Jeremy，我尝试了上面的代码，但出现错误 - 路径不正确或由其他人专门打开。我想提供一些我反编译的Application的更多信息，看看是否能得到任何线索。

有一个函数 fn007A SetDefaultWorkspace fn007A(1, gv0042), fn007A(2, gv0042) ôÖki¼§eü³®Ëâ¨U%þêæ»&þ¸*-¾m,5ä

当我尝试上面的代码时，我很确定它在那个路径中并且不会被任何其他应用程序打开，因为我尝试通过重新启动和系统运行此代码作为第一件事。

@Jermey 你能看看我写了一些 cmets