1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
| function CompactAccessDB(DB, MdP:string):Boolean;
var v:OLEvariant;
begin
Result:=False;
try
v:=CreateOLEObject('JRO.JetEngine');
try
if CopyFile(PChar(DB),PChar(DB+'.bak'),False) then // Sauvegarde de la base d'origine
begin
V.CompactDatabase('Provider=Microsoft.ACE.OLEDB.12.0;Data Source='+DB+';Jet OLEDB:Database Password='+MdP,
'Provider=Microsoft.ACE.OLEDB.12.0;Data Source='+DB+'comp'+';Jet OLEDB:Database Password='+MdP); // Compactage de la base d'origine
DeleteFile(DB); // Suppression de la base d'origine
RenameFile(DB+'comp',DB); // Mise en place de la base compactée
showmessage('Compactage réussi');
Result:=True;
end;
finally
V:=Unassigned;
showmessage('Pas de base de données');
end;
except
showmessage('Compactage non réussi');
Result:=False;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
CompactAccessDB(ExtractFilepath(application.ExeName)+'Base.accdb', '');
end; |
Partager