[AccessD] DBEngine.CompactDatabase - Supplying Passwordargumentfor currently open db.

A.D.TEJPAL adtp at airtelbroadband.in
Wed Apr 26 23:51:19 CDT 2006


Marty,

    Really amazing, the way you come up with such gems. Thanks again.

A.D.Tejpal
---------------

  ----- Original Message ----- 
  From: MartyConnelly 
  To: Access Developers discussion and problem solving 
  Sent: Thursday, April 27, 2006 01:29
  Subject: Re: [AccessD] DBEngine.CompactDatabase - Supplying Passwordargumentfor currently open db.


  I knew I had it somewhere from a couple of years ago, this works for 
  Access 2000-2003
  They use an XOR on the file creation datestamp, now this method may not work in some situations like an mde or an encrypted file, I haven't checked.

  Now everyone should know this method of security is easily circumvented.
  so I am posting it here. Variations of this code are available on the web.

  Dim NullDate As Date
  Private Declare Function GetTempPath Lib "kernel32.dll" Alias 
  "GetTempPathA" (ByVal nBufferLength As Long, _
  ByVal lpBuffer As String) As Long
  Private Declare Function GetTempFileName Lib "kernel32.dll" Alias 
  "GetTempFileNameA" (ByVal lpszPath As String, _
  ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal 
  lpTempFileName As String) As Long

  Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
  End Type

  Private Type BY_HANDLE_FILE_INFORMATION
  dwFileAttributes As Long
  ftCreationTime As FILETIME
  ftLastAccessTime As FILETIME
  ftLastWriteTime As FILETIME
  dwVolumeSerialNumber As Long
  nFileSizeHigh As Long
  nFileSizeLow As Long
  nNumberOfLinks As Long
  nFileIndexHigh As Long
  nFileIndexLow As Long
  End Type

  Private Type SYSTEMTIME
  wYear As Integer
  wMonth As Integer
  wDayOfWeek As Integer
  wDay As Integer
  wHour As Integer
  wMinute As Integer
  wSecond As Integer
  wMilliseconds As Integer
  End Type

  Private Const OFS_MAXPATHNAME = 128
  Private Const OF_READ = &H0

  Private Type OFSTRUCT
  cBytes As Byte
  fFixedDisk As Byte
  nErrCode As Integer
  Reserved1 As Integer
  Reserved2 As Integer
  szPathName(OFS_MAXPATHNAME) As Byte
  End Type

  Private Declare Function GetFileInformationByHandle Lib "kernel32" 
  (ByVal hfile As Long, lpFileInformation As _
  BY_HANDLE_FILE_INFORMATION) As Long
  Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime 
  As FILETIME, lpSystemTime As _
  SYSTEMTIME) As Long
  Private Declare Function FileTimeToLocalFileTime Lib "kernel32" 
  (lpFileTime As FILETIME, lpLocalFileTime As _
  FILETIME) As Long
  Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As 
  String, lpReOpenBuff As OFSTRUCT, _
  ByVal wStyle As Long) As Long
  Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As 
  Long) As Long


  Public Function GetFileDate(File As String) As Date
  Dim fhi As BY_HANDLE_FILE_INFORMATION
  Dim ctime As FILETIME, atime As FILETIME, wtime As FILETIME
  Dim ftime As SYSTEMTIME
  Dim buff As OFSTRUCT
  Dim rval As Long, hfile As Long
  hfile = OpenFile(File, buff, OF_READ)
  If hfile = -1 Then
  GetFileDate = NullDate
  Else
  GetFileInformationByHandle hfile, fhi
  ctime = fhi.ftCreationTime
  'Convert File Time Zone to Local
  rval = FileTimeToLocalFileTime(ctime, ctime)
  'Convert File Time Format to System Time Format
  rval = FileTimeToSystemTime(ctime, ftime)
  GetFileDate = ftime.wDay & "/" & ftime.wMonth & "/" & ftime.wYear & " " 
  & ftime.wHour & ":" & ftime.wMinute & ":" & ftime.wSecond
  End If
  CloseHandle hfile
  End Function

  Public Function GuessAccess2000Password(ProtectedFile As String) As String
  ' The trick of this function is that Access 2000 codifies your password by
  ' making the XOR of it and a mask. I don't know the algorithm to get 
  this mask
  ' but I do know that it only depends on the creation date of the database.
  ' So the proccess is: create a dummy database with the same date as the 
  protected
  ' database, and then make the XOR of the encrypted bytes of the 
  protected database
  ' and the password-less database we create in this process.
  Dim n As Long, s1 As String * 1, s2 As String * 1
  Dim Password As String
  Dim x1 As Byte, x2 As Byte
  Dim TempFile As String
  Dim DateFile As Date, PreviousDate As Date
  Dim Handle1 As Long, Handle2 As Long

  ' Get the creation date of the protected database
  DateFile = GetFileDate(ProtectedFile)
  If DateFile = NullDate Then
  GuessAccess2000Password = "Can't open database file. Maybe you have it 
  open in exclusive mode"
  Exit Function
  End If
  ' Create a temporary file in the Temp directory of windows
  TempFile = TempPath & "temp.mdb"
  ' Remove the temporary file if it exists
  If Dir(TempFile) <> "" Then
  Kill TempFile
  End If

  ' Keep the system date, then set it to the same date as the protected 
  database
  PreviousDate = Date
  Date = DateFile
  ' Create the database, which will have so the same date as the protected 
  database
  CreateDatabase TempFile, dbLangGeneral

  ' We can restore now the real date
  Date = PreviousDate

  Handle1 = FreeFile
  Open TempFile For Binary As #Handle1
  Handle2 = FreeFile
  Open ProtectedFile For Binary As #Handle2
  Password = ""
  Seek #Handle1, &H43
  Seek #Handle2, &H43
  ' The maximum length of the password is 20 characters
  For n = 0 To 19
  x1 = Asc(Input(1, Handle1))
  x2 = Asc(Input(1, Handle2))
  If x1 <> x2 Then
  Password = Password & Chr(x1 Xor x2)
  End If
  ' We skip the even positions, because the password is stored using
  ' two bytes per character
  x1 = Asc(Input(1, Handle1))
  x2 = Asc(Input(1, Handle2))
  Next
  Close 1
  Close 2
  Kill TempFile
  GuessAccess2000Password = Password
  End Function

  Private Function TempPath() As String
  ' Generate a temporary file path to ?????.TMP, where (path)
  ' is Windows's temporary file directory and ???? is a randomly assigned 
  unique value.
  ' Then display the name of the created file on the screen.
  Dim Path As String ' receives name of temporary file path
  Dim TempFile As String ' receives name of temporary file
  Dim slength As Long ' receives length of string returned for the path
  Dim lastfour As Long ' receives hex value of the randomly assigned ????
  ' Get Windows's temporary file path
  Path = Space(255) ' initialize the buffer to receive the path
  slength = GetTempPath(255, Path) ' read the path name
  TempPath = Left(Path, slength) ' extract data from the variable
  End Function

  Sub testit()
  ' NOte 1: Put a reference to Microsoft DAO 3.6
  ' Note 2: You cannot have the database opened in exclusive mode while 
  you execute this procedure
  Debug.Print GuessAccess2000Password("C:\Access files\Security\Access 
  2003 Security Macro\Macro security for runtime.mdb")
  End Sub



  A.D.TEJPAL wrote:

  >    My sincere thanks Marty!  I shall explore the feasibility of adapting it to current version.
  >
  >A.D.Tejpal
  >---------------
  >
  >  ----- Original Message ----- 
  >  From: MartyConnelly 
  >  To: Access Developers discussion and problem solving 
  >  Sent: Wednesday, April 26, 2006 01:32
  >  Subject: Re: [AccessD] DBEngine.CompactDatabase - Supplying Passwordargument for currently open db.
  >
  >
  >  For 97 this was easy
  >  http://www.trigeminal.com/code/DatabasePassword.bas
  >
  >
  >  A.D.TEJPAL wrote:
  >
  >  >    For making a back-up copy of currently open FE and then compacting this back-up copy, using  DBEngine.CompactDatabase method, database password if existing, has to be passed as the last argument, e.g.
  >  >
  >  >    DBEngine.CompactDatabase "SourceFilePath", _
  >  >                "DestinationFilePath", , , ";pwd=xyz"
  >  >
  >  >    Could there be a way to get the password for currently open db,  without prompting the user for it ?
  >  >
  >  >    Note - Application.CompactRepair method seems ruled out as it does not have any password argument in its syntax and instead prompts the user for it.
  >  >
  >  >TIA
  >  >A.D.Tejpal
  >  >---------------


More information about the AccessD mailing list