unit1.pas

ACESS数据库使用时间长了之后,数据库文件后变得越来越庞大,本程序里的函数可以实现对ACESS进行压缩 另外,当机器突然断电,可能对DB造成损坏,该函数也可实现修复

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,ComObj, StdCtrls,ActiveX, DB, ADODB ;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Memo1: TMemo;
    Label1: TLabel;
    Edit2: TEdit;
    ADOConnection1: TADOConnection;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function   DaoActive(var   DaoObject:OleVariant):Boolean;   
begin
    Result:=False;
    try
        DaoObject:=GetActiveOleObject('DAO.DBEngine.36;Jet OLEDB:Database Password=xiangjinmao');
        Result:=True;
    except
        try
            DaoObject:=CreateOleObject('DAO.DBEngine.36;Jet OLEDB:Database Password=xiangjinmao');
            Result:=True;
        except
            DaoObject:=Null;
        end;
    end;
end;

//压缩Access数据库
function   DaoCompactDB(const   FileName:string):Boolean;
var
    db:OleVariant;
    TempFile:string;   
begin
    Result:=False;   
    try
        if   not   DaoActive(db)   then
            Exit;   
        try
            TempFile:=ExtractFilePath(FileName)+'EncodeDBT.mdb';

            db.CompactDatabase(FileName,TempFile);
            DeleteFile(FileName);
            RenameFile(TempFile,FileName);   
            Result:=True;   
        except
            on   E:EOleException   do   
                ShowMessage(E.Message);   
        end
    finally   
        db:=Unassigned;
    end;
end;   


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
    STempFileName:=FormatDateTime('YYYYMMDDHHMMSS',now())+'_backup.mdb';//PChar->String
    DeleteFile(STempFileName);//删除Windows建立的0字节文件
    try
        JE:=CreateOleObject('JRO.JetEngine');//建立OLE对象,函数结束OLE对象超过作用域自动释放
        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 TForm1.Button1Click(Sender: TObject);
var
  AFileName,APassWord:string;
  rv:boolean;
begin
  AFileName:=edit1.Text;
  APassWord:=edit2.text;
  rv:=  CompactDatabase(AFileName,APassWord);
  //rv:=DaoCompactDB(AFileName);
  if rv then
  begin
    memo1.Lines.Add('压缩成功') ;
  end else
  begin
    memo1.Lines.Add('压缩失败');
  end;


end;

end.