delphi压缩access数据库(转载)

//引用ComObj,ActiveX
function   CompactDatabase(AFileName,APassWord:string):boolean;
//压缩与修复数据库,覆盖源文件
const
    SConnectionString   =   'Provider=Microsoft.Jet.OLEDB.4.0;Data   Source=%s; '
            + 'Jet   OLEDB:Database   Password=%s; ';
var
    SPath,SFile:Array   [0..254]   Of   Char;
    STempFileName:String;
    JE:OleVariant;
begin
    GetTempPath(40,SPath);//取得Windows的Temp路径
    GetTempFileName(SPath, '~CP ',0,SFile);//取得Temp文件名,Windows将自动建立0字节文件
    STempFileName:=SFile;//PChar-> String
    DeleteFile(STempFileName);//删除Windows建立的0字节文件
    try
        JE:=CreateOleObject( 'JRO.JetEngine ');//建立OLE对象,函数结束OLE对象超过作用域自动释放
        OleCheck(JE.CompactDatabase(format(SConnectionString,[AFileName,APassWord]),
                format(SConnectionString,[STempFileName,APassWord])));//压缩数据库
        //复制并覆盖源数据库文件,如果复制失败则函数返回假,压缩成功但没有达到函数的功能
        result:=CopyFile(PChar(STempFileName),PChar(AFileName),false);
        DeleteFile(STempFileName);//删除临时文件
    except
        result:=false;//压缩失败
    end;
end;

例子:
procedure   TFAutoStat.ActCompactDBExecute(Sender:   TObject);
var
    sFileName:   String;
begin
    sFileName:=ExtractFilePath(Application.ExeName)+ '..\DataBase\AutoStat.mdb ';
    sBarText( '正在压缩数据库，请稍候．．．．．． ');
    Self.Enabled:=false;
    Self.Cursor:=crSqlWait;
    try
        AdoConnection.Close;
        if     CompactDatabase(sFileName, 'abcd ')
            then   sBarText( '压缩数据库完毕 ')
            else   ShowMessage( '压缩数据库失败！ ');
        ConnectToDB();
    finally
        Self.Enabled:=true;
        Self.Cursor:=crDefault;
    end;
end;