求压缩Access数据库的算法(ADO)？

Question

求压缩Access数据库的算法(ADO)？

Answer 1

Const
  SConnectionString       = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;'
                                +'Jet OLEDB:Database Password=%s;';
function CompactDatabase(AFileName,APassWord:string):boolean;
//压缩与修复数据库,覆盖源文件
var
  STempFileName:string;
  vJE:OleVariant;
begin
  STempFileName:=GetTempPathFileName;
  try
    vJE:=CreateOleObject('JRO.JetEngine');
    vJE.CompactDatabase(format(SConnectionString,[AFileName,APassWord]),
        format(SConnectionString,[STempFileName,APassWord]));
    result:=CopyFile(PChar(STempFileName),PChar(AFileName),false);
    DeleteFile(STempFileName);
  except
    result:=false;
  end;
end;

Answer 2

function TForm1.CompactDatabase(AFileName: string): boolean;
const
  SConnectionString =
    'Provider=Microsoft.Jet.OLEDB.4.0;Password=XXXXXX;' +
    'User ID=XXXXXX;' +
    'Data Source=%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, [AFileName1]), format(SConnectionString, [STempFileName, AFileName1]))); //压缩数据库
    //复制并覆盖源数据库文件,如果复制失败则函数返回假,压缩成功但没有达到函数的功能
    result := CopyFile(PChar(STempFileName), PChar(AFileName), false);
    DeleteFile(STempFileName); //删除临时文件
  except
    result := false; //压缩失败
  end;
end;

Answer 3

AFileName是指要压缩的数据库名称吗？

Answer 4

如果没有密码是不是留空呢？
譬如function CompactDatabase(test.mdb,'');
是这样调用吗？

Answer 5

以下代码，测试通过：
--------------------------------------
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,ComObj;
type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
implementation
{$R *.dfm}
//压缩Access数据库
function DaoActive(var DaoObject:OleVariant):Boolean;
begin
  Result:=False;
  try
    DaoObject:=GetActiveOleObject('DAO.DBEngine.36');
    Result:=True;
  except
    try
      DaoObject:=CreateOleObject('DAO.DBEngine.36');
      Result:=True;
    except
      DaoObject:=Null;
    end;
  end;
end;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)+'msaTemp.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;procedure TForm1.Button1Click(Sender: TObject);
begin
   if DaoCompactDB('e:\abc\jxcdb.mdb') then ShowMessage('OK');
   end;
end;
end.