csjkbf.~pas

根据箱号

unit Csjkbf;

interface

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

type
  Tsjkbf = class(Tmodel)
    Label3: TLabel;
    ProgressBar1: TProgressBar;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Edit2: TEdit;
    Panel1: TPanel;
    Bevel1: TBevel;
    DriveComboBox1: TDriveComboBox;
    DirectoryListBox1: TDirectoryListBox;
    FileListBox1: TFileListBox;
    Label1: TLabel;
    Bevel2: TBevel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    BitBtn3: TBitBtn;
    Edit1: TEdit;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure DriveComboBox1Change(Sender: TObject);
    procedure DirectoryListBox1Change(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
  private
    { Private declarations }
    Procedure CopyFileWithProgressBar(Source,Destination : string);
  public
    { Public declarations }
  end;

var
  sjkbf: Tsjkbf;

implementation

{$R *.dfm}
Procedure Tsjkbf.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);
  //  label3.Visible:=true;
  //  Progressbar1.Visible:=true;
    application.ProcessMessages;  
    With Progressbar1 do
      begin
        Min := 0;
        Max := FileLength;
        Position:=0;
        while FileLength > 0 do
          begin
            BlockRead(FromF,Buffer[0],SizeOf(Buffer),NumRead);
            FileLength := FileLength - NumRead;
            BlockWrite(ToF,Buffer[0],NumRead);
            Position := Position + NumRead;
          end;
          CloseFile(FromF);
          CloseFile(ToF);
      //   label3.Visible:=false;
       //  Progressbar1.Visible:=false;
     end;
end;
procedure Tsjkbf.BitBtn1Click(Sender: TObject);
begin
  inherited;
  if directoryexists(directorylistbox1.Directory+'\'+datetostr(date())) then
  else
    mkdir(directorylistbox1.Directory+'\'+datetostr(date()));
  Try
    CopyFileWithProgressBar(Pchar(Trim('\\Ptacliu\手机销售管理系统\data\imei.mdb')),Pchar(Trim(directorylistbox1.Directory+'\'+datetostr(date()))+'\'+ExtractFileName(Trim('\\Ptacliu\手机销售管理系统\data\imei.mdb'))));
    application.MessageBox('数据库备份成功！','提示',64);
    bitbtn2.Click;
  Except
    ShowMessage('系统出错.');
  end;
end;

procedure Tsjkbf.BitBtn2Click(Sender: TObject);
begin
  inherited;
  close;
end;

procedure Tsjkbf.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  inherited;
  action:=cafree;
end;

procedure Tsjkbf.DriveComboBox1Change(Sender: TObject);
var
  s:string;
begin
  inherited;
  directorylistbox1.Drive:=drivecombobox1.Drive;
  s:=drivecombobox1.Drive;
  label7.Caption:='当前磁盘为:【'+uppercase(s)+':\】'+#13+#13+'总空间为:【'+formatfloat('0.00',disksize(ord(s[1])-96)/1073741824)+'G】'+#13+#13+'剩余空间为:【'+formatfloat('0.00',diskfree(ord(s[1])-96)/1073741824)+'G】';
end;

procedure Tsjkbf.DirectoryListBox1Change(Sender: TObject);
begin
  inherited;
  filelistbox1.Directory:=directorylistbox1.Directory;
end;

procedure Tsjkbf.BitBtn3Click(Sender: TObject);
begin
  inherited;
 edit1.Text:=directorylistbox1.Directory;
 rmdir(e:\手机销售管理系统\data\2006-2-12);
end;

end.