La siguiente función permite compactar una base de datos de access, requiere que se importe la biblioteca de tipos
Microsoft Jet And Replication Objects 2.x
Código Delphi
[-]
function PackMdbFile(_Name, _pass: String; Verbose:Boolean): Boolean;
var
JE : TJetEngine; mdbDest,ConStrOri, ConStrDest: WideString;
sizei,sizef:Real;
begin
sizei:=FileSizeByName(_Name)/1024;
mdbDest:=ExtractFilePath(_name)+'\tmp~'+ExtractFileName(_Name);
ConStrOri:= 'Provider=Microsoft.Jet.OLEDB.4.0;Password="";User ID=Admin;Data Source='+
_Name+';Mode=Share Deny None;Extended Properties="";Jet OLEDB:System'+
' database="";Jet OLEDB:Registry Path="";Jet OLEDB:Database Password='+_pass+
';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';
ConStrDest:= 'Provider=Microsoft.Jet.OLEDB.4.0;Password="";User ID=Admin;Data Source='+
mdbDest+';Mode=Share Deny None;Extended Properties="";Jet OLEDB:System'+
' database="";Jet OLEDB:Registry Path="";Jet OLEDB:Database Password='+_pass+
';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';
if FileExists(mdbDest) then DeleteFile(mdbDest);
JE:= TJetEngine.Create(Nil);
try
try
JE.CompactDatabase(ConStrOri, ConStrDest);
sizef:=FileSizeByName(mdbDest)/1024;
DeleteFile(_Name);
RenameFile(mdbDest, _Name);
if Verbose then ShowMessage('Hecho, mdb compactada de '+FloatToStr(sizei)+' Kb a '+FloatToStr(sizef)+' Kb');
PackMdbFile:=True;
except
on E:Exception do
begin
__Error:=('Excepcion :'+E.Message);
PackMdbFile:=False;
end;
end;
finally
JE.FreeOnRelease;
end;
end;