access压缩方法(100分)

大家有好的对ACCESS数据库进行压缩的方法吗？请指点一下。我的email:chenwcf@sina.com

假设此数据库的密码是 idlehagar

use JRO_TLB;
procedure CompactMdb;
const sProvider = 'Provider=Microsoft.Jet.OLEDB.4.0;';
var oJetEng: JetEngine;
　sOldMdb, sNewMdb: string;
begin
　sOldMdb := sProvider + 'Data Source=' + 'C:/Database/Test.mdb;'
　　+ 'Jet OLEDBatabase Password=idlehagar';
　sNewMdb := sProvider + 'Data Source=' + 'C:/Test.mdb;'
　　+ 'Jet OLEDBatabase Password=idlehagar';
　try
　　try
　　　oJetEng := CoJetEngine.Create;
　　　oJetEng.CompactDatabase(sOldMdb, sNewMdb);
　　　if FileExists('C:/Test.mdb') then begin
　　　　CopyFile('C:/Test.mdb', 'C:/Database/Test.mdb', False);
　　　　DeleteFile('C:/Test.mdb');
　　end;
　　except
　　　on E: Exception do
　　　　showmessage('Compact database failed');
　　end
　finally
　　oJetEng := nil;
　end;
end;

Microsoft Jet 4.0是ADO 2.x的一部分，使用它可以实现Access数据库的压缩与修复
program AccessCompact;

// ***************************************************************************
//
// AccessCompact compacts and repairs Access 97 and Access 2000 databases.
//
// Author: David Simpson (drs@ihug.com.au), 19 Feb 2000
//
// Minor changes: Bob Wasaff (bwasaff@suscom.net), 29 Sep 00 2000
// David Simpson, 30 Sep 2000
//
// ***************************************************************************

{$APPTYPE CONSOLE}

uses
SysUtils,
ActiveX,
JRO_TLB; // 'Microsoft Jet and Replication Objects 2.5 Library' or later
// C:/Program Files/Common Files/System/ADO/msjro.dll

procedure CompactDB(const DBname, DBtype: string);
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 + ';';
strDataDest := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + strDataDestName + ';';

// 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;

begin
if ParamCount = 0 then
begin
writeln('Error: Enter "ACCESSCOMPACT [/]?" for help.'); {Changed 29 Sep 2000 RVW}
halt;
end;
if (ParamStr(1) = '/?') or {Changed 29 Sep 2000 RVW}
(ParamStr(1) = '?') then
begin
write('AccessCompact compacts and repairs Access 97 and Access 2000 databases.');
writeln(' Compacting also rebuilds the database indexes.');
writeln;
writeln('ACCESSCOMPACT [drive:][path]filename [[/,-]97|2000]'); {Changed 29 Sep 2000 RVW}
writeln;
writeln(' [drive:][path]filename Mandatory. Specifies database to fix.');
writeln(' [97|2000] Database type of 97 or 2000. Default 2000.');
writeln;
write('This utility can be automated by using it from a command (.CMD)');
writeln(' file which is then scheduled with the AT command, or directly');
writeln(' using the NT Control Panel''s scheduler.');
end
else
begin
CoInitialize(nil);
if (ParamCount = 2) then
// default to Access 2000 format unless 97 format selected
if (Paramstr(2) = '-97') or {Changed 29 Sep 2000 RVW}
(Paramstr(2) = '/97') or
(Paramstr(2) = '97') then
CompactDB(ParamStr(1), '97')
else
CompactDB(ParamStr(1), '2000')
else
CompactDB(ParamStr(1), '2000');
end
end.

以上摘自中文开发在线

var
dao: OLEVariant;
tmp: String;
begin
if MessageDlg('真的要压缩修复数据库吗？',mtWarning,[mbYes,mbNo],0) = mrNo then
Exit;


tmp:= RepairConn.DefaultDatabase;
RepairConn.Connected:= False;
if POS('/',tmp)=0 then
begin
MessageDlg('对不起，只有Access数据库才能进行压缩操作！',mtWarning,[mbok],0);
Exit;
end;
try
dao := CreateOleObject('DAO.DBEngine.36');
except
MessageDlg('压缩失败！',mtError,[mbok],0);
Exit;
end;

try
if FileExists(tmp+'.mdb') then
dao.CompactDatabase(tmp+'.mdb',tmp+'_new.mdb')
else
Exit;
DeleteFile(tmp+'.mdb');
RenameFile(tmp+'_new.mdb',tmp+'.mdb');

RepairConn.Connected := True;
MainTable.Open ;
StatusBar.Panels[1].Text:= '数据库压缩成功！';

Except
dao.free;
StatusBar.Panels[1].Text:= '数据库压缩失败，请重试！';
end;

http://www.delphibbs.com/delphibbs/dispq.asp?lid=1268352

多人接受答案了。