dataresort.pas

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

unit dataresort;

interface

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

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

var
  Frmdataresort: TFrmdataresort;

implementation

uses dbmodule;

{$R *.dfm}

Procedure TFrmdataresort.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 TFrmdataresort.BtnOpenClick(Sender: TObject);
var
  root:string;
begin
  root:=ExtractFileDir(paramstr(0));
  opendialog1.InitialDir:=root;
  if opendialog1.Execute then
    edit1.Text:=opendialog1.FileName;
end;

procedure TFrmdataresort.BtnBackUpClick(Sender: TObject);
var
 databasepath,newpath:string;
begin
  btnclose.Enabled:=False;
  DataBasepath:=ExtractFileDir(paramstr(0));
  DataBasepath:=DataBasepath+'\database\mydata.mdb';
  newpath:=edit1.Text;
  if dm.conn.Connected then
    dm.conn.Close;
  if fileExists(newpath) then
    CopyFileWithProgressBar(newpath,DataBasePath)
  else
    begin
      application.MessageBox('备份数据文件不存在！','提示',mb_ok);
      exit;
    end;
  btnclose.Enabled:=true;
  application.MessageBox('数据还原成功！','提示',mb_ok);
  dm.conn.Open();
  if not dm.Qfangtai.Active then
    dm.Qfangtai.Active :=True;
 end;
procedure TFrmdataresort.BtnCloseClick(Sender: TObject);
begin
  self.Close;
end;

end.