Gå til innhold

Anbefalte innlegg

Videoannonse
Annonse

Dette funker hos meg. Hvis du ser på den, så har jeg lagt inn callback funksjon - slik at jeg kan få tilbakemelding når hver fil eller mappe blir kopiert - jeg bare definerer privat procedure på formen jeg kaller dette fra hvor jeg kan, for eksempel, endre tekst på label for å vise hvilken fil/mappe blir kopiert nå.

 

Koden er ikke helt optimal, det mangler bl. a. mulighet til å ikke angi callback funksjonen (if assigned ... ), men du kan bare slette alle referanser til den hvis du ikke trenger den.

 

type TCopyCallbackFunc = procedure(AName:String) of object;
function CopyDir(ASourceDir,ADestDir:String;ACallback:TCopyCallbackFunc):Boolean;
function CopyAFile(const ASourceFile:String; const ADestFile:String):Boolean;

....
implementation

function CopyAFile(const ASourceFile:String; const ADestFile:String):Boolean;
begin
 Result:=CopyFile(PChar(ASourceFile), PChar(ADestFile),False);
end;

function CopyDir(ASourceDir,ADestDir:String;ACallback:TCopyCallbackFunc):Boolean;
var
 SR:TSearchRec;
 FindRes:Integer;
begin
 Result:=False;
 if not(DirectoryExists(ASourceDir)) then
   Raise Exception.CreateFmt('Source dir %s does not exist',[ASourceDir]);
 ACallback(ADestDir);
 if ((copy(ASourceDir,length(ASourceDir),1)='.') or (copy(ASourceDir,length(ASourceDir)-1,2)='..')) then
 begin
   Result:=True;
   Exit;
 end;
 ASourceDir:=IncludeTrailingBackslash(ASourceDir);
 ADestDir:=IncludeTrailingBackslash(ADestDir);
 ForceDirectories(ADestDir);
 FindRes:=FindFirst(ASourceDir+'*.*',faAnyFile,SR);
 try
   while FindRes=0 do
   begin
     if HasAttr(ASourceDir+SR.Name,faDirectory) then
       CopyDir(ASourceDir+SR.Name, ADestDir+SR.Name, ACallback)
     else
       try
         ACallback(ADestDir+SR.Name);
         CopyAFile(ASourceDir+SR.Name,ADestDir+SR.Name);
       except
         on e:exception do
         begin
           Result:=False;
           exit;
         end;
       end;
     FindRes:=FindNext(SR);
   end;
 finally
   SysUtils.FindClose(SR);
 end;
end;

Lenke til kommentar

Bli med i samtalen

Du kan publisere innhold nå og registrere deg senere. Hvis du har en konto, logg inn nå for å poste med kontoen din.

Gjest
Skriv svar til emnet...

×   Du har limt inn tekst med formatering.   Lim inn uten formatering i stedet

  Du kan kun bruke opp til 75 smilefjes.

×   Lenken din har blitt bygget inn på siden automatisk.   Vis som en ordinær lenke i stedet

×   Tidligere tekst har blitt gjenopprettet.   Tøm tekstverktøy

×   Du kan ikke lime inn bilder direkte. Last opp eller legg inn bilder fra URL.

Laster...
  • Hvem er aktive   0 medlemmer

    • Ingen innloggede medlemmer aktive
×
×
  • Opprett ny...