backup.pas

这是用Delphi编写的车辆管理系统。主要功能有档案管理

unit Backup;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, StdCtrls, ShellCtrls, Gauges;

  type
      tpaintthread = class(TThread)
      protected
      procedure execute;override;
      end;



type
  TdateBack = class(TForm)
    Label14: TLabel;
    Panel1: TPanel;
    Panel2: TPanel;
    ShellTreeView1: TShellTreeView;
    Label1: TLabel;
    Label2: TLabel;
    Gauge1: TGauge;
    procedure Panel2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ShellTreeView1Change(Sender: TObject; Node: TTreeNode);
    procedure Panel1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    Pt: tpaintthread;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  dateBack: TdateBack;
  pathse:boolean;
  dir:string;


implementation

{$R *.dfm}

procedure Tpaintthread.execute;
var i:integer;
begin
for i:=0 to 100 do
begin
dateback.Gauge1.Progress:=dateback.Gauge1.Progress+1;
sleep(50);
application.ProcessMessages;
end;
dateback.Panel1.Enabled:=true;
dateback.Panel1.Color:=clmoneygreen;
dateback.Panel2.Enabled:=true;
dateback.Panel2.Color:=clmoneygreen;

end;

procedure TdateBack.Panel2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Tpanel(sender).BevelOuter:=bvLowered;
end;

procedure TdateBack.Panel2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
tpanel(sender).BevelOuter:=bvSpace;
end;

procedure TdateBack.Panel2Click(Sender: TObject);
begin
if pathse then
 begin
 dateback.Height:=349;
 pathse:=false;
 panel2.Caption:='确认目录';
 end
 else
    begin
    dateback.Height:=205;
    pathse:=true;
    panel2.Caption:='选择目录';
    end;
end;

procedure TdateBack.FormCreate(Sender: TObject);
begin
pt:=tpaintthread.Create(true);;
dateback.Height:=205;
pathse:=true;
getdir(0,dir);
label1.Caption:=dir+'\bak';
end;

procedure TdateBack.ShellTreeView1Change(Sender: TObject; Node: TTreeNode);
begin
label1.Caption:=shelltreeview1.Path;
end;

procedure TdateBack.Panel1Click(Sender: TObject);
var
  sr: TSearchRec;
  FileAttrs: Integer;
begin
 dateback.Height:=205;
 panel2.Caption:='选择目录';
gauge1.Visible:=true;
panel1.Enabled:=false;
panel1.Color:=clwindow;
panel2.Enabled:=false;
panel2.Color:=clwindow;
try
begin
fileattrs:=faDirectory;
dir:=dir+'\data\';
if FindFirst(label1.Caption, FileAttrs, sr) = 0 then
begin
createdir(pchar(label1.Caption+'\'+datetostr(now)));
copyfile(pchar(dir+'Carbaofei.DBF'),pchar(label1.Caption+'\'+datetostr(now)+'\Carbaofei.DBF'),true);
copyfile(pchar(dir+'carclass.DBF'),pchar(label1.Caption+'\'+datetostr(now)+'\Carclass.DBF'),true);
copyfile(pchar(dir+'Cardangan.DBF'),pchar(label1.Caption+'\'+datetostr(now)+'\Cardangan.DBF'),true);
copyfile(pchar(dir+'Cardriver.DBF'),pchar(label1.Caption+'\'+datetostr(now)+'\Cardriver.DBF'),true);
copyfile(pchar(dir+'Carlingjian.DBF'),pchar(label1.Caption+'\'+datetostr(now)+'\Carlingjian.DBF'),true);
copyfile(pchar(dir+'Carshigu.DBF'),pchar(label1.Caption+'\'+datetostr(now)+'\Carshigu.DBF'),true);
copyfile(pchar(dir+'Carweixiu.DBF'),pchar(label1.Caption+'\'+datetostr(now)+'\Carweixiu.DBF'),true);
copyfile(pchar(dir+'Carweizhang.DBF'),pchar(label1.Caption+'\'+datetostr(now)+'\Carweizhang.DBF'),true);
copyfile(pchar(dir+'Caryidong.DBF'),pchar(label1.Caption+'\'+datetostr(now)+'\Caryidong.DBF'),true);
copyfile(pchar(dir+'Caryunying.DBF'),pchar(label1.Caption+'\'+datetostr(now)+'\Caryunying.DBF'),true);
copyfile(pchar(dir+'driverjf.DBF'),pchar(label1.Caption+'\'+datetostr(now)+'\driverjf.DBF'),true);
copyfile(pchar(dir+'users.DBF'),pchar(label1.Caption+'\'+datetostr(now)+'\users.DBF'),true);
pt.execute;
  showmessage('备份完毕！');
   end
   else showmessage('目录不存在,请重新建立！！');
end;
except
showmessage('出错！请从新备份！！');
end;
dateback.Close;
end;

procedure TdateBack.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 dateback.Height:=205;
 gauge1.Visible:=false;
 gauge1.Progress:=0;
end;

end.