frmbackup.pas

pos商场、超市管理系统

unit FRMBACKUP;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, FRMBASSDIALOGS, StdCtrls, DsFancyButton, ExtCtrls, ComCtrls,
  MenuBar, ToolWin,ShellApi;

type
  TFrm_backup = class(TFrm_bassDialogs)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Edit_path: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Edit_pathChange(Sender: TObject);
    procedure OKBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    B_showmessage:boolean;
    { Public declarations }
  end;

var
  Frm_backup: TFrm_backup;

implementation

uses select_dir;

{$R *.dfm}

procedure TFrm_backup.Button1Click(Sender: TObject);
begin
  inherited;
  Application.CreateForm(TFrm_select_dir, Frm_select_dir);
  Frm_select_dir.DriveComboBox1.Text:=ExtractFileDrive(Edit_path.Text);
  if (FileExists(Edit_path.Text)) then
     Frm_select_dir.DirectoryListBox1.Directory:=Edit_path.Text;
  if (Frm_select_dir.ShowModal=mrOK) then
     Edit_path.Text:=Frm_select_dir.Label2.Caption;
  Frm_select_dir.free;
end;

procedure TFrm_backup.FormCreate(Sender: TObject);
var
  SourcePath:string;
begin
  inherited;
   SELF.Caption :=application.Title +' - 数据备份';
     B_showmessage:=true;
     SourcePath:=ExtractFileDir(Application.ExeName);
     if (StrLen(PChar(SourcePath)) <> 3) then
        SourcePath:=SourcePath+'\';
     Edit_path.Text :=SourcePath+'BACKUPDATA\'+formatdatetime('yyyymmdd',date);
end;

procedure TFrm_backup.Edit_pathChange(Sender: TObject);
begin
  inherited;
  if trim(Edit_path.Text)<>'' then
     OKBtn.Enabled:=true
  else
     OKBtn.Enabled:=false;
end;

procedure TFrm_backup.OKBtnClick(Sender: TObject);
var
   SFilePath,DFilePath,SourcePath: string;
   MesString: string;
   OpStruc: TSHFileOpStruct;
   FromBuf, ToBuf: Array [0..255] of Char;
   ShouldCopy : Boolean;
   sr: TSearchRec;
   FileAttrs: Integer;
   LABEL COPYAGAIN;
begin
   inherited;
     COPYAGAIN:
     // 准备目录拷贝
     FillChar( FromBuf, Sizeof(FromBuf), 0 );
     FillChar( ToBuf, Sizeof(ToBuf), 0 );
     // 设置OpStruc
     with OpStruc do
     begin
          Wnd:= Handle;
          wFunc:= FO_COPY;
          pFrom:= @FromBuf;
          pTo:= @ToBuf;
          fFlags:= FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;
          fAnyOperationsAborted:= False;
          hNameMappings:= nil;
          lpszProgressTitle:= nil;
     end;

     SourcePath:=ExtractFileDir(Application.ExeName);
     if (StrLen(PChar(SourcePath)) <> 3) then
        SourcePath:=SourcePath+'\';
     FillChar( FromBuf, Sizeof(FromBuf), 0 );
     FillChar( ToBuf, Sizeof(ToBuf), 0 );
     SFilePath:=SourcePath+'data';
     StrPCopy( FromBuf, Pchar(SFilePath) );
     DFilePath:=Edit_path.Text;
     StrPCopy( ToBuf, Pchar(DFilePath) );
     // 检测源路径是否存在
     if (not DirectoryExists(SFilePath)) then
     begin
      if B_showmessage then
      begin
         MesString:='源数据库目录'+SFilePath+'已被破坏，系统不能进行备份。';
         MessageBox(Handle,PChar(MesString),'错误',MB_OK+MB_ICONERROR);
      end;
      exit;
     end;
     if uppercase(SFilePath)=uppercase(DFilePath) then
     begin
      if B_showmessage then
      begin
         MesString:='源数据库目录与目标数据库目录相同，系统不能进行备份。';
         MessageBox(Handle,PChar(MesString),'错误',MB_OK+MB_ICONERROR);
      end;
      exit;
     end;
     // 检测目的路径是否存在
     ShouldCopy:=True;
     if (DirectoryExists(DFilePath)) then
     begin
      if B_showmessage then
      begin
         MesString:='目的路径 '+DFilePath+' 已经存在，继续备份会删除该文件夹下的所有文件。'+chr(13)+'是否继续备份至该目录？';
         if MessageBox(Handle,PChar(MesString),'信息',MB_YESNO+MB_ICONINFORMATION) <> IDYES then
           ShouldCopy:=False
         else  //先删除该文件夹
         begin
           OpStruc.wFunc := FO_DELETE;
           StrPCopy( FromBuf, Pchar(DFilePath) );
           ShFileOperation( OpStruc );
           goto COPYAGAIN;    //删除已存在的目录文件夹后重新COPY
         end;
      end
      else
      begin
           OpStruc.wFunc := FO_DELETE;
           StrPCopy( FromBuf, Pchar(DFilePath) );
           ShFileOperation( OpStruc );
           goto COPYAGAIN;    //删除已存在的目录文件夹后重新COPY
      end;
     end;

     if ShouldCopy then
     begin
      if ShFileOperation( OpStruc ) <> 0 then
      begin
        MesString:='在备份目录'+SFilePath+'的过程中出现错误。';
        MessageBox(Handle,PChar(MesString),'错误',MB_OK+MB_ICONERROR);
      end
      else   // 将文件的属性设置为不是只读属性
      begin
        FileAttrs := faAnyFile;
        if FindFirst(DFilePath+'\*.*', FileAttrs, sr) = 0 then
        begin
          FileSetAttr(DFilePath+'\'+sr.Name, faArchive);
        end;

        while FindNext(sr) = 0 do
        begin
           FileSetAttr(DFilePath+'\'+sr.Name, faArchive);
        end;
        FindClose(sr);
      if B_showmessage then
      begin
        showmessage('所有数据已安全备份至【'+dfilepath+'】！');
        self.Close ;
      end;
      end;
     end;
end;

end.