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