databackup.pas

小管理程序主要管理的小咖啡厅我是从网上下的经测试可用

unit databackup;

interface

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

type
  TFrmdatabackup = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    BtnOpen: TSpeedButton;
    BtnBackUp: TSpeedButton;
    BtnClose: TSpeedButton;
    ProgressBar1: TProgressBar;
    procedure BtnOpenClick(Sender: TObject);
    procedure BtnBackUpClick(Sender: TObject);
    procedure BtnCloseClick(Sender: TObject);
    Procedure CopyFileWithProgressBar(Source,Destination : string);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Frmdatabackup: TFrmdatabackup;

implementation
  uses dbmodule;
{$R *.dfm}

Procedure TFrmdatabackup.CopyFileWithProgressBar(Source,Destination : string);
var
  FromF,ToF : file of byte;
  Buffer : array[0..4096] of char;
  NumRead : integer;
  FileLength : longint;
begin
  AssignFile(FromF,Source);
  reset(FromF);
  AssignFile(ToF,Destination);
  rewrite(ToF);
  FileLength:=FileSize(FromF);
  With Progressbar1 do
    begin
      Min := 0;
      Max := FileLength;
      while FileLength > 0 do
        begin
        BlockRead(FromF,Buffer[0],SizeOf(Buffer),NumRead);
        FileLength := FileLength - NumRead;
        BlockWrite(ToF,Buffer[0],NumRead);
        Position := Position + NumRead;
        end;
    end;
  CloseFile(FromF);
  CloseFile(ToF);
end;

procedure TFrmdatabackup.BtnOpenClick(Sender: TObject);
var
 dir,root:string;
begin
  root:=ExtractFileDir(paramstr(0));
  if SelectDirectory('选择路径',root,Dir) then
    edit1.Text:=Dir;
end;

procedure TFrmdatabackup.BtnBackUpClick(Sender: TObject);
var
 databasepath,newpath,filename:string;
begin
  btnclose.Enabled:=False;
  DataBasepath:=ExtractFileDir(paramstr(0));
  DataBasepath:=DataBasepath+'\database\mydata.mdb';
  filename:=datetimetostr(date())+'.bak';
  newpath:=edit1.Text+'\'+filename;
  if dm.conn.Connected then
    dm.conn.Close;
  if fileExists(newpath) then
    begin
      if application.MessageBox('当天的数据备份已存在，是否覆盖？','提示',mb_okcancel)=ID_OK then
         //copyfile(pchar(DataBasePath),pchar(newpath),False)
         CopyFileWithProgressBar(DataBasePath,newpath)
      else
        exit;
    end
  else
    begin
       //copyfile(pchar(DataBasePath),pchar(newpath),True);
      CopyFileWithProgressBar(DataBasePath,newpath);
    end;
  btnclose.Enabled:=true;
  application.MessageBox('数据备份成功！','提示',mb_ok);
  dm.conn.Open();
  if not dm.Qfangtai.Active then
    dm.Qfangtai.Active :=True;
end;

procedure TFrmdatabackup.BtnCloseClick(Sender: TObject);
begin
  self.Close;
end;

end.