unitbackup.~pas

这是一个很好的超市管理系统

unit Unitbackup;

interface

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

type
  TFrmbackup = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    B_showmessage: boolean;
    { Public declarations }
  end;

var
  Frmbackup: TFrmbackup;

implementation

uses Uniselectdir;

{$R *.dfm}

procedure TFrmbackup.Button1Click(Sender: TObject);
begin
  application.CreateForm(TFrmselectdir, Frmselectdir);
  Frmselectdir.DriveComboBox1.Text := Extractfiledrive(Edit1.Text);
  if (edit1.Text <> '') then
    Frmselectdir.DirectoryListBox1.Directory := edit1.Text;
  if (Frmselectdir.ShowModal = mrok) then
    edit1.Text := Frmselectdir.DirectoryListBox1.Directory;
  button2.SetFocus;
end;

procedure TFrmbackup.Button2Click(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(SFilePath, sizeof(SFilePath), 0);
  fillchar(DFilePath, sizeof(DFilePath), 0);

  //设置结构opStruc
  with opStruc do
  begin
    //hwnd := 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 := Edit1.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 TFrmbackup.FormCreate(Sender: TObject);
var
  SourcePath: string;
begin
  B_showmessage := true;
  SourcePath := ExtractFileDir(application.ExeName);
  if (StrLen(pchar(SourcePath)) <> 3) then
    SourcePath := SourcePath + '\';
  Edit1.Text := SourcePath + 'backup\';
end;

end.