udbadmin.pas

此为一个用delphi语言编写的人事管理系统

unit uDBadmin;

interface

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

type
  TfrmDBadmin = class(TForm)
    Label1: TLabel;
    btnCancel: TSpeedButton;
    Panel1: TPanel;
    btnCompact: TBitBtn;
    btnBackup: TBitBtn;
    btnRestore: TBitBtn;
    procedure btnCompactClick(Sender: TObject);
    procedure btnBackupClick(Sender: TObject);
    procedure btnRestoreClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
  private
    { Private declarations }
//    procedure CompactAccess(dbName: string; JetId: string = '4.0');   //压缩
  public
    { Public declarations }
  end;

var
  frmDBadmin: TfrmDBadmin;

implementation

uses uData;

{$R *.dfm}

procedure CompactAccess(dbName: string; JetId: string = '4.0');   //压缩
var
  AVariant: Variant;
begin
  if FileExists(dbName + '.tmp') then DeleteFile(DbName + '.tmp');
  AVariant := CreateOleObject('JRO.JetEngine');
  AVariant.CompactDataBase('Provider=Microsoft.Jet.OLEDB.' + JetId + ';Data Source=' + dbName ,
  'Provider=Microsoft.Jet.OLEDB.' + JetId + ';Data Source=' + dbName + '.tmp');
  DeleteFile(DbName);
  ReNameFile(dbName + '.tmp', DbName);
end;

//数据库压缩
procedure TfrmDBadmin.btnCompactClick(Sender: TObject);
var
  dbname: string;
begin
  if dmPer.acper.Connected = true then dmper.acper.Connected := false;
  Sleep(500);
  dbname := ExtractFilePath(Application.ExeName) + 'permis.mdb';
  CompactAccess(dbname);
  MessageBox(handle, '数据库压缩成功!', '提示', mb_IconInformation + mb_Ok);
  if dmper.acper.Connected = false then dmper.acper.Connected := true;
end;

//数据库备份
procedure TfrmDBadmin.btnBackupClick(Sender: TObject);
var
  dbname: string;
begin
  if dmPer.acper.Connected = true then dmper.acper.Connected := false;
  dbname := ExtractFilePath(Application.ExeName)+ 'permis.bak';
  if FileExists(dbname) then DeleteFile(dbname);
  CopyFile(Pchar('permis.mdb'), Pchar(dbname), true);
  MessageBox(handle, '数据库备份成功!', '提示', mb_IconInformation + mb_Ok);
  if dmper.acper.Connected = false then dmper.acper.Connected := true;
end;

//数据库还原
procedure TfrmDBadmin.btnRestoreClick(Sender: TObject);
var
  dbname, dbbname: string;
begin
  if MessageBox(self.Handle, '确认要还原数据么? ', '提示', mb_IconQuestion + mb_YesNo) = idYes then
  begin
    if dmPer.acper.Connected = true then dmper.acper.Connected := false;
    dbname := ExtractFilePath(Application.ExeName)+ 'permis.mdb';
    dbbname := ExtractFilePath(Application.ExeName)+ 'permis.bak';
    if not FileExists(dbbname) then
      MessageBox(self.Handle, '没有备份数据,不能还原', '提示', mb_IconInformation + mb_Ok)
    else
    begin
      CopyFile(Pchar(dbbname), Pchar(dbname), true);
      MessageBox(handle, '数据库还原成功!', '提示', mb_IconInformation + mb_Ok);
    end;
    if dmPer.acper.Connected = false then dmper.acper.Connected := true;
  end;
end;

procedure TfrmDBadmin.btnCancelClick(Sender: TObject);
begin
  close;
end;

end.