storeupfrm.pas

基于Interbase的图书管理系统

unit storeupfrm;

interface

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

type
  TstoreupForm = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    BtBclose: TBitBtn;
    GroupBox1: TGroupBox;
    Splitter1: TSplitter;
    GroupBox2: TGroupBox;
    BtBbackup: TBitBtn;
    BtBbpcancel: TBitBtn;
    BtBrecover: TBitBtn;
    BtBrecancel: TBitBtn;
    Label1: TLabel;
    DTPbackup: TDateTimePicker;
    Label2: TLabel;
    DTPrecover: TDateTimePicker;
    Label3: TLabel;
    Label4: TLabel;
    Edbackup: TEdit;
    SpeedButton1: TSpeedButton;
    Label5: TLabel;
    Label6: TLabel;
    Edrecover: TEdit;
    SpeedButton2: TSpeedButton;
    prbCopy: TProgressBar;
    Label7: TLabel;
    Lbshow: TLabel;
    procedure BtBcloseClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure BtBbackupClick(Sender: TObject);
    procedure BtBrecoverClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
   function selectdir(const Caption: WideString; const Root: string):string;
   procedure getAsrDestFile(Aedit:string;isbackup:boolean;var AsrcFile,AdestFile:string);
   procedure backupRecoverfile(AsrcFile,AdestFile:string);
     { Public declarations }
  end;

var
  storeupForm: TstoreupForm;
  isbackup:boolean; //是否备份变量

implementation

uses dmfrm;

{$R *.dfm}

procedure TstoreupForm.BtBcloseClick(Sender: TObject);
begin
ModalResult:=mrOK;
end;

function TstoreupForm.selectdir(const Caption: WideString;
  const Root: string):string;
var
Directory:string;
begin
 Result:=Emptystr;
 if  SelectDirectory(Caption,Root,Directory) then
   Result:=Directory;
end;

procedure TstoreupForm.getAsrDestFile(Aedit:string;isbackup:boolean;var AsrcFile, AdestFile: string);
var
 templist:Tstringlist;
begin
   BtBrecover.Enabled:=false;
   BtBbpcancel.Enabled:=false;
   BtBbackup.Enabled:=false;
   BtBclose.Enabled:=false;
   Btbbpcancel.Enabled:=false;
   templist:=TStringlist.Create;
   try
   dmbook.Dbasebook.Session.GetAliasParams(dmbook.Dbasebook.AliasName,templist);
   AsrcFile:=templist.Values['SERVER NAME'];
   finally
    templist.Free;
    templist:=nil;
   end;
  // showmessage(AsrcFile);
   if not fileexists(AsrcFile) then
      begin
       BtBrecover.Enabled:=true;
       BtBbpcancel.Enabled:=true;
       BtBbackup.Enabled:=true;
       BtBclose.Enabled:=true;
       Btbbpcancel.Enabled:=true;
       Raise Exception.Create('指定别名的路径文件不存在！');
      end;
   AdestFile:=Aedit;
   if copy(AdestFile,length(AdestFile),1)<>'\' then AdestFile:=AdestFile+'\';
   AdestFile:=AdestFile+'books'+DateToStr(Date)+'.gdk';
//  showmessage(AdestFile);
  if (isbackup=false)and(not fileexists(AdestFile)) then
     begin
    BtBrecover.Enabled:=true;
   BtBbpcancel.Enabled:=true;
   BtBbackup.Enabled:=true;
   BtBclose.Enabled:=true;
   Btbbpcancel.Enabled:=true;
   Raise Exception.Create('指定路径文件不存在！');
     end;
end;

procedure TstoreupForm.backupRecoverfile(AsrcFile, AdestFile: string);
var
  SrcFile, DestFile: File;
  BytesRead, BytesWritten, TotalRead: Integer;
  Buffer: array[1..500] of byte;
  FSize: Integer;
begin
  AssignFile(SrcFile,AsrcFile);
  AssignFile(DestFile,AdestFile);
  Reset(SrcFile, 1);
  try
     Rewrite(DestFile, 1);
   try
     try
        TotalRead := 0;
         FSize := FileSize(SrcFile);
       repeat
          BlockRead(SrcFile, Buffer, SizeOf(Buffer), BytesRead);
          if BytesRead > 0 then
          begin
            BlockWrite(DestFile, Buffer, BytesRead, BytesWritten);
            if BytesRead <> BytesWritten then
              raise Exception.Create('Error copying file')
            else begin
              TotalRead := TotalRead + BytesRead;
              prbCopy.Position := Trunc(TotalRead/Fsize)*100;
              Lbshow.Caption:=inttostr(prbCopy.Position)+'%';
              prbCopy.Update;
              Lbshow.Update;
            end;
          end
        until BytesRead = 0;
      except
         Erase(DestFile);
        raise;
      end;
    finally
      CloseFile(DestFile); // Close the destination file.
    end;
  finally
    CloseFile(SrcFile);   // Close the source file.
  end;
end;


procedure TstoreupForm.SpeedButton1Click(Sender: TObject);
begin
  Edbackup.Text:=selectdir('选择目录',Emptystr);
end;

procedure TstoreupForm.SpeedButton2Click(Sender: TObject);
begin
 Edrecover.Text:=selectdir('选择目录',Emptystr);
end;

procedure TstoreupForm.BtBbackupClick(Sender: TObject);
var
  AsrcFile, AdestFile: string;
begin
  if Edbackup.Text=Emptystr then
    begin
     messagedlg('请输入路径或选择路径！',mtInformation,[mbOK],0);
     Edbackup.SetFocus;
     exit;
    end;
  if not DirectoryExists(Edbackup.Text) then
   begin
  if messagedlg('这个目录不存在，是否创建！',mtConfirmation,[mbYes,mbNo],0)=mrYes then
    begin
    if not CreateDir(Edbackup.Text) then raise Exception.Create('创建目录失败！');
     end
  else begin
           //showmessage('go');
           Edbackup.Clear;
           Edbackup.SetFocus;
           exit;
          end;
   end;
 getAsrDestFile(Edbackup.Text,true,AsrcFile, AdestFile);
 backupRecoverfile(AsrcFile, AdestFile);
 showmessage('备份数据完毕。');
 prbCopy.Position:=0;
 lbshow.Caption:=Emptystr;
 BtBclose.Enabled:=true;
 BtBrecover.Enabled:=true;
 BtBbpcancel.Enabled:=true;
 BtBbackup.Enabled:=true;
 Btbbpcancel.Enabled:=true;
 isbackup:=true;
end;

procedure TstoreupForm.BtBrecoverClick(Sender: TObject);
var
  AsrcFile, AdestFile: string;
begin
    if Edrecover.Text=Emptystr then
    begin
     messagedlg('请输入来源或选择来源！',mtInformation,[mbOK],0);
     Edrecover.SetFocus;
     exit;
    end;
  if not DirectoryExists(Edrecover.Text) then
   begin
messagedlg('来源的目录不存在，重新输入或选择来源路径！',mtInformation,[mbOK],0);
  Edrecover.Clear;
  Edrecover.SetFocus;
    exit;
   end;
 getAsrDestFile(Edrecover.Text,false,AsrcFile, AdestFile);
 //dmbook.Dbasebook.Close;
 backupRecoverfile(AdestFile,AsrcFile);
 showmessage('恢复数据完毕。');
 prbCopy.Position:=0;
 lbshow.Caption:=Emptystr;
 BtBclose.Enabled:=true;
 BtBrecover.Enabled:=true;
 BtBbpcancel.Enabled:=true;
 BtBbackup.Enabled:=true;
 Btbbpcancel.Enabled:=true;
end;

procedure TstoreupForm.FormDestroy(Sender: TObject);
begin
 storeupForm:=nil;
end;

procedure TstoreupForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
Action:=caFree;
end;

procedure TstoreupForm.FormCreate(Sender: TObject);
begin
DTPbackup.DateTime:=now;
DTPrecover.DateTime:=now;
Edbackup.Text:=extractfilepath(application.ExeName)+'databak';
Edrecover.Text:=extractfilepath(application.ExeName)+'databak';
end;

end.