compactdb.pas

一个售楼系统

Unit CompactDB;

Interface

Uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls, DateUtils, FileCtrl, StrUtils, LbButton;

Type
   tCompactDBForm = Class(TForm)
      StaticText1: TStaticText;
      StaticText3: TStaticText;
      LbButton1: TLbButton;
      LbButton2: TLbButton;
      LbButton3: TLbButton;
      LbButton4: TLbButton;
      Procedure FormClose(Sender: TObject; Var Action: TCloseAction);
      Procedure Button3Click(Sender: TObject);
      Procedure Button1Click(Sender: TObject);
      Procedure Button2Click(Sender: TObject);
      Procedure Button4Click(Sender: TObject);
      Procedure FormCreate(Sender: TObject);
   Private
        { Private declarations }
   Public
        { Public declarations }
   End;

Var
   CompactDBForm    : tCompactDBForm;
   CPaths           : String;
   currdir1         : String;
Const
   DBNAME           : String = 'X.MDB';
Implementation
Uses MainUnit, CompactMDB, DM;
{$R *.dfm}

Procedure tCompactDBForm.FormClose(Sender: TObject; Var Action: TCloseAction);
Begin

   Action := cafree;
   CompactDBForm := Nil;
End;

Procedure tCompactDBForm.Button3Click(Sender: TObject);
Var
   BOL              : Boolean;
Begin
//   BOL := SelectDirectory('选择备份存放路径', DM.CURRDIR, CPaths);
   BOL := SelectDirectory(CPaths, [sdAllowCreate, sdPerformCreate], 0);
   StaticText3.Caption := '目标文件夹：' + CPaths;
   CompactDBForm.Show;
End;

Procedure tCompactDBForm.Button1Click(Sender: TObject);
Begin
   Close;
End;

Procedure tCompactDBForm.Button2Click(Sender: TObject);
Begin
   Close;
End;

Procedure tCompactDBForm.Button4Click(Sender: TObject);

   Function GetTDStr(D: tdatetime): String;
   Var
      y, M, a, H, N, E, ME: word;       //年月日时分秒
      s             : String;
   Begin
      y := yearof(D);
      M := monthof(D);
      a := dayof(D);
      H := hourof(D);
      N := minuteof(D);
      E := secondof(D);
      ME := MilliSecondOf(D);
      s := IntToStr(y) + '-' + IntToStr(M) + '-' + IntToStr(a) + ' ' +
         IntToStr(H) + '.' + IntToStr(N) + '.' + IntToStr(E) + '..' +
         IntToStr(ME);

      result := s;
   End;

Var
   sbackFileName    : String;
Begin
   LbButton2.Visible := false;
   StaticText1.Caption := '正在准备备份数据库';
   Application.ProcessMessages;
   If CPaths = '' Then CPaths := DM.CURRDIR + '\backup';
   If Not DirectoryExists(CPaths) Then MkDir(CPaths);
   DM.DataModule2.ADOConnection1.Close;

   StaticText1.Caption := '正在压缩数据库....';
   If CompactDatabase(DBNAME, '') Then
      StaticText1.Caption := '数据库压缩成功！'
   Else Begin

   End;

   StaticText1.Caption := '正在备份数据库....';
   sbackFileName := GetTDStr(Now);
   If RightStr(CPaths, 1) = '\' Then
      CopyFile(pchar(DM.CURRDIR + '\' + DBNAME), pchar(CPaths + sbackFileName
         + '.kab'),
         false)
   Else
      CopyFile(pchar(DM.CURRDIR + '\' + DBNAME), pchar(CPaths + '\' +
         sbackFileName + '.kab'),
         false);
   StaticText1.Caption := '成功备份数据库！';
   LbButton1.Enabled := true;
   LbButton4.Visible := false;
   ChDir(DM.CURRDIR);

   DM.DataModule2.ADOConnection1.open;
End;

Procedure tCompactDBForm.FormCreate(Sender: TObject);
Begin
   currdir1 := ExtractFilePath(Application.ExeName);
   ChDir(currdir1);
   LbButton1.Enabled := false;
   LbButton2.Visible := true;

   StaticText3.Caption :=
      '可选择备份存放文件夹后再开始，默认为当前目录下的BACKUP文件夹中。';
End;

End.