backupunit.pas

好用得程序

unit BackUpUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, shellapi;

type
  TBackUpForm = class(TForm)
    Panel1: TPanel;
    Edit_path: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Select: TButton;
    Panel_button: TPanel;
    Bevel_button: TBevel;
    OKBtn: TButton;
    CancelBtn: TButton;
    procedure OKBtnClick(Sender: TObject);
    procedure Edit_pathChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SelectClick(Sender: TObject);
    procedure CancelBtnClick(Sender: TObject);
    procedure Edit_pathEnter(Sender: TObject);
  private
    { Private declarations }
  public
    B_showmessage: boolean;
    { Public declarations }
  end;

var
  BackUpForm: TBackUpForm;

implementation
uses FunctionUnit, SelectDirUnit;
{$R *.dfm}


procedure TBackUpForm.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
  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;

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

procedure TBackUpForm.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 TBackUpForm.SelectClick(Sender: TObject);
begin
  Application.CreateForm(TSelectDir, SelectDir);
  SelectDir.DriveComboBox1.Text := ExtractFileDrive(Edit_path.Text);
  if (FileExists(Edit_path.Text)) then
    SelectDir.DirectoryListBox1.Directory := Edit_path.Text;
  if (SelectDir.ShowModal = mrOK) then
    Edit_path.Text := SelectDir.DirectoryListBox1.Directory;
  SelectDir.free;
  OKBtn.SetFocus;
end;

procedure TBackUpForm.CancelBtnClick(Sender: TObject);
begin
  self.Close;
end;

procedure TBackUpForm.Edit_pathEnter(Sender: TObject);
begin
  Edit_path.SelectAll;
end;

end.