csjksc.pas

根据箱号

unit Csjksc;

interface

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

type
  Tsjksc = class(Tmodel)
    Label3: TLabel;
    ProgressBar1: TProgressBar;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Button2: TButton;
    Label1: TLabel;
    Edit1: TEdit;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    Procedure CopyFileWithProgressBar(Source,Destination : string);
  public
    { Public declarations }
  end;

var
  sjksc: Tsjksc;

implementation

{$R *.dfm}
Procedure Tsjksc.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 Tsjksc.BitBtn1Click(Sender: TObject);
begin
  inherited;
  Try
    CopyFileWithProgressBar(Pchar(Trim(Edit1.Text)),Pchar(Trim('\\Ptacliu\新建文件夹\data')+'\'+ExtractFileName(Trim(Edit1.Text))));
    application.MessageBox('数据库上传成功！','提示',64);
    bitbtn2.Click;
  Except
    ShowMessage('系统出错.');
  end;
end;

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

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

end.