databffrm.pas

来自「本人编写的有关军队营房工作的管理系统」· PAS 代码 · 共 131 行

unit databffrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Buttons, StdCtrls,Grids,DirOutln, backup, Gauges;

type
  Tdatabf = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SaveDialog1: TSaveDialog;
    Label1: TLabel;
    Edit1: TEdit;
    SpeedButton4: TSpeedButton;
    BackupFile1: TBackupFile;
    Gauge1: TGauge;
    Label2: TLabel;
    Label3: TLabel;
    ListBox1: TListBox;
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure BackupFile1Progress(Sender: TObject; Filename: String;
      Percent: TPercentage; var Continue: Boolean);
    procedure BackupFile1NeedDisk(Sender: TObject; DiskID: Word;
      var Continue: Boolean);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  databf: Tdatabf;

implementation

uses mainfrm, datafrm;

{$R *.dfm}

procedure Tdatabf.SpeedButton4Click(Sender: TObject);
begin
  databf.SaveDialog1.InitialDir:=extractfilepath(application.ExeName)+'backup';
  databf.SaveDialog1.Execute;
  if databf.SaveDialog1.FileName<>'' then
    if extractFileExt(databf.SaveDialog1.FileName)<>'.bf' then
      databf.Edit1.Text:=databf.SaveDialog1.FileName+'.bf'
    else
      databf.Edit1.Text:=databf.SaveDialog1.FileName;
end;

procedure Tdatabf.SpeedButton2Click(Sender: TObject);
begin
if databf.BackupFile1.busy then
  begin
  if (MessageDlg('您要取消当前正在进行的备份吗？',mtConfirmation, [mbYes,mbNo], 0)= mrYes) then
    begin
      Backupfile1.Stop;
      close;
    end
  end
else
  close;
end;

procedure Tdatabf.BackupFile1Progress(Sender: TObject; Filename: String;
  Percent: TPercentage; var Continue: Boolean);
begin
databf.Label2.caption:= extractfilename(filename);
databf.Gauge1.Progress:= percent;
databf.Label3.caption:=inttostr(databf.BackupFile1.FilesProcessed)+'/'+inttostr(databf.BackupFile1.FilesTotal)+'已完成';
if databf.SpeedButton2.down then Continue := false;
end;

procedure Tdatabf.BackupFile1NeedDisk(Sender: TObject; DiskID: Word;
  var Continue: Boolean);
begin
Continue := MessageDlg('磁盘已满，插入新磁盘' +inttostr(DiskID)+'后并按下OK键以继续',mtInformation, mbOKCancel, 0) = mrOK;
end;

procedure Tdatabf.SpeedButton1Click(Sender: TObject);
var
  filename:string;
begin
if databf.Edit1.Text<>'' then
  begin
    if fileexists(databf.Edit1.Text) then
      begin
        if messagebox(databf.Handle,'文件已经存在，确认要覆盖此文件吗？','营房工作管理系统',33)=1 then
          begin
            filename:=databf.Edit1.Text;
            databf.ListBox1.Items.Add(extractfilepath(application.ExeName)+'data\*.*');
            databf.SpeedButton1.Enabled:=false;
            main.Timer1.Enabled:=false;
            yfgldata.Free;
            if databf.BackupFile1.Backup(listbox1.items,filename) then
              messagebox(databf.handle,pansichar('数据备份完毕，共有'+inttostr(databf.BackupFile1.FilesTotal)+'个文件，'+inttostr(databf.BackupFile1.SizeTotal)+'字节。'),'营房工作管理系统',mb_iconexclamation)
            else
              messagebox(databf.handle,'备份过程发生错误。','营房工作管理系统',16);
            application.CreateForm(tyfgldata,yfgldata);
            main.Timer1.Enabled:=true;
            databf.Close;
          end
      end
    else
      begin
        filename:=databf.Edit1.Text;
        databf.ListBox1.Items.Add(extractfilepath(application.ExeName)+'data\*.*');
        databf.SpeedButton1.Enabled:=false;
        main.Timer1.Enabled:=false;
        yfgldata.Free;
        if databf.BackupFile1.Backup(listbox1.items,filename) then
          messagebox(databf.handle,pansichar('数据备份完毕，共有'+inttostr(databf.BackupFile1.FilesTotal)+'个文件，'+inttostr(databf.BackupFile1.SizeTotal)+'字节。'),'营房工作管理系统',mb_iconexclamation)
        else
          messagebox(databf.handle,'备份过程发生错误。','营房工作管理系统',16);
        application.CreateForm(tyfgldata,yfgldata);
        main.Timer1.Enabled:=true;
        databf.close;
      end;
  end
else
  messagebox(databf.handle,'请选择备份路径。','营房工作管理系统',16);
end;

end.