先选择Project-->import Type Library
选择Microsoft Jet and Replication Objects 2.6 Library(Version2.6)
或者
Microsoft Jet and Replication Objects 2.5 Library(Version2.5)
点击Install
然后使用下面函数
function getCurPath: string;
begin
Result := ExtractFilePath(Application.ExeName);
end;
procedure CompactDB(const DBname, DBtype, DBpass: string); //DBname数据库名,DBtype:Access数据库类型 值为97或者2000,DBpass:数据库密码
var
MyJetEngine: JetEngine;
strDataSource,
strDataDest,
strDataDestName: string;
begin
if not FileExists(DBname) then
begin
writeln('Error: ''', DBName, ''' not found.');
exit;
end;
// delete any previous temporary mdb file
strDataDestName := ExtractFilePath(DBname) + 'temp.mdb';
if FileExists(StrDataDestName) then
begin
DeleteFile(strDataDestName);
//writeln('Previous temporary file ', strDataDestName, ' deleted.');
end;
strDataSource := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + DBname +
';Jet OLEDB
atabase Password=' + '"' + DBpass + '"' + ';';
strDataDest := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' +
strDataDestName + ';Jet OLEDB
atabase Password=' + '"' + DBpass + '"' +
';';
// default to Access 2000 format unless 97 format is specified
{ default changed 30 Sep 2000 DRS }
if DBtype = '97' then
// Use Engine Type 4 for Access 97 db
strDataDest := strDataDest + 'Jet OLEDB:Engine Type=4'
else
// Use Engine Type 5 for Access 2000 db
strDataDest := strDataDest + 'Jet OLEDB:Engine Type=5';
MyJetEngine := CoJetEngine.Create();
try
MyJetEngine.CompactDatabase(strDataSource, strDataDest);
//writeln(DBname, ' compacted into ', strDataDestName + '.');
MyJetEngine := nil;
if DeleteFile(DBname) then
begin
// writeln(DBname, ' deleted.');
if RenameFile(strDataDestName, DBName) then
// writeln(strDataDestName, ' renamed ', DBname + '.')
else
// writeln('Error: ', strDataDestName, ' could not be renamed ', DBname, '.');
end
else
// writeln('Error: ', DBname, ' could not be deleted.');
except
//on E: Exception do writeln('Error: ', E.Message);
end
end;
例子:
procedure TfrmMain.Button3Click(Sender: TObject);
begin
dm1.ADOConnection1.Connected := false;
MessageDlg('请点击 OK 开始压缩,请耐心等待! ', mtInformation,
[mbOk], 0);
CompactDB(getCurPath + 'test.mdb', '2000', 'password');
MessageDlg(' 压缩完毕! ', mtInformation,
[mbOk], 0);
dm1.ADOConnection1.Connected := true;
end;