0

.MDA ファイルもあるため、.MDB ファイルで動作する非常に古い VB 16 ビット アプリケーションがあります。テーブル、関係、およびコンテンツを取得する必要があります。表のデータは「デンマーク語」です。

私の上司には著作権がありますが、管理者のユーザー名とパスワードはありません。アプリケーションは正常に動作します。つまり、アプリケーションは MDB ファイルに接続して操作できます。Windows 7 32ビットマシンで実行しています。

データベースが暗号化されているようです。彼らはRC4エンコーディングを使用しており、.MDBヘッダーにはそのためのキーが含まれていることがわかりました。

エンコードされた .MDB からテーブルとデータを取得する方法はありますか? mdb ロック解除ツールを試してみましたが、ほとんどのツールは .mdb であることを認識しませんが、アプリケーションは機能します。

私は解決策を見つけるために必死です。どんな助けでも大歓迎です。

4

1 に答える 1

0

彼らは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") を実行する必要があります。

于 2013-04-22T22:47:18.737 に答える