copyfile.pas

拷贝文件的控件

unit Copyfile;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs;

type
  TcopyFile = class(TComponent)
  private
    { Private declarations }
    tofilename:string;
    fromfilename:string;
    dowarning:boolean;
    lastresult:integer;
  protected
    { Protected declarations }
  public
    constructor Create(owner:tcomponent);override;
    destructor Destroy;override;
    property CopyResult:integer read lastresult;
    Procedure DoCopy;
  published
    property Forigin:string read fromfilename write fromfilename;
    property Fdestination:string read tofilename write tofilename;
    property Warning:boolean read dowarning write dowarning default true;
  end;

procedure Register;

implementation


constructor TCopyFile.Create(owner:tcomponent);
begin
  inherited create(owner);
  lastresult:=0;
end;

destructor TCopyFile.Destroy;
begin
 inherited destroy;
end;


Procedure TCopyFile.DoCopy;
var r,i,j,k:word;
    p:^byte;
    f1,f2:file;
    num,resto:word;
    l:longint;
begin
  if not fileexists(fromfilename) then begin
      lastresult:=2;
      exit;
  end;
  if FileExists(tofilename) then if dowarning then begin
     r:=MessageDlg('Replace existing file '+tofilename+' ?',
                mtWarning,
                [mbYes, mbNo],0);
     if r<>mrYes then exit;
  end;
  getmem(p,64000);
  {$I-}
  try
  assignfile(f1,fromfilename);
  reset(f1,1);
  l:=filesize(f1);
  assignfile(f2,tofilename);
  rewrite(f2,1);
    num:=l div 64000;
    resto:= l mod 64000;
    for i:=1 to num do begin
      blockread(f1,p^,64000);
      blockwrite(f2,p^,64000);
    end;
    if resto>0 then begin
     blockread(f1,p^,resto);
     blockwrite(f2,p^,resto);
    end;
    lastresult:=ioresult;
    {$I+}
  finally;
  closefile(f1);
  closefile(f2);
  freemem(p,64000);
  end;
end;



procedure Register;
begin
  RegisterComponents('Samples', [TcopyFile]);
end;

end.