Compact An Access Database

Question

I am attempting to compact a Microsoft Access database but the code shown below does not work.

procedure TForm1.Disconnect1Click(Sender: TObject);
begin
  ADODataSet1.Active := False;
  ADOTable1.Active := False;
  ADODataSet1.Connection := nil;
  DataSource1.Enabled := False;
  ADOConnection1.Connected := False;
  JetEngine1.Disconnect;
end;

function DatabaseCompact(const sdbName: WideString): boolean;
{ Compact ADO mdb disconnected database. }
var
  iJetEngine: TJetEngine; { Jet Engine }
  iTempDatabase: WideString; { TEMP database }
  iTempConn: WideString; { Connection string }
const
  iProvider = 'Provider=Microsoft.Jet.OLEDB.4.0; Data Source=';
begin
  Result := False;
  iTempDatabase := ExtractFileDir(sdbName) + 'TEMP' + ExtractFileName(sdbName);
  iTempConn := iProvider + iTempDatabase;
  if FileExists(iTempDatabase) then
    DeleteFile(iTempDatabase);
  iJetEngine := TJetEngine.Create(Application);
  try
    try
      iJetEngine.CompactDatabase(iProvider + sdbName, iTempConn);
      DeleteFile(sdbName);
      RenameFile(iTempDatabase, sdbName);
    except
      on E: Exception do
        ShowMessage(E.Message);
    end;
  finally
    iJetEngine.FreeOnRelease;
    Result := True;
  end;
end;

procedure TForm1.Compact1Click(Sender: TObject);
var
  iResult: Integer;
begin
  AdvTaskDialog1.Clear;
  AdvTaskDialog1.Title := 'Compact Database';
  AdvTaskDialog1.Instruction := 'Compact Database';
  AdvTaskDialog1.Content := 'Compact the database?';
  AdvTaskDialog1.Icon := tiQuestion;
  AdvTaskDialog1.CommonButtons := [cbYes, cbNo];
  iResult := AdvTaskDialog1.Execute;
  if iResult = mrYes then
  begin
    Screen.Cursor := crHourglass;
    try
      DatabaseCompact('D:\RadProjects10\EBook Database\EBook Database.mdb');
      ADODataSet1.Connection := ADOConnection1;
      ADOConnection1.Connected := True;
    finally
      Screen.Cursor := crDefault;
    end;
  end;
end;

procedure TForm1.Connect1Click(Sender: TObject);
begin
  ADOConnection1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;' +
    'User ID=Admin;' +
    'Data Source=D:\RadProjects10\EBook Database\EBook Database.mdb;' +
    'Mode=Share Deny None;' + 'Jet OLEDB:System database="";' +
    'Jet OLEDB:Registry Path="";' + 'Jet OLEDB:Database Password="";' +
    'Jet OLEDB:Engine Type=5;' + 'Jet OLEDB:Database Locking Mode=1;' +
    'Jet OLEDB:Global Partial Bulk Ops=2;' +
    'Jet OLEDB:Global Bulk Transactions=1;' +
    'Jet OLEDB:New Database Password="";' +
    'Jet OLEDB:Create System Database=False;' +
    'Jet OLEDB:Encrypt Database=False;' +
    'Jet OLEDB:Don''t Copy Locale on Compact=False;' +
    'Jet OLEDB:Compact Without Replica Repair=False;' + 'Jet OLEDB:SFP=False;';
  ADODataSet1.Connection := ADOConnection1;
  ADOConnection1.Connected := True;
  ADODataSet1.Active := True;
  ADOTable1.Active := True;
  DataSource1.Enabled := True;
end;

Even though I disconnect the database before compacting I get an error message:

You attempted to open a database that is already opened exclusively by the user 'Admin' on the machine 'xxxx'. Try again when the database is available.

I disconnect and then compact but something is going wrong. I understand that it is good to compact an Access database, so I am attempting to do this with a small application I wrote to store contact information.

Apparently the code I used to disconnect from the database is not working. Where did I fail?

Bucksaw

Answer 1

After closing the TADOConnection and ALL DataSets associated with it, you need to make sure the db is unlocked. Remember that other users might be connected to the db and in that case you cannot compact it.

Before actually compressing the db you have to give the jet engine a bit of time to actually close the connection, flush, and unlock the db. Then test if the db is locked (try to open for exclusive use).

Here is the method I use, which always worked for me:

uses ComObj;

procedure JroRefreshCache(ADOConnection: TADOConnection);
var
  JetEngine: OleVariant;
begin
  if not ADOConnection.Connected then Exit;
  JetEngine := CreateOleObject('jro.JetEngine');
  JetEngine.RefreshCache(ADOConnection.ConnectionObject);
end;

procedure JroCompactDatabase(const Source, Destination: string);
var
  JetEngine: OleVariant;
begin
  JetEngine := CreateOleObject('jro.JetEngine');
  JetEngine.CompactDatabase(
    'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + Source,
    'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + Destination + ';Jet OLEDB:Engine Type=5');
end;

procedure CompactDatabase(const MdbFileName: string;
  ADOConnection: TADOConnection=nil;
  const ReopenConnection: Boolean=True);
var
  LdbFileName, TempFileName: string;
  FailCount: Integer;
  FileHandle: Integer;
begin
  TempFileName := ChangeFileExt(MdbFileName, '.temp.mdb');
  if Assigned(ADOConnection) then
  begin
    // force the database engine to write data to disk, releasing locks on memory
    JroRefreshCache(ADOConnection);
    // close the connection - this will also close all associated datasets
    ADOConnection.Close;
  end;
  // ADOConnection.Close SHOULD delete the ldb
  // force delete of ldb lock file just in case if we don't have an active ADOConnection
  LdbFileName := ChangeFileExt(MdbFileName, '.ldb');
  if FileExists(LdbFileName) then
    DeleteFile(LdbFileName); // could fail because data is still locked - we ignore this
  // delete temp file if any
  if FileExists(TempFileName) then
    if not DeleteFile(TempFileName) then
       RaiseLastOSError;
  // try to open for exclusive use
  FailCount := 0;
  repeat
    FileHandle := FileOpen(MdbFileName, fmShareExclusive);
    try
      if FileHandle = -1 then // error
      begin 
        Inc(FailCount);
        Sleep(100); // give the database engine time to close completely and unlock
      end
      else
      begin
        FailCount := 0;
        Break; // success
      end;
    finally
      FileClose(FileHandle);
    end;
  until FailCount = 10; // maximum 1 second of attempts      
  if FailCount <> 0 then // file is probably locked by another user/process        
    raise Exception.Create(Format('Error opening %s for exclusive use.', [MdbFileName]));
  // compact the db
  JroCompactDatabase(MdbFileName, TempFileName);
  // copy temp file to original mdb and delete temp file on success
  if Windows.CopyFile(PChar(TempFileName), PChar(MdbFileName), False) then
    DeleteFile(TempFileName)
  else
    RaiseLastOSError;
  // reopen ADOConnection
  if Assigned(ADOConnection) and ReopenConnection then
    ADOConnection.Open;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CompactDatabase('F:\Projects\DB\mydb.mdb', ADOConnection1, True);
  // reopen DataSets
  ADODataSet1.Open;
end;

---

Make sure that your TADOConnection is NOT set to Connected in the IDE (Design mode).
Because if it does, there is another active connection to the db.

Bathtub

I tried your code but I still get if FailCount <> 0 then // file is probably locked by another user/process raise Exception.Create(Format('Error opening %s for exclusive use.', [MdbFileName])); Exception is raised in CompactDatabase. I also tried to increase FailCount from 10 to 100. My database is on a non-networked pc with only this app accessing the database. – Bucksaw

My previous comment noted an exception while the app was running in the XE4 IDE. I just tried the app by executing the EXE and the database was compacted with no exception? – Bucksaw

My guess is that your ADOConnection1 is set to Connected in the IDE? That means that another user is connected already. – Bathtub

Answer 2

uses ComObj;
// with or without password 
procedure CompactDatabasev2(const MdbFileName: string; const PW:string='');
var
     LdbFileName, TempFileName: string;
     FailCount: Integer;
     FileHandle: Integer;
     JetEngine: OleVariant;
begin
     TempFileName  :=  ChangeFileExt(MdbFileName, '.temp.mdb');
     LdbFileName  :=  ChangeFileExt(MdbFileName, '.ldb');
     if FileExists(LdbFileName) then
          DeleteFile(LdbFileName); // could fail because data is still locked - we ignore this
      if FileExists(TempFileName) then       // delete temp file if any
          if not DeleteFile(TempFileName) then
               RaiseLastOSError;
  // try to open for exclusive use
     FailCount  :=  0;
     repeat
          FileHandle  :=  FileOpen(MdbFileName, fmShareExclusive);
          try
               if FileHandle  =  -1 then // error
               begin
                    Inc(FailCount);
                    Sleep(100); // give the database engine time to close completely and unlock
               end
               else
               begin
                    FailCount  :=  0;
                    Break; // success
               end;
          finally
               FileClose(FileHandle);
          end;
     until FailCount  =  10; // maximum 1 second of attempts
     if FailCount  <>  0 then // file is probably locked by another user/process
          raise Exception.Create(Format('Error opening %s for exclusive use.', [MdbFileName]));
    if PW='' then
    // DB DE PAROLA YOKSA
    begin
     JetEngine  :=  CreateOleObject('jro.JetEngine');
     JetEngine.CompactDatabase(
                                 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='  +  MdbFileName
                               , 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='  +  TempFileName  +  ';Jet OLEDB:Engine Type=5'
                               );

   end
    else
     // DB PAROLA VARSA
    begin
     JetEngine  :=  CreateOleObject('jro.JetEngine');
     JetEngine.CompactDatabase(
                               'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='  + MdbFileName + ';Jet OLEDB:Database Password='+PW
                             , 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='  + TempFileName +';Jet OLEDB:Database Password='+PW+';Jet OLEDB:Engine Type=5') ;

    end;


  // copy temp file to original mdb and delete temp file on success
     if CopyFile(PChar(TempFileName), PChar(MdbFileName), False) then
          DeleteFile(TempFileName)
     else
          RaiseLastOSError;


end;

Ritchey