Ordner (incl. Dateien und Ordner) kopieren mit Progressbar

[Ferber]

Fehlt eigentlich das wesentliche - Die Kopierfunktion. Hier der Nachtrag.

Delphi-Quellcode:

unit MyUtils;

interface

uses SysUtils, ComCtrls, Dialogs;

// SourceFileName, TargetFileName - vollständige Dateinamen
// Zielpfad wird erzeugt falls nicht vorhanden

function CopyFileWithProgress(SourceFileName, TargetFileName:String; aPB:TProgressBar):Integer;

procedure CreatePath(Path:String);
function ChkPath(Path:String):String;

implementation

function CopyFileWithProgress(SourceFileName, TargetFileName:String; aPB:TProgressBar):Integer;
const
  BufSize:Integer=10240;
var
  Path:String;
  fi,fo:File;
  fSize,nRead,nWrite:Integer;
  Buf:Pointer;
begin
  Result:=0;
  Path:=ExtractFilePath(TargetFileName);
  try
    ChkPath(Path);
  except
    MessageDlg('Error creating Path: '+Path, mtError, [mbCancel], 0);
    exit;
  end;
  try AssignFile(fi, SourceFileName); Reset  (fi,1) except exit end;
  try AssignFile(fo, TargetFileName); Rewrite(fo,1) except CloseFile(fi); exit end;

  fSize:=FileSize(fi);

  if Assigned(aPB) then
    begin
      aPB.Position:=0;
      aPB.Max:=fSize;
    end;

  try
    GetMem(Buf ,BufSize)
  except
    CloseFile(fi);
    CloseFile(fo);
    exit
  end;

  try
    repeat
      BlockRead (fi,Buf^,BufSize, nRead);
      BlockWrite(fo,Buf^,nRead, nWrite);
      if Assigned(aPB) then aPB.Position:=FilePos(fi);
    until nWrite<BufSize;
    FileSetDate(TFileRec(fo).Handle, FileGetDate(TFileRec(fi).Handle));
  finally
    FreeMem(Buf);
    CloseFile(fi);
    CloseFile(fo);
    if Assigned(aPB) then aPB.Position:=0;
    Result:=fSize;
  end;
end;

procedure CreatePath;
var
  si:Integer;
begin
  if Path='' then exit;
  if Path[Length(Path)]<>'\'
     then Path:=Path+'\';
  for si:= 4 to Length(Path) do
      if Path[si]='\'
         then CreateDir(Copy(Path,1,si-1));
end;

function ChkPath(Path:String):String;
begin
  Result:=Path;
  CreatePath(Path);
end;

end.

Beispiel:
CopyFileWithProgress('D:\Subdir\Irgendeinfile.ext', 'C:\Subdir1\Subdir2\Test.txt', Progressbar1) In eine Komponente gekapselt wirds noch komfortabler:

Delphi-Quellcode:

unit ProgressCopy;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, ComCtrls, ExtCtrls, Forms, Dialogs;

type
  TProgressCopy = class(TComponent)
  private
    FProgressbar:TProgressbar;
    FStatusPanel:TPanel;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    procedure Execute(SourceFileName, TargetFileName:String);
  published
    property Progressbar:TProgressbar read FProgressBar write FProgressbar;
    property StatusPanel:TPanel read FStatusPanel write FStatusPanel;
  end;

procedure Register;

implementation

uses MyUtils;

procedure Register;
begin
  RegisterComponents('MyCtrls', [TProgressCopy]);
end;

{ TProgressCopy }

procedure TProgressCopy.Execute(SourceFileName, TargetFileName: String);
begin
  if Assigned(FStatusPanel) then
    begin
      FStatusPanel.Caption:=TargetFileName;
      Application.ProcessMessages;
    end;
  CopyFileWithProgress(SourceFileName, TargetFileName, Progressbar);
  if Assigned(FStatusPanel) then FStatusPanel.Caption:=''
end;

procedure TProgressCopy.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) then
    begin
      if (AComponent = FProgressbar) then FProgressbar:=nil;
      if (AComponent = FStatusPanel) then FStatusPanel:=nil;
    end;
end;

end.

Beispiel:
ProgressCopy.Execute('D:\Subdir\Irgendeinfile.ext', 'C:\Subdir1\Subdir2\Test.txt') Das Blockread und Blockwrite hat schon in TurboPascal gute Dienste geleistet !