procedure TfrmMain.btCopyClick(Sender: TObject);
var
CopyDir: TCopyDir;
Log: TStringList;
begin
CopyDir := TCopyDir.Create('C:\', 'D:\');
CopyDir.Start;
Log := CopyDir.GetLog;
CopyDir.Free;
end;uses
CopyDir
[...]
procedure TfrmMain.btCopyClick(Sender: TObject);
var
CopyDir: TCopyDir;
Log: TStringList;
begin
CopyDir := TCopyDir.Create('C:\', 'D:\'); // copy content of "C:" to "D:"
CopyDir.PrintToTerminal := true; // print progress information
CopyDir.CopyReadOnlyFiles := true; // copy files with attribut "ReadOnly"
CopyDir.CopyHiddenFiles := false; // don't copy files with attribut "Hidden"
CopyDir.CopySystemFiles := false; // don't copy files with attribut "SystemFile"
CopyDir.CopyArchiveFiles := true; // copy files with attribut "Archive"
CopyDir.PreserverFileDates := true; // preserve dates of copied files
{$IFNDEF Unix}
// TCopyDir.PreserveAttributes is not available for Unix systems
// (Unit "FileUtil" is not able to set attributes on Unix system)
CopyDir.PreserveAttributes := true; // preserve attributes of copied files
{$ENDIF}
CopyDir.Enumerate; // this is optional; files added to directory after enumeration won't be copied
CopyDir.Start;
Log := CopyDir.GetLog;
CopyDir.Free;
end;if (self._enumerated) and ((self._dirsCreated) or (Length(self._directories) = 0) ) and
(Length(self._files) > 0) then
{$IFDEF Unix} self._preserveAttributes := false; in line 278. I'm sorry for that error! May I link your post to the start post so that everybody will see the bug?...This URL is dead.
https://github.com/Alexey-T/CudaText/blob/master/comp/copydir.pas (https://github.com/Alexey-T/CudaText/blob/master/comp/copydir.pas)
* TCOPYDIR
* ========
* v2.1
*
* This unit contains "TCopyDir" class wich copies entire directories (incl. its
* subdirectories)
*
* Author: bastla (@ Supernature-Forum / @ Lazarus Forum)
* License: Free Domain
*
* How TCopyDir works:
* -------------------
* TCopyDir uses TFileSearcher to enumerate a whole directory and copies its
* content file by file.
* Because of using LCL-components only, this class should work on all available
* platforms supported by Lazarus and LCL.
https://swissdelphicenter.ch/en/showcode.php?id=152 Windows only. Old but still works.in VBA still one of my favorite Functions, because of the FOF_ALLOWUNDO-Flag for Deleting
* 2021.06.07 - changes by Josh on Lazarus Forum
* Added _copyAllFiles _copyOnlyIfExists,_copyIfNewer,_copyIfSizeChanged,
* _abortcopy,_copycomparefiles:Boolean
*
* Ability to AbortCopy Routine by useer setting _Abortcopy to true in GUI.
*
* Ability To Keep App Responsive
* _AppProcessMessagesCounterInterval:integer;
* _keepalive:boolean;
*
* Configureable Buffer Copy
* _usebufferedcopy:boolean;
* _comparebuffersize:LongInt;
* _CopyBuffer,_CompBuffer1,_CompBuffer2:Array of Byte;
* _copybuffersize:LongInt;
*
* Variables to keep Track of Routine for User
* _CopyDirProcessedFromFile:String;
* _CopyDirProcessedFromFileSize:int64;
* _TotalBytesToCopy,_TotalByteProcessed,_ActutalBytesCopied,_appproctickcounter:Qword;
@CM360The best solution is to use GettTickCount64 instead of GettickCount, but this will break compatibility with WinXP.
Maybe make a pull-request. I don't know the Copydir code, so cannot fix.
@CM360The best solution is to use GettTickCount64 instead of GettickCount, but this will break compatibility with WinXP.
Maybe make a pull-request. I don't know the Copydir code, so cannot fix.