accesscompress.pas

DbAnyWhere开发套件

unit AccessCompress;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComObj;

type
  TAccessCompress = class(TComponent)
  private
    Procedure CampactAccessDB(FileName,Password: String);
    { Private declarations }
  protected
    { Protected declarations }
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function AccessCompress(FileName:string;PassWord:string):boolean;
    { Public declarations }
  published
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('DbAnyWhere', [TAccessCompress]);
end;
constructor TAccessCompress.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;
destructor TAccessCompress.Destroy;
begin
  inherited Destroy;
end;
function TAccessCompress.AccessCompress(FileName:string;PassWord:string):boolean;
  function IsFileInUse(fName : string) : boolean;
  var
    HFileRes : HFILE;
  begin
    Result := false;
    if not FileExists(fName) then
       exit;
    HFileRes := CreateFile(pchar(fName), GENERIC_READ or GENERIC_WRITE,
                0 {this is the trick!}, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
    Result := (HFileRes = INVALID_HANDLE_VALUE);
    if not Result then
    CloseHandle(HFileRes);
  end;
begin
  result:=false;
  if FileExists(filename) then begin
    if IsFileInUse(FileName) then begin
      ShowMessage('其他程序可能正在使用文件：'+FileName+' ！');
      Exit;
    end;
    CampactAccessDB(FileName,Password);
    result:=true;
  end;
end;

Procedure TAccessCompress.CampactAccessDB(FileName,Password: String);
var
  vJE:OleVariant;
  tempfile:String;
  SConnectionString:string;
begin
  SConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;'
                    +'Jet OLEDB:Database Password=%s;';
  tempfile:=FileName+'tmpDB.mdb';
  Try
    vJE:=CreateOleObject('JRO.JetEngine');
    Application.ProcessMessages;
    vJE.CompactDatabase(format(SConnectionString,[FileName,Password]),
        format(SConnectionString,[tempFile,Password]));
    DeleteFile(FileName);
    RenameFile(tempfile,FileName);
  finally
    //
  end;
end;
end.