Dateien kopieren in eigenem Thread

[Ghostwalker]

Oder für ältere Delphi-Versionen:

Code:

interface
  uses windows,classes,sysutils;

TYPE
  TCopyFile = Class;

  TCopyFileThread = Class(TThread)
  PRIVATE
    fparent : TCopyFile;
  PUBLIC
    Constructor Create(parent:TCopyFile);
    procedure Execute;
  End;

  TCopyFile = Class(TObject)
    PRIVATE
      FLock: TRTLCriticalSection;
      fThread : TCopyFileThread;
      fsrc : widestring;
      fdst : widestring;

    PROTECTED
        function TryLock:boolean;
        procedure Lock;
        procedure Unlock;

    PUBLIC
       Constructor Create;
       Destructor Destroy;override;

       procedure Copy;
       procedure CopyAsync;

       property Sourcefile : widestring read fsrc write fsrc;
       property Destination: widestring read fdst write fdst;
  End;
implementation

{ TCopyFile }

procedure TCopyFile.Copy;
begin
  if (FileExists(fsrc)) then
    CopyFileEx(pchar(fsrc),pchar(fdst),false);
end;

procedure TCopyFile.CopyAsync;
begin
  if TryLock then
  begin
    Try
      if (assigned(fthread)) then
        fthread.free;
      fthread := TCopyFileThread.Create(self);
    Finally
      unlock;
    End;
  end;
end;

constructor TCopyFile.Create;
begin
  inherited Create;
  InitializeCriticalSection(FLock);
  fsrc := '';
  fdst := '';
end;

destructor TCopyFile.Destroy;
begin
  if (assigned(fThread)) then
  begin
    if (not fthread.Terminated) then
      fthread.WaitFor;
    FreeAndNil(fThread);
  end;
  DeleteCriticalSection(FLock);
  inherited;
end;

procedure TCopyFile.Lock;
begin
  EnterCriticalSection(FLock);
end;

function TCopyFile.TryLock: boolean;
begin
  Result := TryEnterCriticalSection(FLock);
end;

procedure TCopyFile.Unlock;
begin
  LeaveCriticalSection(FLock);
end;

{ TCopyFileThread }

constructor TCopyFileThread.Create(parent: TCopyFile);
begin
  inherited Create(true);
  fparent := parent;
end;

procedure TCopyFileThread.Execute;
begin
  fparent.Lock;
  try
    fparent.copy;
  finally
    fparent.Unlock;
  end;
end;

(* hoffe das haut hin...habs nicht ausprobiert *)