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?
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.