├── README.md ├── images ├── Overview.png └── sync_example.png ├── license.md └── src ├── CopyCommander2.lpi ├── CopyCommander2.lpr ├── how_to_use.md ├── ucopycommander.pas ├── ufifo.pas ├── unit1.lfm ├── unit1.pas ├── unit2.lfm ├── unit2.pas ├── unit3.lfm ├── unit3.pas ├── unit4.lfm ├── unit4.pas ├── unit5.lfm └── unit5.pas /README.md: -------------------------------------------------------------------------------- 1 | CopyCommander is a tool for windows/linux to use queued file-copy/moves from one to another directory. It also allows synchronizing of files over two directories. 2 | 3 | ![Overview](images/Overview.png) 4 | 5 | A manual can be found [here](src/how_to_use.md) 6 | 7 | If you do not have Lazarus you can directly download a precompiled binary [from](https://www.corpsman.de/klickcounter.php?url=download/copycommander.zip). 8 | 9 | -------------------------------------------------------------------------------- /images/Overview.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/CopyCommander2/bb30e1986612e9822aa6ffdcbc9bef23429c6684/images/Overview.png -------------------------------------------------------------------------------- /images/sync_example.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PascalCorpsman/CopyCommander2/bb30e1986612e9822aa6ffdcbc9bef23429c6684/images/sync_example.png -------------------------------------------------------------------------------- /license.md: -------------------------------------------------------------------------------- 1 | There are two licenses for this software you can choose of: 2 | # 1. Postcardware 3 | you can download COPYING.Postcardware using this link:
4 | https://github.com/PascalCorpsman/Software_Licenses/blob/main/COPYING.Postcardware.txt 5 | 6 | or 7 | # 2. modified LGPL (as described in COPYING.modifiedLGPL) 8 | you can download COPYING.modifiedLGPL using this link:
9 | https://github.com/PascalCorpsman/Software_Licenses/blob/main/COPYING.modifiedLGPL.txt 10 | 11 | 12 | -------------------------------------------------------------------------------- /src/CopyCommander2.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | <Scaled Value="True"/> 13 | <ResourceType Value="res"/> 14 | <UseXPManifest Value="True"/> 15 | <XPManifest> 16 | <DpiAware Value="True"/> 17 | </XPManifest> 18 | </General> 19 | <BuildModes Count="1"> 20 | <Item1 Name="Default" Default="True"/> 21 | </BuildModes> 22 | <PublishOptions> 23 | <Version Value="2"/> 24 | <UseFileFilters Value="True"/> 25 | </PublishOptions> 26 | <RunParams> 27 | <FormatVersion Value="2"/> 28 | </RunParams> 29 | <RequiredPackages Count="2"> 30 | <Item1> 31 | <PackageName Value="TAChartLazarusPkg"/> 32 | </Item1> 33 | <Item2> 34 | <PackageName Value="LCL"/> 35 | </Item2> 36 | </RequiredPackages> 37 | <Units Count="9"> 38 | <Unit0> 39 | <Filename Value="CopyCommander2.lpr"/> 40 | <IsPartOfProject Value="True"/> 41 | </Unit0> 42 | <Unit1> 43 | <Filename Value="unit1.pas"/> 44 | <IsPartOfProject Value="True"/> 45 | <ComponentName Value="Form1"/> 46 | <HasResources Value="True"/> 47 | <ResourceBaseClass Value="Form"/> 48 | <UnitName Value="Unit1"/> 49 | </Unit1> 50 | <Unit2> 51 | <Filename Value="ucopycommander.pas"/> 52 | <IsPartOfProject Value="True"/> 53 | </Unit2> 54 | <Unit3> 55 | <Filename Value="..\Sample\DatenSteuerung\ufifo.pas"/> 56 | <IsPartOfProject Value="True"/> 57 | </Unit3> 58 | <Unit4> 59 | <Filename Value="unit2.pas"/> 60 | <IsPartOfProject Value="True"/> 61 | <ComponentName Value="Form2"/> 62 | <HasResources Value="True"/> 63 | <ResourceBaseClass Value="Form"/> 64 | <UnitName Value="Unit2"/> 65 | </Unit4> 66 | <Unit5> 67 | <Filename Value="unit3.pas"/> 68 | <IsPartOfProject Value="True"/> 69 | <ComponentName Value="Form3"/> 70 | <HasResources Value="True"/> 71 | <ResourceBaseClass Value="Form"/> 72 | <UnitName Value="Unit3"/> 73 | </Unit5> 74 | <Unit6> 75 | <Filename Value="unit4.pas"/> 76 | <IsPartOfProject Value="True"/> 77 | <ComponentName Value="Form4"/> 78 | <HasResources Value="True"/> 79 | <ResourceBaseClass Value="Form"/> 80 | <UnitName Value="Unit4"/> 81 | </Unit6> 82 | <Unit7> 83 | <Filename Value="unit5.pas"/> 84 | <IsPartOfProject Value="True"/> 85 | <ComponentName Value="Form5"/> 86 | <HasResources Value="True"/> 87 | <ResourceBaseClass Value="Form"/> 88 | <UnitName Value="Unit5"/> 89 | </Unit7> 90 | <Unit8> 91 | <Filename Value="how_to_use.md"/> 92 | <IsPartOfProject Value="True"/> 93 | </Unit8> 94 | </Units> 95 | </ProjectOptions> 96 | <CompilerOptions> 97 | <Version Value="11"/> 98 | <PathDelim Value="\"/> 99 | <Target> 100 | <Filename Value="CopyCommander2"/> 101 | </Target> 102 | <SearchPaths> 103 | <IncludeFiles Value="$(ProjOutDir)"/> 104 | <OtherUnitFiles Value="..\Sample\DatenSteuerung"/> 105 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 106 | </SearchPaths> 107 | <Linking> 108 | <Options> 109 | <Win32> 110 | <GraphicApplication Value="True"/> 111 | </Win32> 112 | </Options> 113 | </Linking> 114 | </CompilerOptions> 115 | <Debugging> 116 | <Exceptions Count="3"> 117 | <Item1> 118 | <Name Value="EAbort"/> 119 | </Item1> 120 | <Item2> 121 | <Name Value="ECodetoolError"/> 122 | </Item2> 123 | <Item3> 124 | <Name Value="EFOpenError"/> 125 | </Item3> 126 | </Exceptions> 127 | </Debugging> 128 | </CONFIG> 129 | -------------------------------------------------------------------------------- /src/CopyCommander2.lpr: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* *) 3 | (* Author : Uwe Schächterle (Corpsman) *) 4 | (* *) 5 | (* This file is part of CopyCommander2 *) 6 | (* *) 7 | (* See the file license.md, located under: *) 8 | (* https://github.com/PascalCorpsman/Software_Licenses/blob/main/license.md *) 9 | (* for details about the license. *) 10 | (* *) 11 | (* It is not allowed to change or remove this text from any *) 12 | (* source file of the project. *) 13 | (* *) 14 | (******************************************************************************) 15 | Program project1; 16 | 17 | {$MODE objfpc}{$H+} 18 | 19 | Uses 20 | {$IFDEF UNIX} 21 | cthreads, 22 | {$ENDIF} 23 | {$IFDEF HASAMIGA} 24 | athreads, 25 | {$ENDIF} 26 | Interfaces, // this includes the LCL widgetset 27 | Forms, Unit1, Unit2, Unit3, Unit4, Unit5 28 | { you can add units after this }; 29 | 30 | {$R *.res} 31 | 32 | Begin 33 | RequireDerivedFormResource := True; 34 | Application.Scaled := True; 35 | Application.Initialize; 36 | Application.CreateForm(TForm1, Form1); 37 | Application.CreateForm(TForm2, Form2); 38 | Application.CreateForm(TForm3, Form3); 39 | Application.CreateForm(TForm4, Form4); 40 | Application.CreateForm(TForm5, Form5); 41 | Application.Run; 42 | End. 43 | 44 | -------------------------------------------------------------------------------- /src/how_to_use.md: -------------------------------------------------------------------------------- 1 | # Manual for CopyCommander2 2 | 3 | ## Usage 4 | 5 | This Programm is orientated on the "Total Commander" application for Windows. 6 | 7 | The main porpuse of this programm is copying and moveing files / directories, in a queue. 8 | 9 | ### Sync folder feature 10 | 11 | Navigate to two different folders that you want to be synchronized. Press CTRL + S to open the synchronize folder dialog. 12 | 13 | ![](../images/sync_example.png) 14 | 15 | In the upcomming dialog you can see the suggestions by the programm for the copy jobs to make both folders "same". 16 | 17 | By right click in the Synchronize Dialog you can change the copy direction of files, or 18 | disable copying directories (also available the key commands "N", "L", "R") 19 | 20 | 21 | ### Main Screen 22 | 23 | Select some files, or folders with the mouse or keyboard and press 24 | 25 | F5 to copy the selected ones to the destination on the other side 26 | 27 | F6 to move the selected ones to the destination on the other side 28 | 29 | additional you can press 30 | 31 | F7 to prompt the create subfolder dialog 32 | 33 | F8 to delete a file or directoy 34 | 35 | CTRL + R to reload the actual folder view 36 | 37 | Drag and Drop exact one file from outside the programm into one of the listviews, will change the 38 | folderview to the desination of this file. 39 | 40 | Drag and Drop more then one file from outside into one of the listviews, will put them on 41 | the copy list, to copy them to the folder shown in the listview. 42 | 43 | ### The in app shortcutbuttons 44 | 45 | If you want to use predefined loaddirectories enter the path into one of the edit fields and right 46 | click on that field to open the popup menu, than click "Add". If you want to delete one of the 47 | shortcut buttons right click on the button and choose delete. 48 | 49 | ## License 50 | see [here](https://github.com/PascalCorpsman/CopyCommander2/blob/main/license.md) 51 | 52 | ## Warranty 53 | There is no warranty ! 54 | -------------------------------------------------------------------------------- /src/ucopycommander.pas: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* *) 3 | (* Author : Uwe Schächterle (Corpsman) *) 4 | (* *) 5 | (* This file is part of CopyCommander2 *) 6 | (* *) 7 | (* See the file license.md, located under: *) 8 | (* https://github.com/PascalCorpsman/Software_Licenses/blob/main/license.md *) 9 | (* for details about the license. *) 10 | (* *) 11 | (* It is not allowed to change or remove this text from any *) 12 | (* source file of the project. *) 13 | (* *) 14 | (******************************************************************************) 15 | Unit ucopycommander; 16 | 17 | {$MODE ObjFPC}{$H+} 18 | 19 | Interface 20 | 21 | Uses 22 | Classes, SysUtils, ufifo; 23 | 24 | Const 25 | (* 26 | * Dieser Wert ist empirisch bestimmt 27 | * 4096 entspricht dabei der Blockgröße einer Standard NTFS-Festplatte 28 | * 29 | * Messung mit 8168, Avg Copy Speed ~ 38-42 MB / s 30 | * Messung mit 4096, Avg Copy Speed ~ 55-64 MB / s 31 | * Messung mit 2048, Avg Copy Speed ~ 40-40 MB / s 32 | *) 33 | FileCopyBufferSize = 4096; 34 | 35 | Type 36 | 37 | 38 | TJobType = ( 39 | jtCopyDir, 40 | jtCopyFile, 41 | jtMoveDir, 42 | jtMoveFile, 43 | jtDelFile, 44 | jtDelDir 45 | ); 46 | 47 | TJobAnswers = ( 48 | jaNotChoosen, // Der User hat sich noch nicht entschieden 49 | jaReplace, // Die Zieldatei soll mit der Quelldatei überschrieben werden 50 | jaSkip // Das Kopieren dieser einen Datei soll Abgrbrochen werden 51 | ); 52 | 53 | { TJob } 54 | 55 | TJob = Class // Das müsste natürlich eigentlich gar keine Klasse sein, aber es muss leider von TObject abgeleitet sein .. 56 | public 57 | Source: String; 58 | Dest: String; 59 | JobType: TJobType; 60 | // Es folgen die Antwortmöglichkeiten die ein User eingegeben haben kann 61 | ToAll: Boolean; 62 | Answer: TJobAnswers; 63 | Constructor Create(); 64 | End; 65 | 66 | TJobArray = Array Of TJob; 67 | 68 | TTransfereStatistic = Record 69 | TransferedBytesInLast1000ms: UInt64; // Anzahl Bytes welche in den letzten 1000ms übertragen wurden. 70 | JobsToDo: integer; // Anzahl noch Aussstehender Jobs 71 | SubJobsTodo: integer; // Anzahl der noch zu bearbeitenden SubJobs 72 | BytesToCopyToFinishJobs: UInt64; // Anzahl der "Bytes" die kopiert werden müssen um alle offenen Jobs Ab zu arbeiten \ 73 | BytesCopiedInJobs: UInt64; // Anzahl Bytes, welche gesammt kopiert wurden > Sobald alle Jobs abgearbeitet wurden, gehen diese Zähler wieder auf 0 74 | TotalJobBytes: uint64; // Gesammt Anzahl an Bytes welche zur Abarbeitung der Jobs kopiert werden müssen / 75 | End; 76 | 77 | TOnJobEvent = Procedure(Sender: TObject; Job: TJob) Of Object; 78 | TOnFileCopyProgress = Procedure(Sender: TObject; Const Job: TJob; Percent: Byte) Of Object; 79 | TOnByteTransfereStatistic = Procedure(Sender: TObject; Statistic: TTransfereStatistic) Of Object; 80 | TOnAddSubJobs = Procedure(Sender: TObject; Const Job: TJob; Const SubJobs: TJobArray) Of Object; 81 | 82 | TErrorJob = Record 83 | Job: TJob; 84 | ErrorMessage: String; 85 | End; 86 | 87 | TJobFifo = specialize TFifo < TJob > ; 88 | TErrorJobFifo = specialize TFifo < TErrorJob > ; 89 | 90 | { TWorkThread } 91 | 92 | TWorkThread = Class(TThread) 93 | private 94 | fAJob: TJob; // Der Job der Im Moment Abgearbeitet wird. 95 | fJobProgress: Byte; // Fortschritt in Prozent füf den Aktuellen Job 96 | fStatistic: TTransfereStatistic; 97 | fStatisticTimeStamp: QWord; // Zeitstempel an dem das letzte Mal "aufgenommen" wurde 98 | 99 | FCancelallJobs: Boolean; // Wenn True, dann wird einfach alles abgebrochen 100 | fCancelActualJob: boolean; // Bricht den Aktuellen Job ab 101 | FInJobFifo: TJobFifo; // Alle noch ab zu arbeitenden Jobs 102 | fSubJubFifo: TJobFifo; // Jobs wie Copy / Move / Del Ordner benötigen Subjobs, die Variable wird nur in DoJob benötigt, so muss sie nicht ständig erzeugt und wieder frei gegeben werden.. 103 | FErrorJobFifo: TErrorJobFifo; // Alle Jobs die einen Fehler hatten, und deren Fehlermeldung 104 | FQuestionJobFifo: TJobFifo; // Alle Jobs welche 105 | fAllResult: TJobAnswers; // Wenn ein Nutzer eine "für" alle antwort gemacht hat gillt die immer so lange bis alle Jobs abgearbeitet sind. 106 | 107 | fLCLSubJobArray: TJobArray; // Zum Synchronized aufruf mit LCLOnAddSubJobs 108 | 109 | fCopyFileDetailError: String; // Details warum FileCopy fehlgeschlagen ist 110 | 111 | Function FileCopy(source, dest: String): Boolean; // Die Funktion, welche das Tatsächliche Datei kopieren macht 112 | Function getHasErrorJobs: Boolean; 113 | Function GetHasQuestions: Boolean; 114 | 115 | Procedure Init(); // Ersatz für Create 116 | Procedure TearDown(); // Ersatz für Destroy 117 | 118 | Function DoJob(): Boolean; // Führt Alle Prüfungen und Vorbereitenden Arbeiten zu einem Job aus 119 | Procedure CheckForOnFileTransfereStatistic; // Generiert den VCL Aufrufe für die Statistiken 120 | 121 | (* 122 | * Alle Folgenden Proceduren werden via Synchronize aufgerufen. 123 | *) 124 | Procedure LCLOnByteTransfereStatistic; 125 | Procedure LCLOnStartJob(); 126 | Procedure LCLOnFinishJob(); 127 | Procedure LCLOnAddSubJobs(); 128 | public 129 | OnByteTransfereStatistic: TOnByteTransfereStatistic; // Wird alle 1000ms aufgerufen und gibt an, wie viel Bytes seit her übertragen wurden. 130 | OnStartJob: TOnJobEvent; 131 | OnFileCopyProgress: TOnFileCopyProgress; 132 | OnFinishJob: TOnJobEvent; 133 | OnAddSubJobs: TOnAddSubJobs; // Wird aufgerufen, wenn ein Job job so komplex ist dass er in Unterjobs zerlegt wurde 134 | JobPause: Boolean; // Wenn True, wird das Aktuelle Kopieren Paussiert, Achtung, das darf nicht "PAUSE" heißen sonst verhällt sich der Thread sehr strange. 135 | Property AllResult: TJobAnswers read fAllResult; // Die Antwort auf alle Fragen 136 | Property HasErrorJobs: Boolean read getHasErrorJobs; 137 | Property HasQuestions: Boolean read GetHasQuestions; 138 | Procedure Execute; override; 139 | Procedure AddJob(Const Job: TJob); 140 | Function JobsPending(): Boolean; // True, wenn der Worker noch irgendwas zu tun hat... 141 | Procedure CancelAllJobs(); 142 | Function PopErrorJob(): TErrorJob; 143 | Procedure CancelJob(Job: TJob); // nimmt den Job aus der internen Bearbeitung und gibt ihn frei 144 | 145 | Function TopQuestion(): TJob; 146 | Function PopQuestion(): TJob; 147 | End; 148 | 149 | (* 150 | * Ermittelt die Dateigröße einer gegebenen Datei, Fehler = 0 151 | *) 152 | Function GetFileSize(Filename: String): Int64; 153 | Function GetDirSize(Directory: String): Int64; 154 | 155 | (* 156 | * Ermittelt den Zeitsptempel an dem eine Datei zuletzt verändert wurde. 157 | *) 158 | //Function GetFileModifiedTime(Filename: String): Longint; 159 | 160 | (* 161 | * Wandelt eine Dateigröße in Bytes um in einen "pretty" Printed String 162 | *) 163 | Function FileSizeToString(Value: Int64): String; 164 | 165 | (* 166 | * Wandelt einen Jop in einen Einzeiligen String um 167 | *) 168 | Function JobToString(Const Job: TJob): String; 169 | 170 | Function GetFreeDiskSpaceOf(afolder: String): int64; 171 | 172 | Function GetAllAvailableDrives(): TStringList; 173 | 174 | Implementation 175 | 176 | Uses 177 | //dos, // Für GetFileModifiedTime 178 | LazFileUtils, LazUTF8, math 179 | {$IFDEF Windows} 180 | , windows 181 | {$ENDIF} 182 | ; 183 | 184 | Procedure Nop(); 185 | Begin 186 | 187 | End; 188 | 189 | Function GetFileSize(Filename: String): Int64; 190 | Var 191 | sr: TSearchRec; 192 | Begin 193 | result := 0; 194 | // Alle Verzeichnisse 195 | If FindFirstutf8(Filename, faAnyFile, SR) = 0 Then Begin 196 | result := sr.Size; 197 | FindCloseutf8(SR); 198 | End; 199 | End; 200 | 201 | Function GetDirSize(Directory: String): Int64; 202 | Var 203 | sr: TSearchRec; 204 | Begin 205 | result := 0; 206 | If FindFirstutf8(IncludeTrailingPathDelimiter(Directory) + '*', faAnyFile, SR) = 0 Then Begin 207 | Repeat 208 | If (SR.Attr And FaDirectory = FaDirectory) Then Begin 209 | If (sr.Name <> '.') And (sr.Name <> '..') Then Begin 210 | result := result + GetDirSize(IncludeTrailingPathDelimiter(Directory) + sr.Name); 211 | End; 212 | End 213 | Else Begin 214 | result := result + sr.Size; 215 | End; 216 | Until FindNextutf8(SR) <> 0; 217 | FindCloseutf8(SR); 218 | End; 219 | End; 220 | 221 | Function GetFreeDiskSpaceOf(afolder: String): int64; 222 | Var 223 | {$IFDEF Windows} 224 | currP: String; 225 | {$ENDIF} 226 | DiskNum: integer; 227 | Begin 228 | {$IFDEF Windows} 229 | DiskNum := 0; 230 | currP := GetCurrentDirUTF8; 231 | SetCurrentDirUTF8(afolder); 232 | {$ELSE} 233 | DiskNum := AddDisk(afolder); 234 | result := DiskFree(DiskNum); 235 | {$ENDIF} 236 | result := DiskFree(DiskNum); 237 | {$IFDEF Windows} 238 | SetCurrentDirUTF8(currP); 239 | {$ENDIF} 240 | End; 241 | 242 | (* 243 | * Inspired by: https://wiki.lazarus.freepascal.org/Windows_Programming_Tips#Listing_all_available_drives 244 | *) 245 | 246 | Function GetAllAvailableDrives: TStringList; 247 | {$IFDEF Windows} 248 | Var 249 | OldMode: Word; 250 | Drive: Char; 251 | DriveLetter: String; 252 | {$ENDIF} 253 | Begin 254 | result := TStringList.Create; 255 | {$IFDEF Windows} 256 | // Empty Floppy or Zip drives can generate a Windows error. 257 | // We disable system errors during the listing. 258 | // Note that another way to skip these errors would be to use DEVICE_IO_CONTROL. 259 | OldMode := SetErrorMode(SEM_FAILCRITICALERRORS); 260 | Try 261 | // Search all drive letters 262 | For Drive := 'A' To 'Z' Do Begin 263 | DriveLetter := Drive + ':\'; 264 | If GetDriveType(PChar(DriveLetter)) <> DRIVE_NO_ROOT_DIR Then Begin 265 | result.add(DriveLetter); 266 | End; 267 | End; 268 | Finally 269 | // Restores previous Windows error mode. 270 | SetErrorMode(OldMode); 271 | End; 272 | {$ENDIF} 273 | End; 274 | 275 | //Function GetFileModifiedTime(Filename: String): Longint; 276 | //Var 277 | // f: File; 278 | // b: Boolean; 279 | // // DT: DateTime; 280 | //Begin 281 | // If FileExistsUTF8(Filename) Then Begin 282 | // b := true; 283 | // Try 284 | // result := 0; // Beruhigt den Compiler 285 | // assignfile(f, utf8tosys(FileName)); 286 | // reset(f); 287 | // GetFTime(f, result); 288 | // closefile(f); 289 | // b := false; 290 | // Except 291 | // result := 0; 292 | // End; 293 | // If b Then 294 | // Raise Exception.create('Error can not open the file : ' + Filename); 295 | // End 296 | // Else Begin 297 | // Raise Exception.create('Error could not Open : ' + Filename); 298 | // End; 299 | // // Damit man sich die Ermittelten Daten auch ansehen kann 300 | // // UnPackTime(Result, DT); 301 | // // showmessage( 302 | // // opendialog1.FileName + #13#10 + 303 | // // inttostr(dt.Day) + '.' + 304 | // // inttostr(dt.Month) + '.' + 305 | // // inttostr(dt.Year) + ' ' + 306 | // // inttostr(dt.Hour) + ':' + 307 | // // inttostr(dt.Min) + '.' + 308 | // // inttostr(dt.Sec)); 309 | //End; 310 | 311 | Function FileSizeToString(Value: Int64): String; // ACHTUNG: bei Änderungen "SortListviewFromTo" berücksichtigen ! 312 | Var 313 | s: char; 314 | r: Int64; 315 | Begin 316 | s := ' '; 317 | r := 0; 318 | If value > 1024 Then Begin 319 | s := 'K'; 320 | r := value Mod 1024; 321 | value := value Div 1024; 322 | End; 323 | If value > 1024 Then Begin 324 | s := 'M'; 325 | r := value Mod 1024; 326 | value := value Div 1024; 327 | End; 328 | If value > 1024 Then Begin 329 | s := 'G'; 330 | r := value Mod 1024; 331 | value := value Div 1024; 332 | End; 333 | If value > 1024 Then Begin 334 | s := 'T'; 335 | r := value Mod 1024; 336 | value := value Div 1024; 337 | End; 338 | If value > 1024 Then Begin 339 | s := 'P'; 340 | r := value Mod 1024; 341 | value := value Div 1024; 342 | End; 343 | If (r Div 100) <> 0 Then 344 | result := inttostr(value) + ',' + inttostr(r Div 100) + s + 'B' 345 | Else 346 | result := inttostr(value) + s + 'B' 347 | End; 348 | 349 | Function JobToString(Const Job: TJob): String; 350 | Begin 351 | result := 'Error'; 352 | Case Job.JobType Of 353 | jtCopyDir, jtCopyFile: result := 'Copy '; 354 | jtMoveDir, jtMoveFile: result := 'Move '; 355 | jtDelDir, jtDelFile: result := 'Delete '; 356 | End; 357 | result := result + job.Source; 358 | If Not (Job.JobType In [jtDelDir, jtDelFile]) Then Begin 359 | result := result + ' -> ' + job.Dest; 360 | End; 361 | End; 362 | 363 | Function ToErrorJob(Const Job: TJob; Const ErrorMsg: String): TErrorJob; 364 | Begin 365 | result.Job := Job; 366 | Result.ErrorMessage := ErrorMsg; 367 | End; 368 | 369 | { TJob } 370 | 371 | Constructor TJob.Create; 372 | Begin 373 | ToAll := false; 374 | Answer := jaNotChoosen; 375 | End; 376 | 377 | { TWorkThread } 378 | 379 | Function TWorkThread.FileCopy(source, dest: String): Boolean; 380 | Var 381 | SourceFile, DestFile: integer; 382 | FileSize, RemainingFileSize: QWord; 383 | buffer: Array[0..FileCopyBufferSize - 1] Of Byte; 384 | BufferSize: Integer; 385 | FreeDiskSpace: Int64; 386 | Begin 387 | fCopyFileDetailError := 'Unknown error'; 388 | Result := False; 389 | If FCancelallJobs Or fCancelActualJob Or (source = dest) Then Begin 390 | fCopyFileDetailError := ''; 391 | result := true; 392 | exit; 393 | End; 394 | // Sicherstellen das dest nicht existiert, Die Fälle wo es existieren darf und 395 | // Nicht "überschrieben" werden soll klärt der Aufrufer!. 396 | If FileExistsUTF8(dest) Then Begin 397 | If Not DeleteFileUTF8(dest) Then Begin 398 | fCopyFileDetailError := 'Could not delete dest file'; 399 | exit; 400 | End; 401 | End; 402 | Try 403 | SourceFile := FileOpen(utf8tosys(source), fmOpenRead); 404 | If SourceFile = 0 Then Begin 405 | fCopyFileDetailError := 'Unable to read source file'; 406 | exit; 407 | End; 408 | (* 409 | * We need to cast the 0 to force the compiler to use the 64-Bit version, otherwise 410 | * the filesize is wrong for files larger then (2^31)-1 Bytes 411 | *) 412 | FileSize := FileSeek(SourceFile, int64(0), fsFromEnd); 413 | RemainingFileSize := FileSize; 414 | // Prüfen ob die Datei auf dem Ziellaufwerk überhaupt noch genug Platz hat 415 | FreeDiskSpace := GetFreeDiskSpaceOf(ExtractFilePath(dest)); 416 | If FreeDiskSpace <= RemainingFileSize Then Begin 417 | fCopyFileDetailError := 'Not enough diskspace at destination available'; 418 | exit; 419 | End; 420 | DestFile := FileCreate(utf8tosys(dest)); 421 | If DestFile = 0 Then Begin 422 | fCopyFileDetailError := 'Unable to create destination file'; 423 | FileClose(SourceFile); 424 | exit; 425 | End; 426 | FileSeek(SourceFile, 0, fsFromBeginning); 427 | fJobProgress := 0; 428 | While RemainingFileSize > 0 Do Begin 429 | If FCancelallJobs Or fCancelActualJob Or Terminated Then Begin 430 | FileClose(DestFile); 431 | FileClose(SourceFile); 432 | fCopyFileDetailError := ''; 433 | result := true; // Das Stimmt zwar nicht, erzeugt aber im Abgang die wenigsten Fehler, Störungen 434 | exit; 435 | End; 436 | If JobPause Then Begin 437 | Sleep(1); // Sonst erzeugen wir nur Unnötig Last es geht ja ums "Still" Sein. 438 | End 439 | Else Begin 440 | (* Das Eigentliche Kopieren *) 441 | BufferSize := FileRead(SourceFile, buffer, SizeOf(buffer)); 442 | If BufferSize = 0 Then Begin 443 | // Die Quelldatei konnte nicht gelesen werden 444 | FileClose(SourceFile); 445 | FileClose(DestFile); 446 | fCopyFileDetailError := 'Sourcefile read error'; 447 | exit; 448 | End; 449 | If FileWrite(DestFile, buffer, BufferSize) = -1 Then Begin 450 | // Irgendwas hat nen Fehler ausgelöst 451 | FileClose(SourceFile); 452 | FileClose(DestFile); 453 | fCopyFileDetailError := 'Destfile write error'; 454 | exit; 455 | End; 456 | // Und noch die Statistik Nach ziehen 457 | RemainingFileSize := RemainingFileSize - BufferSize; 458 | fStatistic.TransferedBytesInLast1000ms := fStatistic.TransferedBytesInLast1000ms + BufferSize; 459 | fStatistic.BytesCopiedInJobs := fStatistic.BytesCopiedInJobs + BufferSize; 460 | End; 461 | fJobProgress := min(100, max(0, 100 - ((100 * RemainingFileSize) Div FileSize))); 462 | CheckForOnFileTransfereStatistic(); 463 | End; 464 | FileClose(DestFile); 465 | // TODO: evtl fehlt hier noch a bissl was ... 466 | //{$IFDEF Windows} 467 | //FileSetDate(DestFile, FileGetDate(SourceFile)); 468 | //FileSetAttr(dest, FileGetAttr(source)); 469 | //{$ELSE} 470 | // FileClose(DestFile); 471 | // SetFileAge(dest, getModifiedTime(source)); 472 | // FileGetDate(SourceFile)); 473 | //{$ENDIF} 474 | FileClose(SourceFile); 475 | Except 476 | // KA was ich da noch Vergessen habe 477 | On AV: Exception Do Begin 478 | fCopyFileDetailError := av.Message; 479 | exit; 480 | End; 481 | End; 482 | fCopyFileDetailError := ''; 483 | Result := True; 484 | End; 485 | 486 | Function TWorkThread.getHasErrorJobs: Boolean; 487 | Begin 488 | If assigned(FErrorJobFifo) Then Begin 489 | result := Not FErrorJobFifo.isempty; 490 | End 491 | Else Begin 492 | // This could only be happen, if the question was asked before the Thread Inits itself 493 | result := false; 494 | End; 495 | End; 496 | 497 | Function TWorkThread.GetHasQuestions: Boolean; 498 | Begin 499 | If assigned(FQuestionJobFifo) Then Begin 500 | result := Not FQuestionJobFifo.isempty; 501 | End 502 | Else Begin 503 | // This could only be happen, if the question was asked before the Thread Inits itself 504 | result := false; 505 | End; 506 | End; 507 | 508 | Procedure TWorkThread.Init; 509 | Begin 510 | fLCLSubJobArray := Nil; 511 | fAllResult := jaNotChoosen; 512 | FCancelallJobs := false; 513 | fCancelActualJob := false; 514 | JobPause := false; 515 | fAJob := Nil; 516 | fJobProgress := 0; 517 | FInJobFifo := TJobFifo.create; 518 | fSubJubFifo := TJobFifo.create; 519 | FQuestionJobFifo := TJobFifo.create; 520 | FErrorJobFifo := TErrorJobFifo.create; 521 | fStatisticTimeStamp := GetTickCount64; 522 | fStatistic.JobsToDo := 0; 523 | fStatistic.SubJobsTodo := 0; 524 | fStatistic.TransferedBytesInLast1000ms := 0; 525 | fStatistic.BytesToCopyToFinishJobs := 0; 526 | fStatistic.BytesCopiedInJobs := 0; 527 | End; 528 | 529 | Procedure TWorkThread.TearDown; 530 | Var 531 | ej: TErrorJob; 532 | j: TJob; 533 | Begin 534 | setlength(fLCLSubJobArray, 0); // der Inhalt wird nicht freigegeben, da er von anderen Stellen her schon Kontrolliert wird !! 535 | 536 | While Not FErrorJobFifo.isempty Do Begin 537 | ej := FErrorJobFifo.Pop; 538 | ej.Job.Free; 539 | End; 540 | FErrorJobFifo.free; 541 | FErrorJobFifo := Nil; 542 | 543 | While Not FQuestionJobFifo.isempty Do Begin 544 | j := FQuestionJobFifo.Pop; 545 | J.Free; 546 | End; 547 | FQuestionJobFifo.free; 548 | FQuestionJobFifo := Nil; 549 | 550 | While Not FInJobFifo.isempty Do Begin 551 | j := FInJobFifo.Pop; 552 | J.Free; 553 | End; 554 | FInJobFifo.free; 555 | FInJobFifo := Nil; 556 | 557 | While Not fSubJubFifo.isempty Do Begin 558 | j := fSubJubFifo.Pop; 559 | J.Free; 560 | End; 561 | fSubJubFifo.free; 562 | fSubJubFifo := Nil; 563 | End; 564 | 565 | (* 566 | * FaJob ist Absichtlich kein Übergabeparameter, denn so kann er in all den Synchronize Routinen direkt mit genutzt werden. 567 | *) 568 | 569 | Function TWorkThread.DoJob: Boolean; 570 | 571 | Procedure AddFolderToSubfifo(Mode: Boolean; aSourceFolder, ADestFolder: String); 572 | Var 573 | Job: TJob; 574 | sr: TSearchRec; 575 | ja: TJobArray; 576 | i: Integer; 577 | Begin 578 | ja := Nil; 579 | If FindFirstutf8(IncludeTrailingPathDelimiter(aSourceFolder) + '*', faAnyFile, SR) = 0 Then Begin 580 | Repeat 581 | If (SR.Attr And FaDirectory = FaDirectory) Then Begin 582 | If (sr.Name <> '.') And (sr.Name <> '..') Then Begin 583 | AddFolderToSubfifo(mode, IncludeTrailingPathDelimiter(aSourceFolder) + sr.Name, IncludeTrailingPathDelimiter(ADestFolder) + sr.Name); 584 | // Wenn Verschoben wurde, löschen wir das Verzeichnis nach der Erfolgreichen Verschiebung.. 585 | If Not mode Then Begin 586 | job := TJob.Create; 587 | job.JobType := jtDelDir; 588 | job.Source := IncludeTrailingPathDelimiter(aSourceFolder) + sr.Name; 589 | job.Dest := ''; 590 | setlength(ja, high(ja) + 2); 591 | ja[high(ja)] := Job; 592 | fSubJubFifo.Push(job); 593 | End; 594 | End; 595 | End 596 | Else Begin 597 | job := TJob.Create; 598 | If mode Then Begin 599 | job.JobType := jtCopyFile; 600 | End 601 | Else Begin 602 | job.JobType := jtMoveFile; 603 | End; 604 | Job.Source := IncludeTrailingPathDelimiter(aSourceFolder) + sr.Name; 605 | Job.Dest := IncludeTrailingPathDelimiter(ADestFolder) + sr.Name; 606 | setlength(ja, high(ja) + 2); 607 | ja[high(ja)] := Job; 608 | fSubJubFifo.Push(job); 609 | End; 610 | Until FindNextutf8(SR) <> 0; 611 | FindCloseutf8(SR); 612 | End; 613 | If assigned(ja) And assigned(OnAddSubJobs) Then Begin 614 | setlength(fLCLSubJobArray, length(ja)); 615 | For i := 0 To high(ja) Do Begin 616 | fLCLSubJobArray[i] := ja[i]; 617 | End; 618 | Synchronize(@LCLOnAddSubJobs); 619 | End; 620 | End; 621 | 622 | Function DelFolder(aFolder: String): Boolean; 623 | Var 624 | sr: TSearchRec; 625 | Begin 626 | // Wir Versuchen was zu löschen was es schon gar nicht mehr gibt -> alles palletti 627 | If Not DirectoryExistsUTF8(aFolder) Then Begin 628 | result := true; 629 | exit; 630 | End; 631 | result := false; 632 | If FindFirstutf8(IncludeTrailingPathDelimiter(aFolder) + '*', faAnyFile, SR) = 0 Then Begin 633 | Repeat 634 | If (SR.Attr And FaDirectory = FaDirectory) Then Begin 635 | If (sr.Name <> '.') And (sr.Name <> '..') Then Begin 636 | result := DelFolder(IncludeTrailingPathDelimiter(aFolder) + sr.Name); 637 | If Not result Then Begin 638 | FindCloseutf8(SR); 639 | exit; 640 | End; 641 | End; 642 | End 643 | Else Begin 644 | result := DeleteFileUTF8(IncludeTrailingPathDelimiter(aFolder) + sr.Name); 645 | If Not result Then Begin 646 | FindCloseutf8(SR); 647 | exit; 648 | End; 649 | End; 650 | Until FindNextutf8(SR) <> 0; 651 | FindCloseutf8(SR); 652 | End; 653 | result := RemoveDirUTF8(aFolder); 654 | End; 655 | 656 | (* 657 | * Wird ein Job an die Errorlog übergeben, dann zählt er auch als Abgearbeitet. 658 | *) 659 | Procedure AddToErrorLog(Msg: String); 660 | Begin 661 | If Assigned(OnFinishJob) Then Begin 662 | Synchronize(@LCLOnFinishJob); 663 | End; 664 | FErrorJobFifo.push(ToErrorJob(fAJob, Msg)); 665 | End; 666 | 667 | Var 668 | oldJob, Job: TJob; 669 | s: String; 670 | Begin 671 | result := false; 672 | If Not assigned(fAJob) Then exit; 673 | If FCancelallJobs Or fCancelActualJob Then Begin 674 | // Beim Abcanceln der Jobs rufen wir den FinishJob dennoch auf, damit die LCL die Chance hat diesen aus ihren Listen zu streichen.. 675 | If Assigned(OnFinishJob) Then Begin 676 | Synchronize(@LCLOnFinishJob); 677 | End; 678 | result := true; 679 | exit; 680 | End; 681 | If Assigned(OnStartJob) Then Begin 682 | Synchronize(@LCLOnStartJob); 683 | End; 684 | // Alles Vorbereiten damit der Job Erledigt werden kann 685 | // Gibt es die Quelle überhaupt noch ? 686 | Case fAJob.JobType Of 687 | jtMoveFile, jtCopyFile: Begin 688 | If Not FileExistsUTF8(fAJob.Source) Then Begin 689 | AddToErrorLog('Source file does not exist anymore.'); 690 | exit; 691 | End; 692 | // Ziel Verzeichnis erstellen 693 | If Not ForceDirectoriesUTF8(ExtractFileDir(fAJob.Dest)) Then Begin 694 | AddToErrorLog('Unable to create destination folder.'); 695 | exit; 696 | End; 697 | If FileExistsUTF8(fAJob.Dest) Then Begin 698 | // Wenn die Datei schon existiert gibt es 2 Möglichkeiten 699 | If GetFileSize(fAJob.Source) = GetFileSize(fAJob.Dest) Then Begin 700 | // 1. Die Zieldatei ist Identisch zur Quelldatei (Anhand Dateigröße Bestimmt) -> ggf Warnung ausgeben 701 | // Nichts zu tun wir ignorieren das ganze einfach 702 | If Assigned(OnFinishJob) Then Begin 703 | Synchronize(@LCLOnFinishJob); 704 | End; 705 | result := true; 706 | exit; 707 | End 708 | Else Begin 709 | // 2. Die Zieldatei ist Unterschiedlich -> Auf die Rückfrage Fifo und Einfach weiter machen 710 | If fAllResult <> jaNotChoosen Then Begin 711 | fAJob.Answer := fAllResult; 712 | End; 713 | Case fAJob.Answer Of 714 | jaNotChoosen: Begin 715 | // Wir starten eine Useranfrage 716 | If Assigned(OnFinishJob) Then Begin 717 | Synchronize(@LCLOnFinishJob); 718 | End; 719 | FQuestionJobFifo.Push(fAJob); 720 | exit; 721 | End; 722 | jaSkip: Begin 723 | // Der user will das wir die Datei einfach auslassen 724 | If Assigned(OnFinishJob) Then Begin 725 | Synchronize(@LCLOnFinishJob); 726 | End; 727 | result := true; 728 | exit; 729 | End; 730 | jaReplace: Begin 731 | If Not DeleteFileUTF8(fAJob.Dest) Then Begin 732 | AddToErrorLog('Unable to delete destination file.'); 733 | exit; 734 | End; 735 | End; 736 | End; 737 | End; 738 | End; 739 | If Not FileCopy(fAJob.Source, fAJob.Dest) Then Begin 740 | AddToErrorLog('Unable to copy file to destination folder: ' + fCopyFileDetailError); 741 | exit; 742 | End; 743 | If fAJob.JobType = jtMoveFile Then Begin 744 | If Not DeleteFileUTF8(fAJob.Source) Then Begin 745 | AddToErrorLog('Unable to delete file.'); 746 | exit; 747 | End; 748 | End; 749 | End; 750 | jtMoveDir, jtCopyDir: Begin 751 | If Not DirectoryExistsUTF8(fAJob.Source) Then Begin 752 | AddToErrorLog('Source directory does not exist anymore.'); 753 | exit; 754 | End; 755 | // Ziel Ordner Erstellen 756 | s := extractfilename(ExcludeTrailingPathDelimiter(fAJob.Source)); 757 | If Not ForceDirectoriesUTF8(IncludeTrailingPathDelimiter(fAJob.Dest) + s) Then Begin 758 | AddToErrorLog('Unable to create dest dir.'); 759 | exit; 760 | End; 761 | // Rekursiv Verschieben / Kopieren 762 | AddFolderToSubfifo(fAJob.JobType = jtCopyDir, fAJob.Source, fAJob.Dest + s); 763 | If fAJob.JobType = jtMoveDir Then Begin 764 | job := TJob.Create; 765 | job.JobType := jtDelDir; 766 | job.Source := fAJob.Source; 767 | job.Dest := ''; 768 | If assigned(OnAddSubJobs) Then Begin 769 | setlength(fLCLSubJobArray, 1); 770 | fLCLSubJobArray[0] := Job; 771 | Synchronize(@LCLOnAddSubJobs); 772 | End; 773 | fSubJubFifo.Push(job); 774 | End; 775 | (* Nun heist es Job für Job ab arbeiten *) 776 | oldJob := fAJob; // Retten des Aufrufenden Jobs 777 | While Not fSubJubFifo.isempty Do Begin 778 | fAJob := fSubJubFifo.top; 779 | If DoJob() Then Begin 780 | fSubJubFifo.pop.Free; 781 | End 782 | Else Begin 783 | fSubJubFifo.pop; 784 | End; 785 | End; 786 | fAJob := oldJob; 787 | End; 788 | jtDelFile: Begin 789 | If Not DeleteFileUTF8(fAJob.Source) Then Begin 790 | AddToErrorLog('Unable to delete file.'); 791 | exit; 792 | End; 793 | End; 794 | jtDelDir: Begin 795 | If Not DelFolder(fAJob.Source) Then Begin 796 | AddToErrorLog('Unable to delete folder.'); 797 | exit; 798 | End; 799 | End; 800 | End; 801 | If Assigned(OnFinishJob) Then Begin 802 | Synchronize(@LCLOnFinishJob); 803 | End; 804 | result := true; 805 | End; 806 | 807 | Procedure TWorkThread.CheckForOnFileTransfereStatistic; 808 | Var 809 | t: QWord; 810 | Begin 811 | t := GetTickCount64; 812 | If fStatisticTimeStamp + 1000 <= t Then Begin 813 | fStatisticTimeStamp := t; 814 | If Assigned(OnByteTransfereStatistic) Then Begin 815 | fStatistic.JobsToDo := FInJobFifo.Count; 816 | fStatistic.SubJobsTodo := fSubJubFifo.Count; 817 | Synchronize(@LCLOnByteTransfereStatistic); 818 | End; 819 | fStatistic.TransferedBytesInLast1000ms := 0; 820 | End; 821 | End; 822 | 823 | Procedure TWorkThread.LCLOnByteTransfereStatistic; 824 | Begin 825 | If Assigned(OnByteTransfereStatistic) Then Begin 826 | OnByteTransfereStatistic(self, fStatistic); 827 | End; 828 | If assigned(OnFileCopyProgress) And assigned(fAJob) Then Begin 829 | OnFileCopyProgress(self, fAJob, fJobProgress); 830 | End; 831 | End; 832 | 833 | Procedure TWorkThread.LCLOnStartJob; 834 | Begin 835 | If Assigned(OnStartJob) Then Begin 836 | OnStartJob(self, fAJob); 837 | End; 838 | End; 839 | 840 | Procedure TWorkThread.LCLOnFinishJob; 841 | Var 842 | js: Int64; 843 | Begin 844 | Case fAJob.JobType Of 845 | jtCopyFile, jtMoveFile: Begin 846 | js := GetFileSize(fAJob.Dest); 847 | If fStatistic.BytesToCopyToFinishJobs >= js Then Begin 848 | fStatistic.BytesToCopyToFinishJobs := fStatistic.BytesToCopyToFinishJobs - js; 849 | End 850 | Else Begin 851 | fStatistic.BytesToCopyToFinishJobs := 0; 852 | End; 853 | // Wenn Alle Jobs abgearbeitet wurden -> Reset aller Counter -> dadurch laufen die Statistiken in der Ansicht wieder "Hübsch" 854 | If (fStatistic.BytesToCopyToFinishJobs = 0) Then Begin 855 | fStatistic.BytesCopiedInJobs := 0; 856 | fStatistic.TotalJobBytes := 0; 857 | End; 858 | End; 859 | End; 860 | If Assigned(OnFinishJob) Then Begin 861 | OnFinishJob(self, fAJob); 862 | End; 863 | End; 864 | 865 | Procedure TWorkThread.LCLOnAddSubJobs; 866 | Begin 867 | If assigned(OnAddSubJobs) Then Begin 868 | OnAddSubJobs(self, fAJob, fLCLSubJobArray); 869 | End; 870 | End; 871 | 872 | Procedure TWorkThread.Execute; 873 | Begin 874 | Init(); 875 | Try 876 | While Not Terminated Do Begin 877 | If FCancelallJobs Then Begin 878 | While Not (FInJobFifo.isempty) Do Begin 879 | fAJob := FInJobFifo.Top; 880 | If Assigned(OnFinishJob) Then Begin 881 | Synchronize(@LCLOnFinishJob); 882 | End; 883 | FInJobFifo.Pop.free; 884 | End; 885 | // Reset der Statistic 886 | fStatistic.BytesToCopyToFinishJobs := 0; 887 | fStatistic.BytesCopiedInJobs := 0; 888 | fStatistic.TotalJobBytes := 0; 889 | FCancelallJobs := false; 890 | End; 891 | If (FInJobFifo.isempty) Or (JobPause) Then Begin 892 | // Wir haben grad nix zu tun oder sollen nichts neues mehr Starten 893 | fAJob := Nil; 894 | fJobProgress := 0; 895 | If JobPause Then Begin 896 | If fCancelActualJob Then Begin 897 | fAJob := FInJobFifo.Top; 898 | If Assigned(OnFinishJob) Then Begin 899 | Synchronize(@LCLOnFinishJob); 900 | End; 901 | FInJobFifo.Pop.free; 902 | fAJob := Nil; // Den haben wir grad Freigegeben -> also Nil 903 | fCancelActualJob := false; 904 | End; 905 | End 906 | Else Begin 907 | fAllResult := jaNotChoosen; 908 | End; 909 | // Wenn Alle Jobs Abgearbeitet sind auf jeden Fall die Statistik Resetten 910 | If FInJobFifo.isempty Then Begin 911 | fStatistic.BytesToCopyToFinishJobs := 0; 912 | fStatistic.BytesCopiedInJobs := 0; 913 | fStatistic.TotalJobBytes := 0; 914 | End; 915 | sleep(1); 916 | End 917 | Else Begin 918 | (* 919 | * Der Job wird erst aus der JobFifo genommen, wenn er abgearbeitet wurde (und zwar Vollständig) 920 | *) 921 | fAJob := FInJobFifo.Top; 922 | If DoJob() Then Begin 923 | FInJobFifo.Pop.free; 924 | End 925 | Else Begin 926 | // Runter muss der Job auf jeden Fall, nur darf er hier nicht freigegeben werden. 927 | FInJobFifo.Pop; 928 | End; 929 | fCancelActualJob := false; 930 | End; 931 | CheckForOnFileTransfereStatistic(); 932 | End; 933 | Finally 934 | TearDown(); 935 | End; 936 | End; 937 | 938 | Procedure TWorkThread.AddJob(Const Job: TJob); 939 | Var 940 | js: uint64; 941 | Begin 942 | // Wurde ein Job mit für alle beantworten zurück in die Queue gegeben dann müssen wir das hier auch übernehmen 943 | // das erst bei der Bearbeitung zu machen ist zu spät, dass muss sofort gemacht werden ! 944 | If Job.ToAll And (Job.Answer <> jaNotChoosen) Then Begin 945 | fAllResult := Job.Answer; 946 | End; 947 | Case job.JobType Of 948 | jtCopyFile, jtMoveFile: Begin 949 | js := GetFileSize(Job.Source); 950 | fStatistic.BytesToCopyToFinishJobs := fStatistic.BytesToCopyToFinishJobs + js; 951 | fStatistic.TotalJobBytes := fStatistic.TotalJobBytes + js; 952 | End; 953 | jtCopyDir, jtMoveDir: Begin 954 | js := GetDirSize(Job.Source); 955 | fStatistic.BytesToCopyToFinishJobs := fStatistic.BytesToCopyToFinishJobs + js; 956 | fStatistic.TotalJobBytes := fStatistic.TotalJobBytes + js; 957 | End; 958 | End; 959 | FInJobFifo.Push(job); 960 | End; 961 | 962 | Function TWorkThread.JobsPending: Boolean; 963 | Begin 964 | result := (Not FInJobFifo.isempty); 965 | End; 966 | 967 | Procedure TWorkThread.CancelAllJobs; 968 | Begin 969 | FCancelallJobs := true; 970 | End; 971 | 972 | Function TWorkThread.PopErrorJob: TErrorJob; 973 | Begin 974 | If FErrorJobFifo.isempty Then Begin 975 | Result.Job := Nil; 976 | Result.ErrorMessage := 'Errorfifo empty.'; 977 | End 978 | Else Begin 979 | result := FErrorJobFifo.Pop; 980 | End; 981 | End; 982 | 983 | Procedure TWorkThread.CancelJob(Job: TJob); 984 | Var 985 | found, p: Boolean; 986 | i: Integer; 987 | j: TJob; 988 | js: uint64; 989 | Begin 990 | p := JobPause; 991 | JobPause := true; 992 | If Job = FInJobFifo.Top Then Begin 993 | fCancelActualJob := true; 994 | End 995 | Else Begin 996 | found := false; 997 | For i := 0 To FInJobFifo.Count - 1 Do Begin 998 | j := FInJobFifo.Pop; 999 | If j = job Then Begin 1000 | // Wird der Job abgebrochen, dann muss das auch noch berücksichtigt werden 1001 | Case j.JobType Of 1002 | jtCopyFile, jtMoveFile: Begin 1003 | js := GetFileSize(j.Source); 1004 | // TODO: BUG hier darf nicht alles abgezogen werden 1005 | fStatistic.BytesToCopyToFinishJobs := fStatistic.BytesToCopyToFinishJobs - js; 1006 | fStatistic.TotalJobBytes := fStatistic.TotalJobBytes - js; 1007 | End; 1008 | jtCopyDir, jtMoveDir: Begin 1009 | // TODO: BUG hier darf nicht alles abgezogen werden 1010 | js := GetDirSize(j.Source); 1011 | fStatistic.BytesToCopyToFinishJobs := fStatistic.BytesToCopyToFinishJobs - js; 1012 | fStatistic.TotalJobBytes := fStatistic.TotalJobBytes - js; 1013 | End; 1014 | End; 1015 | If assigned(OnFinishJob) Then Begin 1016 | OnFinishJob(self, j); 1017 | End; 1018 | j.free; 1019 | found := true; 1020 | // Break darf hier nicht sein, weil wir einmal durch müssen damit die Reihenfolge wieder stimmt. 1021 | End 1022 | Else Begin 1023 | FInJobFifo.Push(j); 1024 | End; 1025 | End; 1026 | If Not found Then Begin 1027 | // Der Job muss ein Subjob sein 1028 | If fSubJubFifo.Top = job Then Begin 1029 | fCancelActualJob := true; 1030 | End 1031 | Else Begin 1032 | For i := 0 To fSubJubFifo.Count - 1 Do Begin 1033 | j := fSubJubFifo.Pop; 1034 | If j = job Then Begin 1035 | // Wird der Job abgebrochen, dann muss das auch noch berücksichtigt werden 1036 | Case j.JobType Of 1037 | jtCopyFile, jtMoveFile: Begin 1038 | js := GetFileSize(j.Source); 1039 | fStatistic.BytesToCopyToFinishJobs := fStatistic.BytesToCopyToFinishJobs - js; 1040 | fStatistic.TotalJobBytes := fStatistic.TotalJobBytes - js; 1041 | End; 1042 | jtCopyDir, jtMoveDir: Begin 1043 | js := GetDirSize(j.Source); 1044 | fStatistic.BytesToCopyToFinishJobs := fStatistic.BytesToCopyToFinishJobs - js; 1045 | fStatistic.TotalJobBytes := fStatistic.TotalJobBytes - js; 1046 | End; 1047 | End; 1048 | If assigned(OnFinishJob) Then Begin 1049 | OnFinishJob(self, j); 1050 | End; 1051 | j.free; 1052 | // Break darf hier nicht sein, weil wir einmal durch müssen damit die Reihenfolge wieder stimmt. 1053 | End 1054 | Else Begin 1055 | fSubJubFifo.Push(j); 1056 | End; 1057 | End; 1058 | End; 1059 | End; 1060 | End; 1061 | JobPause := p; 1062 | End; 1063 | 1064 | Function TWorkThread.TopQuestion: TJob; 1065 | Begin 1066 | If FQuestionJobFifo.isempty Then Begin 1067 | result := Nil; 1068 | End 1069 | Else Begin 1070 | result := FQuestionJobFifo.Top; 1071 | End; 1072 | End; 1073 | 1074 | Function TWorkThread.PopQuestion: TJob; 1075 | Begin 1076 | If FQuestionJobFifo.isempty Then Begin 1077 | result := Nil; 1078 | End 1079 | Else Begin 1080 | result := FQuestionJobFifo.Pop; 1081 | End; 1082 | End; 1083 | 1084 | End. 1085 | 1086 | -------------------------------------------------------------------------------- /src/ufifo.pas: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* uFifo.pas 23.09.2005 *) 3 | (* *) 4 | (* Version : 0.04 *) 5 | (* *) 6 | (* Author : Uwe Schächterle (Corpsman) *) 7 | (* *) 8 | (* Support : www.Corpsman.de *) 9 | (* *) 10 | (* Description : Simulation einer FIFO in FPC. *) 11 | (* All die Bekannten Eigenschaften, Befehle wie bei einem FiFo. *) 12 | (* *) 13 | (* License : See the file license.md, located under: *) 14 | (* https://github.com/PascalCorpsman/Software_Licenses/blob/main/license.md *) 15 | (* for details about the license. *) 16 | (* *) 17 | (* It is not allowed to change or remove this text from any *) 18 | (* source file of the project. *) 19 | (* *) 20 | (* Warranty : There is no warranty, neither in correctness of the *) 21 | (* implementation, nor anything other that could happen *) 22 | (* or go wrong, use at your own risk. *) 23 | (* *) 24 | (* Known Issues: none *) 25 | (* *) 26 | (* History : 0.01 - Initial version *) 27 | (* 0.02 - Speed up durch entfernen Schleife in Push *) 28 | (* Bugfix Verlust von Daten beim Push *) 29 | (* 0.03 - property count *) 30 | (* 0.04 - TFifo thread Safe gemacht *) 31 | (* *) 32 | (******************************************************************************) 33 | 34 | Unit ufifo; 35 | 36 | {$MODE ObjFPC}{$H+} 37 | 38 | Interface 39 | 40 | Uses sysutils, syncobjs; // Für die Exception 41 | 42 | Type 43 | (* 44 | * TQueue 45 | * 46 | * Eine via Pointer realisierte FIFO, Thread Safe 47 | *) 48 | 49 | { TFifo } 50 | 51 | Generic TFifo < T > = Class 52 | private 53 | // Hilfstypen Definieren 54 | Type 55 | PGenQ = ^TGenQ; 56 | TGenQ = Record 57 | Value: T; 58 | Next: PGenQ; 59 | End; 60 | Var 61 | Front, Back: PGenQ; 62 | fCount: integer; 63 | cs: TCriticalSection; 64 | public 65 | Property Count: integer read fCount; // Anzahl der Aktuell enthaltenen Elemente 66 | // Initialisieren 67 | Constructor create; 68 | // Freigeben 69 | Destructor Destroy; override; 70 | // Leeren 71 | Procedure Clear; 72 | // Hinzufügen eines Wertes 73 | Procedure Push(Value: T); 74 | // Rückgabe des Obersten Elementes und Löschen 75 | Function Pop: T; 76 | // Rückgabe des Obersten Elements 77 | Function Top: T; 78 | // Gibt True zurück wenn Leer 79 | Function isempty: Boolean; 80 | End; 81 | 82 | FifoException = Class(Exception); 83 | 84 | (* 85 | * TBufferedFifo 86 | * 87 | * Eine via Array realisierte FIFO, welche sich intern bei Bedarf erweitert 88 | * Vorteil : weniger Speicherallokationen 89 | * Nachteil : nicht Thread Safe (höchstwahrscheinlich) 90 | *) 91 | 92 | { TBufferedFifo } 93 | 94 | Generic TBufferedFifo < T > = Class 95 | private 96 | fBuffer: Array Of T; 97 | fCount: integer; 98 | fHead: integer; 99 | fTail: integer; 100 | public 101 | Property Count: integer read fCount; // Anzahl der Aktuell enthaltenen Elemente 102 | // Initialisieren 103 | Constructor create; overload; // Ruft Create(16) auf. 104 | Constructor create(InitialBufferSize: integer); overload; 105 | // Freigeben 106 | Destructor Destroy; override; 107 | // Leeren 108 | Procedure Clear; 109 | // Hinzufügen eines Wertes 110 | Procedure Push(Value: T); 111 | // Rückgabe des Obersten Elementes und Löschen 112 | Function Pop: T; 113 | // Rückgabe des Obersten Elements 114 | Function Top: T; 115 | // Gibt True zurück wenn Leer 116 | Function isempty: Boolean; 117 | End; 118 | 119 | BufferedFifoException = Class(Exception); 120 | 121 | Implementation 122 | 123 | { TFifo } 124 | 125 | Constructor TFifo.create; 126 | Begin 127 | Inherited create; 128 | Front := Nil; 129 | back := Nil; 130 | fCount := 0; 131 | cs := TCriticalSection.Create; 132 | End; 133 | 134 | Destructor TFifo.Destroy; 135 | Begin 136 | clear; 137 | cs.Free; 138 | cs := Nil; 139 | Inherited Destroy; 140 | End; 141 | 142 | Procedure TFifo.Clear; 143 | Var 144 | bl, bl2: PGenQ; 145 | Begin 146 | cs.Acquire; 147 | Try 148 | If Front <> Nil Then Begin 149 | bl := Front; 150 | While bl <> Nil Do Begin 151 | bl2 := bl; 152 | bl := bl^.next; 153 | dispose(bl2); 154 | End; 155 | front := Nil; 156 | End; 157 | Front := Nil; 158 | back := Nil; 159 | fCount := 0; 160 | Finally 161 | cs.Release; 162 | End; 163 | End; 164 | 165 | Procedure TFifo.Push(Value: T); 166 | Var 167 | b: PGenQ; 168 | Begin 169 | cs.Acquire; 170 | Try 171 | inc(fCount); 172 | new(b); 173 | b^.Value := value; 174 | b^.next := Nil; 175 | If assigned(Front) Then Begin 176 | // bei exitierender FiFo wir das neue Element hinten angehängt 177 | Back^.next := b; 178 | back := b; 179 | End 180 | Else Begin 181 | // Bei einer neuen Fifo werden die Pointer entsprechend Initialisiert 182 | Front := b; 183 | back := b; 184 | End; 185 | Finally 186 | cs.Release; 187 | End; 188 | End; 189 | 190 | Function TFifo.Pop: T; 191 | Var 192 | b: PGenQ; 193 | Begin 194 | cs.Acquire; 195 | Try 196 | If assigned(front) Then Begin 197 | // Rückgabe des Wertes 198 | result := Front^.Value; 199 | // Löschen des Knoten in der Schlange 200 | b := Front; 201 | // gehen zum nächsten Element aus der Schlange 202 | front := front^.next; 203 | // Freigeben des Speichers 204 | Dispose(b); 205 | dec(fCount); 206 | End 207 | Else Begin 208 | // wird von einer Leeren Schlange Gepoppt dann Exception 209 | Raise FifoException.create('Error queue empty'); 210 | End; 211 | Finally 212 | cs.Release; 213 | End; 214 | End; 215 | 216 | Function TFifo.Top: T; 217 | Begin 218 | If assigned(Front) Then Begin 219 | // Rückgabe des Wertes 220 | result := Front^.Value; 221 | End 222 | Else Begin 223 | // wird von einer Leeren Schlange Gepoppt dann Exception 224 | Raise FifoException.create('Error queue empty'); 225 | End; 226 | End; 227 | 228 | Function TFifo.isempty: Boolean; 229 | Begin 230 | Result := Not assigned(Front); 231 | End; 232 | 233 | { TBufferedFifo } 234 | 235 | Constructor TBufferedFifo.create; 236 | Begin 237 | create(16); 238 | End; 239 | 240 | Constructor TBufferedFifo.create(InitialBufferSize: integer); 241 | Begin 242 | Inherited create(); 243 | If InitialBufferSize <= 2 Then Begin 244 | Raise BufferedFifoException.Create('Invalid InitialBufferSize, has to be > 2'); 245 | End; 246 | fHead := 0; 247 | fTail := 0; 248 | fCount := 0; 249 | setlength(fBuffer, InitialBufferSize); 250 | End; 251 | 252 | Destructor TBufferedFifo.Destroy; 253 | Begin 254 | setlength(fbuffer, 0); 255 | Inherited Destroy; 256 | End; 257 | 258 | Procedure TBufferedFifo.Clear; 259 | Begin 260 | // Die Indexe werden gelöscht, der Puffer bleibt Allokiert => die Query ist Leer ;) 261 | fHead := 0; 262 | fTail := 0; 263 | fCount := 0; 264 | End; 265 | 266 | Procedure TBufferedFifo.Push(Value: T); 267 | Var 268 | Next, olength: integer; 269 | Begin 270 | Next := (fHead + 1) Mod length(fBuffer); 271 | If next = fTail Then Begin // Überlauf der Buffer ist Voll und muss erweitert werden 272 | olength := length(fbuffer); 273 | // 1. Verdoppeln des bisher genutzten Speichers 274 | setlength(fBuffer, length(fBuffer) * 2); 275 | If next <> 0 Then Begin 276 | // 2. Umkopieren der Datensätze von 0 bis Head in den neuen Speicherbereich 277 | move(fbuffer[0], fbuffer[olength], (fhead + 1) * sizeof(t)); 278 | FillChar(fbuffer[0], (fhead + 1) * sizeof(t), 0); // Sollte T Referenzcountet sein, dann muss der alte Speicher = 0 gesetzt werden, sonst funktioniert das RefCounting nicht mehr.. 279 | // 3. Anpassen des neuen "Next" 280 | next := (olength + fHead + 1); 281 | End 282 | Else Begin 283 | next := olength; 284 | End; 285 | End; 286 | // Pushen des Elementes in das Array 287 | fbuffer[next] := value; 288 | fHead := next; 289 | inc(fCount); 290 | End; 291 | 292 | Function TBufferedFifo.Pop: T; 293 | Begin 294 | If isempty() Then Begin 295 | Raise BufferedFifoException.create('Error queue empty'); 296 | End; 297 | fTail := (fTail + 1) Mod length(fBuffer); 298 | result := fBuffer[fTail]; 299 | dec(fCount); 300 | End; 301 | 302 | Function TBufferedFifo.Top: T; 303 | Var 304 | next: integer; 305 | Begin 306 | If isempty() Then Begin 307 | Raise BufferedFifoException.create('Error queue empty'); 308 | End; 309 | next := (fTail + 1) Mod length(fBuffer); 310 | result := fBuffer[next]; 311 | End; 312 | 313 | Function TBufferedFifo.isempty: Boolean; 314 | Begin 315 | result := fHead = fTail; 316 | End; 317 | 318 | End. 319 | 320 | 321 | 322 | 323 | 324 | -------------------------------------------------------------------------------- /src/unit1.lfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 353 3 | Height = 626 4 | Top = 120 5 | Width = 777 6 | AllowDropFiles = True 7 | Caption = 'Form1' 8 | ClientHeight = 626 9 | ClientWidth = 777 10 | Constraints.MinHeight = 200 11 | Constraints.MinWidth = 400 12 | Position = poScreenCenter 13 | LCLVersion = '4.99.0.0' 14 | OnActivate = FormActivate 15 | OnClose = FormClose 16 | OnCloseQuery = FormCloseQuery 17 | OnCreate = FormCreate 18 | OnDropFiles = FormDropFiles 19 | object PairSplitter1: TPairSplitter 20 | Left = 50 21 | Height = 400 22 | Top = 50 23 | Width = 400 24 | Position = 200 25 | OnResize = PairSplitter1Resize 26 | object PairSplitterSide1: TPairSplitterSide 27 | Cursor = crArrow 28 | Left = 0 29 | Height = 400 30 | Top = 0 31 | Width = 200 32 | ClientWidth = 200 33 | ClientHeight = 400 34 | object Panel1: TPanel 35 | Left = 0 36 | Height = 75 37 | Top = 0 38 | Width = 200 39 | Align = alTop 40 | Caption = 'Panel1' 41 | ClientHeight = 75 42 | ClientWidth = 200 43 | PopupMenu = PopupMenu3 44 | TabOrder = 0 45 | OnResize = Panel1Resize 46 | object cbDirLeft: TComboBox 47 | Left = 12 48 | Height = 28 49 | Top = 39 50 | Width = 148 51 | Anchors = [akLeft, akRight, akBottom] 52 | ItemHeight = 0 53 | PopupMenu = PopupMenu3 54 | TabOrder = 0 55 | TextHint = 'Directory left' 56 | OnDblClick = cbDirLeftDblClick 57 | OnKeyDown = cbDirLeftKeyDown 58 | OnKeyPress = cbDirLeftKeyPress 59 | OnSelect = cbDirLeftSelect 60 | end 61 | object btnDirLeft: TSpeedButton 62 | Left = 164 63 | Height = 27 64 | Top = 40 65 | Width = 27 66 | Anchors = [akRight, akBottom] 67 | Images = AppIcons 68 | ImageIndex = 19 69 | OnClick = btnDirLeftClick 70 | end 71 | end 72 | object ListView1: TListView 73 | Left = 0 74 | Height = 301 75 | Top = 75 76 | Width = 200 77 | Align = alClient 78 | Columns = < 79 | item 80 | Caption = 'Name' 81 | MinWidth = 100 82 | Width = 100 83 | end 84 | item 85 | Caption = 'Ext' 86 | MinWidth = 75 87 | Width = 75 88 | end 89 | item 90 | Caption = 'Size' 91 | MinWidth = 75 92 | Width = 75 93 | end> 94 | HideSelection = False 95 | MultiSelect = True 96 | PopupMenu = PopupMenu1 97 | ReadOnly = True 98 | RowSelect = True 99 | ScrollBars = ssAutoVertical 100 | SmallImages = ImageList1 101 | TabOrder = 1 102 | ViewStyle = vsReport 103 | OnColumnClick = ListView1ColumnClick 104 | OnDblClick = ListView1DblClick 105 | OnKeyDown = ListView1KeyDown 106 | OnResize = ListView1Resize 107 | end 108 | object StatusBar1: TStatusBar 109 | Left = 0 110 | Height = 24 111 | Top = 376 112 | Width = 200 113 | Panels = < 114 | item 115 | Width = 50 116 | end> 117 | SimplePanel = False 118 | end 119 | end 120 | object PairSplitterSide2: TPairSplitterSide 121 | Cursor = crArrow 122 | Left = 205 123 | Height = 400 124 | Top = 0 125 | Width = 195 126 | ClientWidth = 195 127 | ClientHeight = 400 128 | object Panel2: TPanel 129 | Left = 0 130 | Height = 75 131 | Top = 0 132 | Width = 195 133 | Align = alTop 134 | Caption = 'Panel2' 135 | ClientHeight = 75 136 | ClientWidth = 195 137 | PopupMenu = PopupMenu4 138 | TabOrder = 0 139 | OnResize = Panel2Resize 140 | object cbDirRight: TComboBox 141 | Left = 8 142 | Height = 28 143 | Top = 39 144 | Width = 148 145 | Anchors = [akLeft, akRight, akBottom] 146 | ItemHeight = 0 147 | PopupMenu = PopupMenu4 148 | TabOrder = 0 149 | TextHint = 'Directory right' 150 | OnDblClick = cbDirRightDblClick 151 | OnKeyDown = cbDirRightKeyDown 152 | OnKeyPress = cbDirRightKeyPress 153 | OnSelect = cbDirRightSelect 154 | end 155 | object btnDirRight: TSpeedButton 156 | Left = 160 157 | Height = 27 158 | Top = 40 159 | Width = 27 160 | Anchors = [akRight, akBottom] 161 | Images = AppIcons 162 | ImageIndex = 19 163 | OnClick = btnDirRightClick 164 | end 165 | end 166 | object StatusBar2: TStatusBar 167 | Left = 0 168 | Height = 24 169 | Top = 376 170 | Width = 195 171 | Panels = < 172 | item 173 | Width = 50 174 | end> 175 | SimplePanel = False 176 | end 177 | object ListView2: TListView 178 | Left = 0 179 | Height = 301 180 | Top = 75 181 | Width = 195 182 | Align = alClient 183 | Columns = < 184 | item 185 | Caption = 'Name' 186 | MinWidth = 100 187 | Width = 100 188 | end 189 | item 190 | Caption = 'Ext' 191 | MinWidth = 75 192 | Width = 75 193 | end 194 | item 195 | Caption = 'Size' 196 | MinWidth = 75 197 | Width = 75 198 | end> 199 | HideSelection = False 200 | MultiSelect = True 201 | PopupMenu = PopupMenu2 202 | ReadOnly = True 203 | RowSelect = True 204 | ScrollBars = ssAutoVertical 205 | SmallImages = ImageList1 206 | TabOrder = 2 207 | ViewStyle = vsReport 208 | OnColumnClick = ListView2ColumnClick 209 | OnDblClick = ListView2DblClick 210 | OnKeyDown = ListView1KeyDown 211 | OnResize = ListView2Resize 212 | end 213 | end 214 | end 215 | object ImageList1: TImageList 216 | Left = 96 217 | Top = 8 218 | Bitmap = { 219 | 4C7A150000001000000010000000011200000000000078DAED9B7974D45596C7 220 | E3D1E35F738E47C1991EE7CC9C5647E976E99931D23467D469647AC4A17154EC 221 | E9B1B10189C4465B30EC118582B02309900089901012C21AC84242F6A412B290 222 | 5059C8BEEFFBBE54AAB2F29D7B5FEA57FCEA97AA4A55E4B89D54CE3DBF5ADEE7 223 | DEFBEEEFDD77DF7B5581037E307F0E2A15268983036C65E50F95416CD1C16D7E 224 | AB565B14B37EB13D0BB6A77A706BA1D7E097C4AB6C15F53478B5E9755AF6D5D3 225 | B0AFBE0FF6D5D3B0AFB672B5C4AB6D63CDF1D6C68FC571251B97FC7C3A02879F 226 | CEDFB7E9CFB78989C4A954F6EB90B392D8A343EEB79CB5B71F727EBAF1BB5FBC 227 | B20F2AC31CAC32CC99CAD7725E194773BE99F3F5DBF2924FD3F57FE6EFC7FD37 228 | 3A3A8AC6BA1AD45555A0A6B20C55E525A82C2D427971214A0BF351929F87A23B 229 | 3928C8D560787868D27DEF686B467D4D954D3C7F2667B5FD7DC2B6AD7C7E7616 230 | BA3A3B8C3A2A4AF2111A7C09D72E5F40F0A5205CB910884BE7037031E82C2E04 231 | FAE37CC0190405F821E8AC2FCEB1F8FB22F776BA914F4B8EC7B265CBF0DE7BEF 232 | E1ADB7DEC2A2458BF0FAEBAFE3D5575FC5FCF9F33177EE5CBCF4D24B98E33407 233 | 2FBEF8225E78E105D271DA2EFEE5D52FE303FA7B6AD553D3E2D9FE734ECF99B5 234 | DFDA50859BEA38A424C6401D1F8DC4B81B488889447C7404E2A2C2117B230C31 235 | 9161888E0C45744428A2AE87505CEFCCE4EE7DFCE3B9D016B1C64FF550D39AC9 236 | 920E5B79B1CE33A3C316DEDADA4B65C71E40AD58FBCDF0333CF3FCBEADA2E4EF 237 | C7DE41BC6718E716AFD6D6EE526E59B99AD361F299ADD71FE8BD3789AFECF5F7 238 | 615FE9CB8CFD9F66EEDB9BFF967278EFDEBDB045ACF1966AAEF4E0360F3DF4D0 239 | BD7D9B869E4E218E3E1A48BAA5ABA443B4F1E1363E58B162051C9C7DE8B546BC 240 | 2717E6D817E6E422F11A8D063ECE8EF07124717646787838FAFAFAA081292FEF 241 | 979CE7878638665987B3418F33F925F7DF265EA187C53EDED00F125E473BD27B 242 | 92FF521F2CF2068E6D6AC8F7F4E21E93FE5BE2F9B5C432C7B113F9A8B9173FF9 243 | 7850F2CE142347BA77CE741F268D012BBCA3997BAD1429FEE6FCB767FC9BBBFF 244 | 538D7F6BF38039DE9E79C01CAF1CDF5389BDB96F29FFF9FDA1A12121CE348E78 245 | 9EE19C92DE93C4920E39CFB9C7AF2DF1D29539C9969C976CC8796EC757E55CE8 246 | 6CC80D7ECE319D68C3754465E4A5CFA53E4922CDA5FC39FB2CE990F3E2BB0243 247 | 5D92F42979510326A0099F1C348257B2F2FE2879F68175A8840EEBAC9C5FB264 248 | 89315E5BB66C31FB9CF7E096789E5FCCDD278E83741FCDB591FBCF9F735B161F 249 | 9A3BCEF9FB8BFBC23E48B6A7E2DBDBDB8594949418F5C86D4FC537343488F725 250 | 1D126F8F7D7E9FF5F067CABE4F87671F9463CEDCF8BB1FDF1FCCECDFEFE31A54 251 | FEDDE574D7B0F2EF2EEDE0E5792FDD33A50E5BEC1BDB18E26DEF1A5ABEA753FA 252 | 61EB1A5AF243EE8BBD6B70E5FA7F66FF7F7FBF3BDCBD7B37BEADA4A7A7DB2DCC 253 | 711F243E819EDB23B6F296CE1F94FC74FA2DE7ED7DCCF03F1C7EBA32DD9AFD5D 254 | 7DFFAF72504DDB06B362DE7750D9EDAB9C958B2D7A2CB1B6E851B2A28E4AA29A 255 | ACC32A6B5803C8F558B26FC96731CF9B6155B2DF34598C95059FA53A63FCCD81 256 | CC9FA96226AF51C6F71C5426F5DD9C1E4BACDC7F69CDA0D4638DBDF75DBECA64 257 | 6F2ED7638D9DFC1B8EC97AA662A7D2632B6B49CFB7C9C1E9FC9665E6FC7FE6FC 258 | DFA46D52D2A4732F5BEC4BAC9887F86AEFDA5F62A5BD10BDFE2EED1B75C9D89F 259 | E2F9FF8F77DF3F71D635BD7DFF84287907A9362AAFB2B1236795FECBEBAA51E4 260 | 7B67056BF6DC4070B827C65A3F99B56CDF9437D6C229CE3DEED997D53D590CA6 261 | 1AFBA6F6550671B039F7E4FD57BE670B6FF6DED9C15BCD999FF0BEBFBCA21209 262 | 894942E21312A7146E57525A66D4A34E4E814EA7434F77F784F474A3B7B7077D 263 | BDBDE27BA0FE7E967E0C0CB00C8873CEB8F80413BE9FDA35D4D7A1B1B1012DCD 264 | 4D686D6D11D2D9D981AEAE4E922E7477B37443AFD721362EDEC827A99305DFC4 265 | 6C4B33BC2F84628B872FB6FB86E1774B9761D33E4F9CBA1842BE4CF8C3F695FC 266 | 00F9D74AEC014F1F9CB95906F7D054FCC5CD0BBF78693EBE0E49836F7231DCBD 267 | 7DA1D56A313C3C8C98D838135EAB1D407B7B1B367BF8E393FDA7F1D14E4F7CB0 268 | 7137DEFE783316AFFC0C6F3B6FC05F777B91EF7AF06F0DA363624DF8C1C141D1 269 | D793F1F9F04EA910723C916C466663EFD5347C199484CDBE51181919C1D8D8D8 270 | 249EE3CFF1F926EE0E4EA8CBE09550048FA85C1C0CCDC0CE4B29D81A90802FCE 271 | 440BDBE3E3E39378D7D5ABE0EABC0A5B3F77C1DE539770283C0B6EE762B0CD37 272 | 1C5F9D0AC1F6BD1ED8F0E95FF1D527CED8BC6A39A2A2634CF8B2827C2121C1D7 273 | B0DDF50BB8B86C4065652512D54958EFF239F6BAED41F0E5AB28A7365525C5B8 274 | 11156DC297E4DC466A7C2C3CBCFD712E2406070E1E420F8DA1D45B1958E7B211 275 | BE17C3E9B3B328CBCB11A2E4CBF3F3509CA341D8E58BB8121000D557DB505452 276 | 82F48C0CECD9B903278FB823C0F73462222290997A538C6139CF6C45C11D5416 277 | E6233B2D0D87F6EF43534B0BEAEAEB71C2F32892E3E370F7EE5DE869EC9C0B3C 278 | 87FE01ADC9F8D5A4A5A098FCAAA1BED59696E0F0C1FD50A7A4208DEC1F3FEA81 279 | 5BA929E2DEFB9E3983BEFE01931C643E97FA9993918EEA9222345557225F9385 280 | B5EBD662DDBACF9092108B9CAC4C9C0D0C98C4CAF3977393F38A85C7B75CF8F3 281 | DEBE7E4CF51BF4E9CC23FC9C73DB98F794679CF352BEB3707E70EE0C0E6A451C 282 | 943C739CE73C867B7A4C75C859CE13733CE735CF0D13F6EF710FBBFD0DC20A42 283 | 457E30C7C2F9ABE4797E6276C2E6843D9D6E10B33D9FC22FDD7F09DDD0A0E058 284 | 3887943CDBEAE868C79D3B77848F6C6F68488F7F3CF902B6C76E8767B6278A8B 285 | 8B851DCEDFC9BC1629345E3A3B3B451C798EE25C9F736A9EB0B73B63B7E8179F 286 | 5599E3D9D790901061B7B0B050B02C2F9EFE77C1FB15F8098EBF57E2FC57F23C 287 | A7DEBC79D310FB3EC132F7F3E3CF092EA52145C42583C6B3795E4FF1EB455151 288 | 9191656EB6FBDF8BF6FA513D4A4B4B857F9C474A5EFA5E8CD9CB5D09989BF607 289 | FC93FBBFE0E10F1F16ED59581FC7DFDCFDE7DF64F367B787AAE0706B1E32B405 290 | 704E72C5AFD63B0AB6A3A3C3EAF895EE6DD5702B5EAEFE0CAFE4AFC612F52728 291 | 6A2A36DE6FC9077335985979BFB9CF2CCCF078E036CA7123E7F933732C0B8F0D 292 | 6B7BF9EFF3AC70E6FCFF8779FE6F6EEF6E2B6F69EF6C2B6F69EFFE5DD9B7B477 293 | 9F39FF9FFC97A58E85D7CE8D38FAE53AAB727CE7263454574CB2E7B5633DFA9A 294 | 6B30D4D58CA1CE46E83BEAA16BAB85AEB51A83CD95186C2A87B6B154E8387FE2 295 | E0241DFCFE706F3B867B5A31D47D4F875ED2D132A183DB8D0EEB2774549543CE 296 | 8FF477216BEBEBB8E532CFA2C8FB72D26D93093FAAEDB1C849FBE80C97DF507F 297 | 2A30D858267498F0837DA2ADB5077FAE6BA9123A94FC985E3B255FEEEF4A316A 298 | 133151F2E3C3BA29792A24625D30DCD739991F19123CD77FB9E4E5E521282848 299 | D4FCEAEA6A3CF1C413B87DFB36AD510B4DF8BB63A366F9F2F272AC59B306B367 300 | CF465B5B9B18AFFCFF3DFCDCDBDB1B46FEEE38B25C179AC4BD3D2B42F4D5C3C3 301 | 038F3CF288F0E50CAD9DB90F2B57AEC4A38F3E6AE427FA372EFC181F1DA6FEE8 302 | 451D757272424C4C8C3104F5B496E77DE4BC79F3E0E8E868CA1B6274777C0C77 303 | 474784BE050B16E081071E106BA6E5CB970BFF67CD9A25FA26EFBF32CE420749 304 | 4D4D0D0E1E3C2862C73190E7EDE5CB9721E58F8ED6B50A25061DA3E27AFCF871 305 | 13F6F9E79F17B195F2F78495FCF53BA44237ED2B3D3D3D85646666423F786FEF 306 | F253C9FFE1BE0E911F7DB4673B7CA0191E873BB0E3AB36ECFAB20EBDF55553E6 307 | BF363F1E5D217B50EDEB8666CAB5AC60358DD13E6CDAD4892F36D61A73D75CFE 308 | EB9B4AD11BE38591960A686F05A327FC00CADCFE0F6B96E5E18D379AF1EEDB1C 309 | 931A8BF9DF1B7302C38DC518483D8F8EB32E683EF07BB41C5C821D0BB763CE9C 310 | 3A2C7DA7012394B796F2BF37F604066E87A0EB822B1A77BC82EA558FA271D702 311 | ECFF9F3D282B1B4159A95E8C2A4BF93FDC5E83066F67B47B3BA161CBBFA2C1D5 312 | 11793B17E38B7DB6E7FF996BE751EBB502E57B16E3D6E13FC32D3212A70A6A6D 313 | CEFFFD99A5086ED2C2A5A003AFDC6C44588B16F5037A9BF37FEBCD221CA8E8C1 314 | E28C663C1A590DDDC8A85DF99FD6D48965F1855892DE880529F528E9D1DA9DFF 315 | 4DE4AFFBED4A920A74D33EE7C790FFF2AFB87F8CD27E450573D27AE94B349FDB 316 | 827AFFCF517FEA53D49D5C85AA23EFA3ECD0BB28DDF3268A55AF217FCB5CD176 317 | 202FCA28FD247D39D7D17B3B143D99C1E84EBF88AE944074A8FDD01EE783D628 318 | 2F344778A031F400B2D73E6DE47BD22FA187F2B73B25009D497EE888F7465BB4 319 | 275A23DCD11CBA1F0DC13B517F611B6A0337A2DA6F2DEA2FAB90B9EA09C1F7E7 320 | 46624CDB4DDC198C0E74617C488B715A138CE907A0ADC8440BE9D03797A3E1AA 321 | 1B74344F54505F6A023723F5FD9FA199729E7D1D1F1A447BACB7605BAE7F2D5E 322 | 37908DE1EE2674674788D74DD7DDC55AA1D4E38FA8F2FB0CEAB7FE96E2B316DD 323 | 1917C5381B277B77692DC0BEF29A847D1DEEA4B9A7BF43E86DB8B697E6A17614 324 | 1D5882721F67242C7C5CC4B533F9ACF0B5E9EA6E8CE9FA514771E7D755A7D660 325 | A8A316BD058918A8CE41EDA51D18E96D43BEDB7FA2CC6B39A25E99850AF7A522 326 | AE823BEF8A315A4B55F97E2A5E97531B7D5B358ABF7E073D7762514D7AB9B6EB 327 | 5BAB50E2F13E6ECC7D0CC5BB17A225F28831AE95DF7C8C8AE32B5176F44F2839 328 | BC54F85AB06711F2772E44DEF6D790BB6D3E725CE7A2E8F07B88707C4C8C81C6 329 | 907D68B8B2137517B789B856D31C5CE9FB192A7CFE82F2934EC2D792A3CBC8E6 330 | 1F0557F4F55221CCF318C85CFD0FB8B5F209A4D3FD4859FA7722AE096F3C8EB8 331 | 058F23E6B5D9889A3F4BF8CAED95F243C8A1DCDCDC451F1D4AC19B5B13F18B0F 332 | 63798EF9B58DF273627FA5D168B4A9195948CEC8C69C15D162ED658BB08EAD5B 333 | B73E1C1616B6F2E37D31F8F89B34CC591E6D3CA79384CF4FF80C44123E43339C 334 | A5FC5A6E5F4DF69F5D163589977448C2E7587C566362DF2D0ACE3EA978F6FD28 335 | E359545DD017A80BDC4AB205B5019B51EBCFB251F820F146FBE906FBFF1B693C 336 | 4B62B65D1D481280F6A4B3684FF4478D9F8BE00D675846FBCEBB22B1FAC44D3C 337 | F38708E3D99DDC668DDF06549E5E8FCA53EB44FF753ADDB839FBCFBC1B2E62C3 338 | BCFCF7E66C8FFB3D71CED9CB67A55AE21D25FBAB7744E223AF14FCF33BE146B6 339 | F6CC06CA45CA856FD652BE7F8A32EF4F50E8F989F8AD3A9F534EB29F9E8DA7DF 340 | 0A133CF75FB2CB677E529F58D8073E277DF0C1077F23D9FFE8CBEB703A968CA7 341 | 178718E3C7C2AC74BF24966B586B6BAB19FB1A3CF5E635635BB6CFB1E6F34C8E 342 | 09B3595959686E6E9E34FE9C5CAFE3438F243CF55FF778C9369F2BF35562A573 343 | 3A73F69F5C182CCEEEB88D649FD71C7C2ECAEB1EC51985B0BF71E3C6275F581C 344 | 84B97F0EC193AF5F11DF9BF05929AF75F2F3F345AC0A0A0AC495D75FD9D9D962 345 | 4DC6BC94C38F3DB3F23F7EF66FDB77CE7AD6E9237BF277A6FE7FFFF59F1FFD79 346 | 31A20673FD6F8F398E51AAB35C43C7F4FDA2165AABFF5CDB072BB3C4BE55AAFF 347 | CC72FDE76BCDD9F556EB7F7F61BCF0A18BFAC0AC583F509D655FD93ED7546BF5 348 | 9FF7BC7D8589B48FEABE57FF077B45FD1FD3F5A1ECD80756EBFF5DDAB30B5FA9 349 | AD54FF794FC6F59F5FCFD4FF19B1243EA9A93027C75352E0A556E34852120E27 350 | 24605F5C1C764745411511816D245B4243B1FECA15D1369DF66792A45555E126 351 | CDBFC9151550D31E2BBEAC0CB134174715172392E6F0709A8743691EBE4AFBD1 352 | 35172E18F998921244539B1B346747509B309AB7AF519B2BB9B9B848F37510CD 353 | DB0154B7FC68DE3E959626DE5B191020F854B21945BA3368BF384C75A595EA14 354 | DBD751FDEBA3FA194875A7976A91965E5F27DDDCB740D2F7BE9F9FE823B7E5F7 355 | 99E5E7B554AF06A96D1CF954D5D1814A9236D2194A3E71FF8E2426C2EFD62DBC 356 | EBE38323149B04EA27FBCABCE46B23AD11C629AF7BC86E3871FC18A07A763927 357 | 07872896A7D2D3F1DFB42FE5B872DF2F13374C358F7DF5A73E9EA6CFB96FDDB4 358 | DEAAA5FAE74136D9373DD5D5BDB4273F497BE885C78E4175E38688EB39431F47 359 | A9766AC90EC76094FCE1F6C52D2D18A1E73A7A5ED0D4845DC4782527E3B7478E 360 | C095F6E61C6B29AEDEA4973F3B4AF7DD9DFAC6BEEE8F8DC59EE868ECE2FB4FEC 361 | 76BAFFC7286EAFB8BB8B31104C7DBF44FD3AAFD188B89E35DC27D107D2C9BE8A 362 | F1447A8FB16E628F1A781E034EE7CF6339DDCB3FD1FD58EAEB2BE2FAFB9327F1 363 | 26C5E777D4C705E427FBCAED95F27DE7CFFF03647CB6FE 364 | } 365 | end 366 | object PopupMenu1: TPopupMenu 367 | Images = AppIcons 368 | Left = 120 369 | Top = 231 370 | object MenuItem19: TMenuItem 371 | Caption = 'Diff viewer [CTRL + S]' 372 | ImageIndex = 12 373 | OnClick = MenuItem19Click 374 | end 375 | object MenuItem20: TMenuItem 376 | Caption = '-' 377 | end 378 | object MenuItem5: TMenuItem 379 | Caption = 'Reload directory [CTRL +R]' 380 | ImageIndex = 5 381 | OnClick = MenuItem5Click 382 | end 383 | object MenuItem1: TMenuItem 384 | Caption = 'Rename [F2]' 385 | ImageIndex = 18 386 | end 387 | object MenuItem2: TMenuItem 388 | Caption = 'Copy -> [F5]' 389 | ImageIndex = 6 390 | OnClick = MenuItem2Click 391 | end 392 | object MenuItem14: TMenuItem 393 | Caption = 'Move -> [F6]' 394 | ImageIndex = 4 395 | OnClick = MenuItem14Click 396 | end 397 | object MenuItem15: TMenuItem 398 | Caption = 'Make Directory [F7]' 399 | ImageIndex = 9 400 | OnClick = MenuItem15Click 401 | end 402 | object MenuItem6: TMenuItem 403 | Caption = 'Delete [F8]' 404 | ImageIndex = 7 405 | OnClick = MenuItem6Click 406 | end 407 | object MenuItem3: TMenuItem 408 | Caption = '-' 409 | end 410 | object MenuItem12: TMenuItem 411 | Caption = 'Swap view left <-> right [CTRL + Tab]' 412 | ImageIndex = 11 413 | OnClick = MenuItem12Click 414 | end 415 | object MenuItem4: TMenuItem 416 | Caption = 'Show Progress window' 417 | ImageIndex = 10 418 | OnClick = MenuItem4Click 419 | end 420 | end 421 | object PopupMenu2: TPopupMenu 422 | Images = AppIcons 423 | Left = 320 424 | Top = 231 425 | object MenuItem21: TMenuItem 426 | Caption = 'Diff viewer [CTRL + S]' 427 | ImageIndex = 12 428 | OnClick = MenuItem19Click 429 | end 430 | object MenuItem22: TMenuItem 431 | Caption = '-' 432 | end 433 | object MenuItem7: TMenuItem 434 | Caption = 'Reload directory [CTRL +R]' 435 | ImageIndex = 5 436 | OnClick = MenuItem7Click 437 | end 438 | object MenuItem18: TMenuItem 439 | Caption = 'Rename [F2]' 440 | ImageIndex = 18 441 | end 442 | object MenuItem8: TMenuItem 443 | Caption = 'Copy <- [F5]' 444 | ImageIndex = 3 445 | OnClick = MenuItem8Click 446 | end 447 | object MenuItem16: TMenuItem 448 | Caption = 'Move <- [F6]' 449 | ImageIndex = 4 450 | OnClick = MenuItem16Click 451 | end 452 | object MenuItem17: TMenuItem 453 | Caption = 'Make Directory [F7]' 454 | ImageIndex = 9 455 | OnClick = MenuItem17Click 456 | end 457 | object MenuItem9: TMenuItem 458 | Caption = 'Delete [F8]' 459 | ImageIndex = 7 460 | OnClick = MenuItem9Click 461 | end 462 | object MenuItem10: TMenuItem 463 | Caption = '-' 464 | end 465 | object MenuItem13: TMenuItem 466 | Caption = 'Swap view left <-> right [CTRL + Tab]' 467 | ImageIndex = 11 468 | OnClick = MenuItem12Click 469 | end 470 | object MenuItem11: TMenuItem 471 | Caption = 'Show Progress window' 472 | ImageIndex = 10 473 | OnClick = MenuItem4Click 474 | end 475 | end 476 | object PopupMenu3: TPopupMenu 477 | Images = AppIcons 478 | Left = 120 479 | Top = 160 480 | object mnCreateShortcutL: TMenuItem 481 | Caption = 'Add actual folder as shortcut button' 482 | ImageIndex = 1 483 | OnClick = mnCreateShortcutLClick 484 | end 485 | object MenuItem23: TMenuItem 486 | Caption = 'Clear directory history' 487 | ImageIndex = 7 488 | OnClick = MenuItem23Click 489 | end 490 | object mnFilemanagerL: TMenuItem 491 | Caption = 'Open in file manager' 492 | ImageIndex = 8 493 | OnClick = mnFilemanagerLClick 494 | end 495 | end 496 | object PopupMenu4: TPopupMenu 497 | Images = AppIcons 498 | Left = 320 499 | Top = 160 500 | object mnCreateShortcutR: TMenuItem 501 | Caption = 'Add actual folder as shortcut button' 502 | ImageIndex = 1 503 | OnClick = mnCreateShortcutRClick 504 | end 505 | object MenuItem24: TMenuItem 506 | Caption = 'Clear directory history' 507 | ImageIndex = 7 508 | OnClick = MenuItem24Click 509 | end 510 | object mnFileManagerR: TMenuItem 511 | Caption = 'Open in file manager' 512 | ImageIndex = 8 513 | OnClick = mnFileManagerRClick 514 | end 515 | end 516 | object ApplicationProperties1: TApplicationProperties 517 | OnIdle = ApplicationProperties1Idle 518 | Left = 232 519 | Top = 8 520 | end 521 | object PopupMenu5: TPopupMenu 522 | Images = AppIcons 523 | Left = 320 524 | Top = 8 525 | object mnDeleteShortcut: TMenuItem 526 | Caption = 'Delete entry' 527 | ImageIndex = 7 528 | OnClick = mnDeleteShortcutClick 529 | end 530 | object mnCopyBtn: TMenuItem 531 | Caption = 'Copy entry to other view' 532 | ImageIndex = 2 533 | OnClick = mnCopyBtnClick 534 | end 535 | object mnMoveShortcut: TMenuItem 536 | Caption = 'Move entry to other view' 537 | ImageIndex = 4 538 | OnClick = mnMoveShortcutClick 539 | end 540 | end 541 | object AppIcons: TImageList 542 | Left = 400 543 | Top = 8 544 | Bitmap = { 545 | 4C7A150000001000000010000000DA2000000000000078DAED7B07545549BAAE 546 | 739DE93BF7AEBBD6BCBBD67DF366DA56BBB5736BB76D1BDBD06DCE8A8280E42C 547 | 3948064992738E0A080888204132282A39A380A4032A202847259D430EDFABDA 548 | C211F01C0C33F7AE7E6FF5667D6B1FF6AEAFF2F757FD55B5012CC13F11BF9629 549 | ACDE562463B1355F92F5E32D11CEDADC539CEFB24FB1BECB3C65F175DAF1D58B 550 | 717794C8096FCA3FD37D26DF00018D51886E4D64E0DF1001A16C75AC8CDFDDBD 551 | 326EB7303F2E495378C39DD35CAB6A2F24B567C2A72914C6D5B60CE8EFC4F674 552 | 9894BA6279E87AEEF2D04DF3E2D89A2FB56A43DEE92ECAA5E1B42ACDA05E6E04 553 | D5D27304060486D0283345C2A33418153AE39380B55D9FF8AD5D35CBDF9077C6 554 | 52ECB62E932EE5529E72892E148BB4A150A80DC5423D6474E641A7C492C4918E 555 | 837132F8C4F34BCB59FEDA5C11967F6304BC1B2F42ADCC084AC53A90273CF902 556 | 72CFD741F6933BA05727B71BAEF783E15A1D8A4F9C3E65CDF2BF4C3B321CDB96 557 | 827395D65029D14732C9476D6F0314EFEA22ABF336C39D989A84DBBD60A8DDB5 558 | 444463229659AD189EE5AFBCBE7B38A63509BAE556D02FB746FFD800C3793EF2 559 | 92C775AA0A8064B61ECEE659E07263129699CDE1C7ED6679D786C3BD3E044A05 560 | 06302D73C4E03897E14E4D4FC1A1220062995A847F0EF69581702C09C1329395 561 | BCFCAFB8B2C3F268B212AEB5A541E9AE2964F3F46058648FFA17CD70A90A8668 562 | 8626C4D3B521956980989634ECBA781CCB8C57F2EA6FF9C54DAB3E09F8A1EB5C 563 | BE23AEB26E40EEA631A472F471264B1767D27508570792841BDD9C0AB52C2B7C 564 | ACB7A26B99DECA5573FBC027DEDF092F73F994AB95674BE24887636510546E5A 565 | 4029E73CC97F10E1A64125D3021F6B2EE7122EDF3EF889CB67C2CB6C5776EFBE 566 | 7C0A8EE521B858178F8BB5F1B02D09C08EC0A3F8587B45F7325DFE5C5E1C362B 567 | 572FB35C69B1CC6C25EB63FD159C8F755770487A2C028B659A2B57E39FACD77F 568 | 360C725D57EB653B596867D8B1D453AD396753CE7314138D5972F1FA165257B5 569 | 17CDBF7EAEABB05E9663B75FF515147457A0E6793DCA7AAA91D49605AD6C2B88 570 | 47AB758B44280B0BE2EA663972935A73D13AF818194F6EE1222B1A01CD9711FD 571 | 2809779E15C134DF054261B2DCA31725E7C5A19FE3B28A70BBAEB564A269A095 572 | B1174E55BEB0ABF4806B7D005CEAFD615BEB81A4C799D0C8B6C0C120D1AEBD7E 573 | 2779FD87702DED4B0289E61AE14FD273A9F38355A933662FD32A7B68149CE7E9 574 | 7F5F98187EF53ECAEBBF5AE9B6AC84B60CC4907CDA54B8E17C9903B46F99F2F8 575 | 9209EABC3E4DF56F5DE483ED1E0778FA51BB61399CD19107D7078130235C4117 576 | D503D57F68FD356C71DDCDD3AF7292D9705C5B2A2C6A5C605869B3289FEAFF52 577 | 7D3C3638EDE0F1E5130C592E442FCE7501D0283663ECCEE978E5793C8A59FD9B 578 | E7B9639DFD565EFEA5E3742D85E355E7E99F96772E7FAEFEB778EEC19A0B1B78 579 | F5772646639568944A973A699BB7E95FE29A26E5767D63B56E9EFE4F86CB0B1F 580 | BB24CD554A3311A87FF16B1A5863B3814BB87CFBE0A16071E17D01C2DDBB8285 581 | 6091EF89807B3108A88981499E3336B9EFA6DC6E41DC59ECF239BE7A87E7218B 582 | 9FDDF6B23639FFCA59EFB89DF383DD66D61A9B9F2CBEB65AF79BD6BF4AD13917 583 | E57C5D3B41EF4FC549B99CB822CEF7BD4AE1395FEB4A1758963B93F6D3F07A83 584 | 7B55D2572BC3086A69E770304488F75EB5587F29E1865B11EE9596EB646CBB06 585 | D3223B48A4295F124B56582A9220B3F464AC64B86686017C6B2EC2B33A108AF1 586 | 1AF8D5EBE0A51DAE7B0957CF5CE9AE4EAD7DA527229BE2C9D81607A3BBD6104B 587 | 92AF15899731391923617E2C52B456F5861EBCAA83E05EE90FD5241D6C77D953 588 | BBD5FE5713A6FFDFD25C7136EF1CC21BAF22F4410C4413E5B030FFFB838EC3AD 589 | C20FCEE55ED8E77D145BEC7F5931FB4E265B6D85528E36D1D51504D747E2F435 590 | 1908459FF988C70D3CFED15EDFA3702AF3827DA91B76B91DC046AB6D3CBE64BA 591 | CA0AB9740D04D54520E07E18B4328D70F4F269F7D9F7BBBD0FB9CBC42AC3AEC4 592 | 15178A9CB0C3610F7E34DBC4E38BA7282C3D9D20FBD2B6D80D3E3521F0206554 593 | 4AD2C45EFFA3D9BBBC0F654B5E518055A123B13B8ED048D1C33AD34D2FD71AAE 594 | 5F3A4F3FB19222C7A3C4C674334DE052EEC394D320DB1CBA19264C9A16057690 595 | 8C92C73A938D636B0DD68BF0EB038743853F3F1074227C8FDF9149AD547D5C28 596 | 7666D2554ED0C0FAF35B267F30D918BE46FFC7CFDFD60F7FF138B0FD68A0302C 597 | 0BEC713EFF02F6B81EC20FC61BB6BF4F5FDE62B773D4F48E158CF3CEE37BA39F 598 | 46DF570B1B2C7F86F16D0B18E699E13BBD1FF0BE7C52C720758C6F757FC0579A 599 | 6BF05B1FF7FF7F8187ACFC07D7B5D9EE7DD05EB3EE83F8D6478EC175EF21449C 600 | 9181D32FFB60BD711B9CB6ED86F7AE43083E700211C74411272C851471056449 601 | AB224F5E8B978EA38818DCF61D469ED179DC35B34681A51D8A2F38A3CCD10315 602 | AEBEA8F60AC23DBF50D40545E0C1A568345E8E4381B21E8FEF2C2C0AEFC342C8 603 | B7B880221B4794D8BBA2DCD90B951EFEA8F10D416D4038EA43A2D010168BA6C8 604 | 78B44427A244D5605E39BD4E9F41E869294449282C9A679A2EE52EE453048B49 605 | C38FF0FE91F64B33B1FC5D2BBFE383A05A62F01141EEC2E7F4A2F703C12772C9 606 | 78F8D1227C967281DE88203EE18E6C73DACD12C0BD6F5DE54AE6FE8E90CE5205 607 | 1993211C27856311A220E94E112E24A214703A540A641CBCBF805B46E73F74FE 608 | 12D6108B90FA2804107FDC77662CA763B13D19FB6DC8F86D41C6C3C3DE42F842 609 | ED9B32DEFCBF40AFD0BCD401971E44337308BF7BA1CC5CC7B5C2178E651ECC38 610 | 6C49C66F33322F3222E3E13EB7C3F84CF1F3C2B9792079AED1CB3327616C2179 611 | 4D89E61934CFA4BCD868BD0DBF38EDC3990819EC256331E1D6F0AB0352DE6652 612 | DE11C2DDB2F01D1907B7903C8F106EB3A0FA27DC8F08374BD07BC2CD5A2EF3E9 613 | 47BFF7F5F70399D7991CBA7872E987F2499BD492BE7069B1308A77B497CBE6AA 614 | EB4AA629678A5E97650BC548E0489830F6051C83DC555548462A80CCA9BCF871 615 | 15F2B4B6CA64AB269B16D892BEEE43FAEF25F89379B0574D3033E7762CF38435 616 | 99471EF717C1575A6BE6F91F723735974B659C4DB627FDFC22997F7B927E4FE7 617 | C0749EEF4474635BEC0ACB427B98DEB5C201F7A358A5FC85CB5C3EC9AFAEE16D 618 | 4B04D512DDD45C8243893BE85C7BABC3AF34BF74EE88435E27B0CFF5303E55FC 619 | DC7761DE898F91695DE0CCA4675BE802E293B46FB6DDE93E37CC6A95AF6A57CA 620 | AF0EE7DFE74F3F23F53B4AEA779868EDE546EBEDB60BC3AC90FDCC7C99E48AA5 621 | 242D79D296F2A42DE5F7F81E912769C993FA95FFC563BF3CC9AF3CC9AF3CC9AF 622 | FC59E25329E5EB9AF349CB96A4F57226AD5192D633016D194EDAB276EE33D296 623 | EE24AD7687620FE2C7784227D588D64D269FB6F4352FB18771BE0D487E41F20B 624 | 925F28121FC0B6C095694B6A8F840245695BEA2E684B17D3425B8435C6326D19 625 | 486CE0DCB63423B68FB6A5F415457CA9F16D3269CBE50BDAD24EFFD679E24385 626 | 336DE95915407C196FC6769AE5D940F9BA268EF89CC4E7AADF2493B6DC2A402B 627 | 5E2AC9DA90BFA64ADB12A42DB1DE7C33D618AC6793FC6692B6D4256DB97CD135 628 | 00A21552BFB51FAA37D2964B495B9AFC6EBBFEB978DBF8FF36081AFFC9F80D0A 629 | 320E433E4F8BDFF88FB78CFF886E49FC47C67F66DDE343C7FFC5F2FC3EE3FF62 630 | 7897F1FF6DF87DFCFFEF879656C76A0DF5760B55F53696A2522B475EA98523AD 631 | D8CC92546CB01057A85F74FD524BB353585DFD51B787EF4BE4158CA2B26E0C85 632 | 1563B896C6858A6E078465EE770B49570B0BE4AA3DE65EBB3E88A6D62924E68C 633 | C33B6A1CAEA1E3B81437819C9249E89AF7E0A86425F7A078F9BC383435DB5711 634 | 6E57542C07F5AC2938868CC3CABB1F661E03B0F21B85A5CF188CDC4671356314 635 | 8ADA9DD82756D2B54BB488B77E4CB89616B66C54D54F32E959FA8EC0D0A5179A 636 | 76C3F3A068CAC195A451EC3C710F3B45F279EBD767D51FB2A29386101A3F0E63 637 | B77E88C8BEE00B45E341D878706162D5839F85EFF0EC88921A6B38297B0C56BE 638 | E3D0B5EF17B87E7FEC4C0F64D47B11103A804D27F278EBF7B28A2DC311F123D0 639 | 751885EA85E145F9522A6C045C1AC07AA19B3CBE944223CBC6AD1796DE2390D6 640 | E730E1F8E184640FCC6DFB6168DE81EF8FE4F0F22F2E576F79449485C8F86188 641 | 2AF5E3944AEF1BDCA3E2DD3825D18DF0A8216C102AC4B787B378F527225BBB4A 642 | 58BEA64B5EA3131109434C5D0949B119DEF133DD382ADA0D2182B0482E44E41A 643 | 28B7EB9B23E9F3D6FF8F4954091F3A53C195527E8C889821583AF44152B10767 644 | A49FC2C2AE176197B93829DD88EF0E677209976F1FDC2F5E2ABCFB7471F7F653 645 | 9530347B064F9F5E067A264FF0D3B1BB94DB2D88CB5BBB142958FDB350BEC516 646 | E13CD6C693B738EB8EDCE47C7F3C8BF5DDD14C8BAF0EA6FFE6D6FFE3F44E6AB4 647 | A5B8735B63CDD11A6386962B66688A34C583CB46A80F33446DA83E6A42CEA13A 648 | 581715013A28F3D34461881997F228BF2DC17EEA59B60FDE1777BD74A6289F49 649 | F70370C7558559276291FC0E0F0FBF376E392A32FCE628530C0D0D1170C1A5E0 650 | 7299DF05050502C1E50E21C7FED51E01ADABC1C141D4DA8AF33038C861C209BA 651 | 381C0E326D64183EADE781817E0CF40FA07F6080B90F90FB627CFA3EDD528AE1 652 | D336EAEBED455F5FDFAB3B416F1F0173EF7B759F411FEF771F6E9C9760F8F72F 653 | E9E3C58B1704CF67407E3F7FB168F969B8643371865F19A8839E9E9E79E5A7FF 654 | 2F96FF1E361B0986220CBFDC4F1B4F9F3EC53382A773B0189FBEBFA62FCCF04B 655 | 7D34D1DDD5852E06DD33F72EDE33E6DE4DEEDDDD33BFE9BD1B71E74E62A6FFC7 656 | 1578A832FD29CF4909B9F6F2C8B695451AA95F5A4729E6E2483415C3752351C4 657 | 933CC79174098722EEF7F9C23F071BD29AEFC9E4B78FCB1574F0204BB03D83D5 658 | B6E646D35F09FE320FA90CFE38CBDF94DA323A353D8D69F20FB9618A80FE668F 659 | 4C40A3E4C9984649E7E82C4CABBA470CCABBDAD7A7348BCEF23726B5F48F4C4E 660 | C3E3C928BC1F0E21FCF11012DA87D137310D2E898C43DE0D10D0FF7B09C6A730 661 | B629A9A59E97FEB596C101F2D08F707D5BB9B0793008F5F297D0AC60C3BEAE0F 662 | D6B57D30BBD707A39A5E9C23E821F9DA90D8C2E1A51FDF32FE6C78027EF57D70 663 | AAEE85FEDD1E94F50C6370F255DAF4DE3F277D5AB64DF12DBC75CACD312DE3F4 664 | D928B1A8C304439360784DC393F0EB1E857DE7088C1E0D43953504A9262E1AB9 665 | 93D878E5357F5344CBD830095F3A3889ECBE0924BC2073AE67637025BCF38FC9 666 | DCA77518929969100F34C4090F151C7091C77A379F091E3FA4657490943FF5E5 667 | 38AEF48CC19FA6D941D27C380C6592A6486A22E4E36DE05F9F869CEE7B50CFF5 668 | C45A4F31FC5D63B31B537EBF96913E528208C2F5EE1A854DFB08CE11AE620BE1 669 | 3672B1D759015E7529F0694861F4AF7CD30D676F7A523E53869F3C9ABB5BFBC7 670 | FB63DBB853612C2E0248D57A3471E0D0C88155FD207E343F8A4BF519F36C887F 671 | ED0DCA676CC01A8726DDB54E4D316B1D9BD8E43EB2109F68ED84428E2BE4721C 672 | 19AE5CB6E3BCF4DF0612CEEE6B376128E5B833E9D23BFD7FB6FCEF188713C120 673 | CDF3CCDD893ED70B6FFC338136412A411B0197604A2DF83EA4BC4A71DC216FEA 674 | 17F354EE0FBA57DB3E53094BFD2F697FEDFF10F3FCF36CBC246CA163E663F817 675 | 7723B4868D88BA17B87CFF392E963F43407E173C733AE098D206D3A87AC87B15 676 | 62A74922089FE73B9A4535DC9FE55FACEAC12582E092A7F0BFFB041E598FE19C 677 | DC069BD846E85FAC81B45B3EC3FFBBB417CFFF6DAF2DFAF64E511542325B6111 678 | F3008AFEE538E198079267903C63F5D970AC500CC21A8D1008DBC6C2C92F0499 679 | D17EDFCEAD9B71565ED658671526382F303D3E82E989514C0EBDC448F7030CB7 680 | 5762ECC5238C3D6FC3F3EA343CCAF0E3BBBE3CDC909D34D4903D3DF6E231A646 681 | B998E8EFC6E8D346C27B88C196227464074E3F4AF74D5CAC8D066A92B7F4D7A4 682 | B471DACA30DEDBC1705FDECB407B7600EB61BACF96776D6B76714C01B7BD1A9C 683 | 479568CFF2CF67341EA531F463B832D686CAFEDBDBF83DC5574BB89DF708BF0A 684 | 0FD37CE840BAE4C770C52189541B7C1D248695FE27F8C6D15314F333BB22B99D 685 | D3518B1DD13AD87A451B1B2254B12E541EA793CEC3BBE21A4EC41BE0FF78EE9B 686 | FA4FD71DFF3197FBAC202AB9A734617A84FD906903925F045427C3AFEA3AC3F3 687 | AAB80A839B5E702989C0FE6855FCABE3C6A93FD8AEFD0BE53ECDBF9CFDB22E17 688 | E3FD5D981A1BC2F4E438487E19AE4E8E0734B29CA192610FF9546B9C4DBF00DB 689 | FC206CBF2C8525565F4CD6E5C67EDB5D108DBE863B981864335C4C4FE19B8B92 690 | F02A8F837B69345C8A23E05414067512C785FC401C8C56C1128BCFD84B4C97AD 691 | A3FD3F28BB1E45258578D15482E1E79D181F1AC0AAC053F8C4FB10FEEAB907FF 692 | CB751B7E0E9781F5DD00EC8F52C01FCCBE1A5B62FAF76F17EA67B1FEFF27BB1F 693 | B1274216FF6AFE3DFE5DC6A46A8EFE78FA259A6D239AE5CE6896E9FF44B35344 694 | B3DC25E7BF985E6ABE02FF26A76B3357BFBFCFFFCDF0002D042C341034A215CD 695 | 78C8AC3D67B5DC1438879C3BFF9FE5D74D35C1BCD896E11F8B388DF4866C26AC 696 | 7DB12B067B9F62E8F95370D84F30F8F4E1BCF9FF2B7E0BD4B2F5201227831CF6 697 | 6D485E51C48DDAF457E7FF9294A09AA28391C1E718E96763F8C5B379F37FCAD5 698 | CC35844686018C6E5A42F8B22494623570A3269D29077D7E3659074AD16A18E7 699 | F46174F0C5BCF9BF788202D4D2F4E0511900D70A1F38967A4036421909658933 700 | E7815E3D978894C74E877D98181A9C37FFA7E9CBC6A9403A4609E2A48FD27D0F 701 | B11069C415C54324520A9AA906CCF333FE3298181FC604B18F73E7FFB3E53FE6 702 | 2F82CD56DBC9AF47746D1FD70A1350DFDD801D8E7B21E42182A9A9714C4E8E60 703 | 626278DEFC7F965F3BD9883381320C7F95F21788BE1DC3D49F5A9826C626885D 704 | 9F1E67303939366FFE3FCBA7EDDF843686BF5CE65344DDBC22B0FD7F9FFFBFC2 705 | 931B6EE84872C2E3043BB4C559A335DA022D5166E5FCC2F6E54759F6DD8DEC7C 706 | 79271CCFF342F1FC66082646B86FA0F1B2C1343F7EEFDD88A1856117AE4DD367 707 | F51775F89E0179713B8C793F779D7BE145DFDF0F54E7CB7F7EEB22F37E9E2F5A 708 | 10330FF47DB5AF12E69F5D9412A1F680AE899F0C119F17FE5949C2BCF846069E 709 | A3C25396C7178A91103912263C6D7ECB0636F98E38EC25C4F0E8F5AC308EE1F7 710 | 9425E3592941653A635B4A5DCE60662F4AE4D0C593D306596610BA28C6EC45ED 711 | 7138809EE26B04096013EEC2F407BA582876384DED9704C9EFB44EBA115DC39F 712 | DE68BDFD60678A1BC68707C02E4B64C2B269BA337130E99726422EE12CB36F2B 713 | 15AB088D1B7A741F749AD883FDCC5C2DD111E3DC7EB02B6E805D99FA0A353998 714 | 181EE4A52F11290BB3DB649C4ED6A2F99D5E6FBE79FF6C5D3CBA760163C47EB1 715 | AB335F7D9F702F17ECAAF479100E169FD973D88E75A61BF7CF6D87B6AB960CFF 716 | F9BD1C86CBF04BAECF2B7F7F47138ADD64F9B67F33192BC638BD785E9BF72AFD 717 | BADB4CF8852872919EE2C76F8C3024B6F7E52B1BFEB21B5C76070AEC4EBD815C 718 | E3DDC9FCF80D61E70AEB82B5B9F7035451EDA3880A0F997FFCACD36FE0EF4CFE 719 | 63C8177440B1B093070502D13B8FF17274121CE21BCEC3C41426A9A33EC3DF9E 720 | CE8220FF5DBBB40B3A654F78B0A8790ABB7BCF90D335C8E3EF4A6BC57BFAEF10 721 | BFF998C7FF35B115EFEBBFEFBCD1CAE36FBDCEC2FBFAEFDB13593CFEB6AB2CCC 722 | FAEFA7BCCFBC93FFBE2D760E3F8A05EABF1FF312C10E977D7CFD77E9E6219C68 723 | 20BE741D07F738841FF99ABF3D948503CE272017AB06E92BCAD87C612799036C 724 | C38FA69BF1BDE10688111FFC503D07DBEE0F625DF5002A0727B0EDE26BFE4E0F 725 | 79C8C69C857B55009CC93CC3AED41DD6C54E302FB0C5B7BAEB7080A4B9F5DE20 726 | BEAF1AC09715FD28A7FCC0577CFB0C17C890F9B86BA51F2C8A1CA07FE73CB46F 727 | 19432D570F86B7CF3367674DEB0671AE76009AF706A05633807CF6287EF17F9D 728 | FE614F2988864AF3D234BE6B857379A6D0B96988CFCF7E8D0D6ECDAFE1DA8CAD 729 | 9E2DB0CFEE99A79EAD463B99F9CB216F217CADBD165FAA7F8BD52A5FE133C52F 730 | DE59653F1BFF821D46BBFE21556ED7FFF537A2EA77FFFB39B30532F9ED902336 731 | 6016B204BF64B5A26D700CCF8626E683E8676C6A8A57CECDA92D5864FD0E1AA5 732 | 9D3C985675C3A8BC0B6EF5AFDB6F5372CB7BEB7F7BCAEBFEB3E95ACB7BEB7F63 733 | 620B8FBF31BE051FB07EF7BAFC312D78DBFADDF6AB46A0FEFF9CF5BBD7F98F68 734 | C1DBD6EF36105F7ED6FFA7FADF183E27FD90162C5CBFA3FEFF962B3AD810A986 735 | 75618AF3FCFF8FBD0F626350F3EBF2FBB560E1FADDDBFCFF3F3B6E79CD277A6C 736 | ED1F476C1B17B3EB77EFE8FF337168273CC1FEC0367CEFD4C4C3DBFCFF3F596D 737 | 5854679F059EC432E2FFFF6FE2FFFF6581FFFF679B2FDF5BA34BEDD632FEFFBF 738 | 5B7FFD41FAFE17CB55A0FEFF1B6FFE077D855371522627AE887FF039C21351E2 739 | B547C245049E2354B8ADB55C2E5743573A4B3553224D992D96AC009104199C8C 740 | 9564CE91A9A5EA412549077BFD8E7AF13B43289BAB9E6C5E640FF7EA00C63FA0 741 | 7E02FD1E879E23A3BE82774D30DCC938237BF52CFDFE87778E50FE96E672D91C 742 | F564A74A1FE61C4D40DD655CAC8F42F0CCF738F4BB23AFEA60E61C1A3D4F2649 743 | FAC016FB5F5CE67CFFA36B5664C79CDDA169529F5B2B8BF98607872E9D247DF3 744 | 3876FB1C66FC6B8928796CB1DB39EF1CA164BA4AA64BA52F7CEF933C568780D4 745 | 7107E17ABEF18DB4D3AE5A32A77EE31CA1788A02DBEFFEAB33934637AD40EAD8 746 | 935FFD6EBEB0C3FC27CBAD6FB41FA963363D2F44EBE75CB619F173843CDFA75D 747 | 4FC648645A11DFC6919E532A76C31EBF231DBF7A1E78E7388E4588EAAADED065 748 | CE2BD1B34E9677ED7126528ED63173F668BDF916FAFD0FD6E8FF886FE8D8ACF1 749 | EDBC7933A9E3E5A48E93B589AF43CF499990F1DFAAD081F976C894F895C6B72D 750 | 6170CB0CE76E994037D79019D717E661B7F7A1AD3BDDF7254B44C9413D451786 751 | 37CFC3E4B605E3931ADC3285DE4D63C2358056B63E3E55F89CEFBCFD67C75DCB 752 | 491DEB923ACE5C67BA89BDD670FDD4ECF73F5FA87D8355CA5F12EE6AAC90FDEC 753 | 37F58D439289A84659A41DB73ADC18F723CFA3FD860BDAD3DCD1712B9C9B6527 754 | 1B5773DD8B5B1F6783867807342539A133C71F4FF2A3B9B9CE0ACC1A60819FFE 755 | 54CFAD20B0F342C0BE7D09EC3BA1787E371CCF0B22D0911588178557F0A2281A 756 | 2F8A63F1B2E4EA2B94C6E1495E38E367DD713B8BB6384BB4C55BE361C2053C4A 757 | B4C7A324473C4E71C6639A97543774A47BA023C30B1D99DEE8CCF24567B61F81 758 | 3F538FB976F202D7791E5D17FC3D6D47860FC3CFB0921418A695F8AC82AEC769 759 | 9E0C3FC55854609896184B81EF1EA6B831FCEBBAA7048669883011F88EF5AA6C 760 | 4BAE6A1C1718A62E545FE0BBE6B80BCCC70DB2F20E582E7E1B7FDA7313AB25EF 761 | C0D0FBF5DE7B4D90B640FE832BE7F1C73D395ADF6B94E3DCD52164354CC33D7D 762 | 84CC816B1190D2C98429F53A2B905F136A88A57BB31FFEEAF21C9F91A2FCA731 763 | 708C34897BFA30BE90CE67C214392B0AE45704EAE18FBB6F4EFFCDAA6FDEF3C4 764 | AA69A62CF4BA6B2723905FEAAD81A5FBB29F2C556DC712A35E8251FCCD0A500C 765 | E5E2AF4712917D5E0C97E4F675842AEC47B8F22144AA1D418CE609DCB495C51D 766 | 2705C4681D8F5BBA2FCBEC8FC76E4DFE41A90D7F3265E333E36E7CA15436F1B1 767 | 5881F5BB688F5E340E928F4E5A16727FB45CACD064F69B93FF6E500D532D534D 768 | 536D538D53AD53CD53ED531B406D01B509D436501B416D05B519CCFA21D130D5 769 | F2ACAEA9C619AD13CD53ED531B406D01B5098C6D203682DA0A6A33289F6A98D1 770 | 32D134D536A371A275AA79AA7D6A03A82DA03681DA066A23A8ADA03683F26734 771 | FCDEDA9FB1194B6634FCDEDA9FB1194B6634FCDEDA9FB1194B588BE47131EDCF 772 | D88C2554C31FA2FD199BB1846A58A03EE7689FDA046A1BA8AEA8ADA03683F2A9 773 | 8605EA6B46FBD416509B406D03B511D456509B416D07D5B0A06B56FBD416509B 774 | 406D03B511D456509B416D07D5B0A06B56FB34CFD426CCBDA8CDA07AA31AA65A 775 | A69AA6DAA61AA75AA79AA7DAA73680DA026A13A86DA03682DA0A6A33A8ED7817 776 | 8D515B406D02B50DD446505B416D06D5FDBBEA94DA046A1B666C44E75C2EB93E 777 | 21F88960D35BF029C1BFF0B1413F8D8E8EF64F4C4C4C4D4E4E821FC87BF8F9F9 778 | 79F38B83C64DB9AFCECE0DF140CFA9D17369F43C188D23E1C113884737C19EF8 779 | DEFB43EFE13BFFFB3284FB07CAA7EF474646303636C6DC29E839B9FEFE7EB0D9 780 | 6C243DE1C038EF29D26AFBD1C50112884F7ED0ADE4D95C3EE5CE82F2E9393F7A 781 | 36EF6AF333D834F4E24627F189EF3C4562DD300A1F4F4225BC6E642E9F948157 782 | 5EFA9B9639A7B31F16F5BD28248EB966DB30B4CA5F4231AA1152C135FD273C0A 783 | BF9ACB5F885B5D8330ADEB45C9C814645B8720D93102B386419C8CECC0EAC31A 784 | 52335CBEFCA4FA2E18573C65B832842B417C6AF3FA011C0969437DD71066DA93 785 | 2FFFC6832E18E534229FE459F1D108A43B46493EFA7128A8150F7B06993082F8 786 | D1058D30CB7800AFCCFB385DF604928F866072EF254E86B6E1D1F321A64E16E3 787 | EF71BE86C783804848133E36CB236916E1A047099ABA390CF76DFCEFCFDAC3AF 788 | 640CDE6563D8655F46E6FA89A8EFE8C5F8F8380F8BF1FFB64702DFC93BE3A84B 789 | 1E74AE56E071CF00D3967321803F2DA8EFF3C114E5CCE9FF1B489F1BA2CFDF85 790 | 4BC272A8E6E6F097D338DE41BFB3A05A5F8EFFE7560AF9FF6D486BE6BB7EB83D 791 | 838535379ADE44EA2BF0D6BFDEB67E58D2C9035D3F3428EFC2FA9439EB5749EF 792 | BF7EB829A9E51F5A3FDCF03FBC7EC8E7FCDF7BAD1F2EDC3F98BB7EB889CFFAE1 793 | DCF37FFCF60F3606B52CBA7E38F7FC1FBFFD03CA99E5FFE4D1FCC6FAE1DCF37F 794 | FCF60F286796BFC6A1096B9D081C67EE8B61260CE5FC16B4C36F4FBE2727004F 795 | 337DD19DEE85B7EDEFF7DE8D78CE6F0F7F31345E36185D6C4F7EB16FCF16EEEF 796 | F3DB935FEC5AB8BFDF9313C43C5BB88F2F080BF7F79F66FAF1F8B37BF273AFB7 797 | EDEF7711FF617C7870DE9E7C4FC975D4076AA33ECC1CF782F4D070E502AA3C54 798 | 51E5A5867B2186B81FAC8F5257055C97F87413BF3D797A55BA2B8353F5EA7767 799 | 49EA1BF5C0BE1D81326739F0DD932728719044DF9DB05771F96ACFAD40622806 800 | F024C90D252EF2E0B727CFCCDD9DA4D147D2989A1CC7F4E404A6A7A608263135 801 | 314E9E4DA0EDAA3DEE5A0983DF9E3C4539C93F3B2B186DD196688BB1062BEA3C 802 | 9A2F9B1198A229DC044D6126B86D270D7E7BF2F42A739527FDD7071DB1366827 803 | 78186581D60873B0C24DD11C668CFA107DE45A8A81DF9E3CE7E94314DA88809D 804 | 1148E6906CBC1CE8461F457F37F9DD05CED04B3CB8648A64DDBDE0B7275FE622 805 | 8902AB93E8CB08019BF30C276FDB41A72C087A65C11021BF9F707BD076C91CD7 806 | D47E16B88E576C7B1A7DD5396823FF38F6962092DB88C8E146B891DF8FC9B3B6 807 | 487BC4ABEF14C8CF51FDA9A8C04E1C75AEAA68F7D445ABBB265A5CB5D0E8A28D 808 | 2A574DC46BED458CECF7F8BF271A3F09 809 | } 810 | end 811 | object SelectDirectoryDialog1: TSelectDirectoryDialog 812 | Left = 512 813 | Top = 8 814 | end 815 | end 816 | -------------------------------------------------------------------------------- /src/unit1.pas: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* CopyCommander2 15.02.2022 *) 3 | (* *) 4 | (* Version : 0.13 *) 5 | (* *) 6 | (* Author : Uwe Schächterle (Corpsman) *) 7 | (* *) 8 | (* Support : www.Corpsman.de *) 9 | (* *) 10 | (* Description : qued copy Application *) 11 | (* *) 12 | (* License : See the file license.md, located under: *) 13 | (* https://github.com/PascalCorpsman/Software_Licenses/blob/main/license.md *) 14 | (* for details about the license. *) 15 | (* *) 16 | (* It is not allowed to change or remove this text from any *) 17 | (* source file of the project. *) 18 | (* *) 19 | (* Warranty : There is no warranty, neither in correctness of the *) 20 | (* implementation, nor anything other that could happen *) 21 | (* or go wrong, use at your own risk. *) 22 | (* *) 23 | (* Known Issues: *) 24 | (* - die "ins" taste funktioniert unter Linux nicht (zumindest nicht wie *) 25 | (* erwartet), Shift Pfeil runter geht aber. *) 26 | (* - Wird ein Laufender Job Abgebrochen, dann werden die "fehlenden" Bytes *) 27 | (* nicht Korrekt von den Bytes to Copy abgezogen *) 28 | (* \-> Am Ende bleiben dann Bytes über, die Engine nullt das zwar ganz *) 29 | (* am Schluss wenn die JobFifo leer ist, aber sauber ist anders. *) 30 | (* -Ändert sich die Anzahl der Bytes in einem Job der noch in der *) 31 | (* Warteschlange ist, dann stimmt am ende die Statistik nicht mehr *) 32 | (* Da die Byteanzahl beim Adden gespeichert und dann nicht mehr *) 33 | (* aktualisiert wird *) 34 | (* *) 35 | (* History : 0.01 - Initial version *) 36 | (* (15.02.2022) 0.01 = Initialversion *) 37 | (* (17.02.2022) 0.02 = Auswerten Paramstr beim Start (besseres *) 38 | (* Fehlerhandling) *) 39 | (* Windows: show Drive Letters as top Level *) 40 | (* Fix: ListViewSelectItemIndex *) 41 | (* Fix: Linux: F7 dialog was doubled if entered via *) 42 | (* keyboard. *) 43 | (* (18.02.2022) 0.03 = Fix: Anchors of Progress Label *) 44 | (* Refactor file ext icons ( Pull request by H. Elsner) *) 45 | (* (21.02.2022) 0.04 = Shortcut buttons seperated for left and right panels *) 46 | (* (Pull request by H. Elsner) *) 47 | (* Added menu item to copy shortcut button to the other *) 48 | (* panel ( Pull request by H. Elsner) *) 49 | (* Added menu item to move shortcut button to the other *) 50 | (* panel ( Pull request by H. Elsner) *) 51 | (* Added double click to pathname-edits to create *) 52 | (* shortcuts ( Pull request by H. Elsner) *) 53 | (* Added menu Open in file manager ( Pull request by H. *) 54 | (* Elsner) *) 55 | (* Added app icon ( Pull request by H. Elsner) *) 56 | (* (22.02.2022) 0.05 = Fix: Roll back OnActivate procedure *) 57 | (* Fix: Open file manager was incorrectly called in LINUX*) 58 | (* environmat *) 59 | (* Fix showing bug for files with no "name" *) 60 | (* (12.03.2022) 0.06 = Fix: Diff Dialog did not find hidden files *) 61 | (* Fix: Filesize of Files larger than 2^32-Bit was wrong *) 62 | (* detected -> Error on file finish *) 63 | (* Feature Request - blue and green arrows in sync dialog*) 64 | (* (10.04.2022) 0.07 = Fix: Progress was not correct (filesize to copy did *) 65 | (* not decrease during progress) *) 66 | (* Fix: Crash, when GetHasQuestions was called before *) 67 | (* init *) 68 | (* Add Overall Progressbar *) 69 | (* (11.04.2022) 0.08 = Fix: Progress Calculation was complete garbage, *) 70 | (* rewrite calculations *) 71 | (* Enable Rename Feature in Submenu *) 72 | (* Add some video extensions to list *) 73 | (* (15.09.2022) 0.09 = Edit Eingabefelder gegen ComboBox getauscht, *) 74 | (* es werden die letzten 10 [maxDirs=10] gemerkt und in *) 75 | (* einer Drop-Down-Liste angeboten, *) 76 | (* Die Liste kann via contextmenü gelöscht werden *) 77 | (* 0.10 = TODO im STRG+S Dialog implementiert *) 78 | (* 0.11 = FIX: Combobox text was not updated, when history was *) 79 | (* full -> result in empty directory view *) 80 | (* CTRL + R = Reload directory *) 81 | (* CTRL + Tab = switch left / right view *) 82 | (* Diff dialog can export diff as .csv *) 83 | (* 0.12 = FIX: comming up the directory structure was broken *) 84 | (* ADD: swap size / ext for folders *) 85 | (* FIX: some gui glitches *) 86 | (* FIX: if filediff had exact 5 files, diff view was not *) 87 | (* refreshed. *) 88 | (* ADD: del target file in diff dialog if source file is *) 89 | (* not existing. *) 90 | (* ADD: improve UI on reloading directories *) 91 | (* 0.13 = ADD: implement sort for EXT and size *) 92 | (* FIX: column width glicht during resize *) 93 | (* *) 94 | (******************************************************************************) 95 | (* Silk icon set 1.3 used *) 96 | (* ---------------------- *) 97 | (* Mark James *) 98 | (* https://peacocksoftware.com/silk *) 99 | (******************************************************************************) 100 | (* This work is licensed under a *) 101 | (* Creative Commons Attribution 2.5 License. *) 102 | (* [ http://creativecommons.org/licenses/by/2.5/ ] *) 103 | (******************************************************************************) 104 | Unit Unit1; 105 | 106 | {$MODE objfpc}{$H+} 107 | 108 | Interface 109 | 110 | Uses 111 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, 112 | PairSplitter, ComCtrls, Menus, IniFiles, ucopycommander, Types, lclintf, 113 | Buttons; 114 | 115 | Type 116 | 117 | TJobSubType = (jsCopy, jsMove, jsDel); 118 | 119 | TView = Record 120 | (* Daten welche sich andauernd Ändern *) 121 | aDirectory: String; // das Gerade Geladene Verzeichnis (unabhängig davon was im Editfeld steht) immer mit pathdelim ! 122 | sortstate: integer; 123 | (* Daten welche 1 mal initialisiert werden*) 124 | ListView: TListView; 125 | ComboBox: TComboBox; 126 | StatusBar: TStatusBar; 127 | End; 128 | 129 | PView = ^TView; 130 | 131 | TShortCutButton = Record 132 | Button: TButton; 133 | Link: String; 134 | Side: String; 135 | End; 136 | 137 | { TForm1 } 138 | 139 | TForm1 = Class(TForm) 140 | AppIcons: TImageList; 141 | ApplicationProperties1: TApplicationProperties; 142 | cbDirLeft: TComboBox; 143 | cbDirRight: TComboBox; 144 | ImageList1: TImageList; 145 | ListView1: TListView; 146 | ListView2: TListView; 147 | MenuItem1: TMenuItem; 148 | MenuItem18: TMenuItem; 149 | MenuItem23: TMenuItem; 150 | MenuItem24: TMenuItem; 151 | mnFileManagerR: TMenuItem; 152 | mnFilemanagerL: TMenuItem; 153 | mnMoveShortcut: TMenuItem; 154 | mnCreateShortcutL: TMenuItem; 155 | MenuItem10: TMenuItem; 156 | MenuItem11: TMenuItem; 157 | MenuItem12: TMenuItem; 158 | MenuItem13: TMenuItem; 159 | MenuItem14: TMenuItem; 160 | MenuItem15: TMenuItem; 161 | MenuItem16: TMenuItem; 162 | MenuItem17: TMenuItem; 163 | mnCreateShortcutR: TMenuItem; 164 | MenuItem19: TMenuItem; 165 | MenuItem2: TMenuItem; 166 | MenuItem20: TMenuItem; 167 | MenuItem21: TMenuItem; 168 | MenuItem22: TMenuItem; 169 | mnCopyBtn: TMenuItem; 170 | mnDeleteShortcut: TMenuItem; 171 | MenuItem3: TMenuItem; 172 | MenuItem4: TMenuItem; 173 | MenuItem5: TMenuItem; 174 | MenuItem6: TMenuItem; 175 | MenuItem7: TMenuItem; 176 | MenuItem8: TMenuItem; 177 | MenuItem9: TMenuItem; 178 | PairSplitter1: TPairSplitter; 179 | PairSplitterSide1: TPairSplitterSide; 180 | PairSplitterSide2: TPairSplitterSide; 181 | Panel1: TPanel; 182 | Panel2: TPanel; 183 | PopupMenu1: TPopupMenu; 184 | PopupMenu2: TPopupMenu; 185 | PopupMenu3: TPopupMenu; 186 | PopupMenu4: TPopupMenu; 187 | PopupMenu5: TPopupMenu; 188 | btnDirLeft: TSpeedButton; 189 | btnDirRight: TSpeedButton; 190 | SelectDirectoryDialog1: TSelectDirectoryDialog; 191 | StatusBar1: TStatusBar; 192 | StatusBar2: TStatusBar; 193 | Procedure ApplicationProperties1Idle(Sender: TObject; Var Done: Boolean); 194 | Procedure btnDirLeftClick(Sender: TObject); 195 | Procedure btnDirRightClick(Sender: TObject); 196 | Procedure cbDirLeftDblClick(Sender: TObject); 197 | Procedure cbDirLeftKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState 198 | ); 199 | Procedure cbDirLeftKeyPress(Sender: TObject; Var Key: char); 200 | Procedure cbDirLeftSelect(Sender: TObject); 201 | Procedure cbDirRightDblClick(Sender: TObject); 202 | Procedure cbDirRightKeyDown(Sender: TObject; Var Key: Word; 203 | Shift: TShiftState); 204 | Procedure cbDirRightKeyPress(Sender: TObject; Var Key: char); 205 | Procedure cbDirRightSelect(Sender: TObject); 206 | Procedure FormActivate(Sender: TObject); 207 | Procedure FormClose(Sender: TObject; Var CloseAction: TCloseAction); 208 | Procedure FormCloseQuery(Sender: TObject; Var CanClose: Boolean); 209 | Procedure FormCreate(Sender: TObject); 210 | Procedure FormDropFiles(Sender: TObject; Const FileNames: Array Of String); 211 | Procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn); 212 | Procedure ListView1DblClick(Sender: TObject); 213 | Procedure ListView1KeyDown(Sender: TObject; Var Key: Word; 214 | Shift: TShiftState); 215 | Procedure ListView1Resize(Sender: TObject); 216 | Procedure ListView2ColumnClick(Sender: TObject; Column: TListColumn); 217 | Procedure ListView2DblClick(Sender: TObject); 218 | Procedure ListView2Resize(Sender: TObject); 219 | Procedure MenuItem12Click(Sender: TObject); 220 | Procedure MenuItem14Click(Sender: TObject); 221 | Procedure MenuItem15Click(Sender: TObject); 222 | Procedure MenuItem16Click(Sender: TObject); 223 | Procedure MenuItem17Click(Sender: TObject); 224 | Procedure MenuItem23Click(Sender: TObject); 225 | Procedure MenuItem24Click(Sender: TObject); 226 | Procedure mnCreateShortcutRClick(Sender: TObject); 227 | Procedure MenuItem19Click(Sender: TObject); 228 | Procedure mnCreateShortcutLClick(Sender: TObject); 229 | Procedure mnCopyBtnClick(Sender: TObject); 230 | Procedure mnDeleteShortcutClick(Sender: TObject); 231 | Procedure MenuItem2Click(Sender: TObject); 232 | Procedure MenuItem4Click(Sender: TObject); 233 | Procedure MenuItem5Click(Sender: TObject); 234 | Procedure MenuItem6Click(Sender: TObject); 235 | Procedure MenuItem7Click(Sender: TObject); 236 | Procedure MenuItem8Click(Sender: TObject); 237 | Procedure MenuItem9Click(Sender: TObject); 238 | Procedure mnFilemanagerLClick(Sender: TObject); 239 | Procedure mnFileManagerRClick(Sender: TObject); 240 | Procedure mnMoveShortcutClick(Sender: TObject); 241 | Procedure PairSplitter1Resize(Sender: TObject); 242 | Procedure Panel1Resize(Sender: TObject); 243 | Procedure Panel2Resize(Sender: TObject); 244 | private 245 | fShortCutButtons: Array Of TShortCutButton; 246 | fLeftView, fRightView: TView; 247 | finiFile: TIniFile; 248 | fButtonPopupTag: Integer; 249 | startup: boolean; 250 | Procedure DiffViewer(); 251 | Procedure CreateAndAddJob(Item: TListItem; JobType: TJobSubType; SourceDir, 252 | DestDir: String); 253 | Procedure OnByteTransfereStatistic(Sender: TObject; Statistic: TTransfereStatistic); 254 | Procedure OnStartJob(Sender: TObject; Job: TJob); 255 | Procedure OnFinishJob(Sender: TObject; Job: TJob); 256 | Procedure OnFileCopyProgress(Sender: TObject; Const Job: TJob; Percent: Byte); 257 | Procedure OnAddSubJobs(Sender: TObject; Const Job: TJob; Const SubJobs: TJobArray); 258 | Procedure LoadShortCutButtons; 259 | Procedure OnButtonClick(Sender: TObject); 260 | Procedure OnButtonContextPopup(Sender: TObject; MousePos: TPoint; 261 | Var Handled: Boolean); 262 | Procedure CreateShortcutR; // Create schortcut button on right panel 263 | Procedure CreateShortCutL; // Create shortcut button on left panel 264 | Procedure CopyShortcut; 265 | Procedure DeleteShortcut; 266 | public 267 | fWorkThread: TWorkThread; // Bäh wieder Private machen ! 268 | Procedure LoadDir(Dir: String; Var View: TView); 269 | Procedure AddJob(Const Job: TJob); 270 | End; 271 | 272 | Var 273 | Form1: TForm1; 274 | 275 | Implementation 276 | 277 | {$R *.lfm} 278 | 279 | Uses LazFileUtils, LCLType, math 280 | , unit2 // Progress Dialog 281 | , Unit3 // Diff Dialog 282 | , unit4 // Errorlog 283 | , Unit5 // Abfrage Skip, Replace ... 284 | ; 285 | 286 | Const 287 | ImageIndexFolder = 0; 288 | ImageIndexBack = 1; 289 | {$IFDEF Windows} 290 | ImageIndexHDD = 2; // C:\, ... 291 | {$ENDIF} 292 | ImageIndexUnknownFile = 3; 293 | 294 | // Identifiers used for INI file 295 | iniGeneral = 'General'; 296 | iniLeft = 'Left'; 297 | iniRight = 'Right'; 298 | iniBtn = 'Btn'; 299 | 300 | iniLastDir = 'LastDir'; 301 | iniListDir = 'ListDir'; 302 | iniShortcutButtonCount = 'ShortcutButtonCount'; 303 | iniAppHeight = 'AppHeight'; 304 | iniAppWidth = 'AppWidth'; 305 | iniCaption = 'Caption'; 306 | iniLink = 'Link'; 307 | iniPosition = 'Position'; 308 | 309 | extra = '.'; // Extension-Rahmen: Der Rahmen um die Extension muss im Array unten verwendet werden 310 | {Diese Liste kann leicht erweitert werden. Man muss allerdings selber 311 | darauf achten, dass die Indizes stimmen - hier von 4..20} 312 | extlist: Array[4..20] Of String = ( 313 | '.txt.log.csv.', {4} 314 | '.avi.mov.mp4.m4v.mpg.mkv.webm.wmv.mpeg.ts.dv.', {5} 315 | '.bmp.tiff.tif.', 316 | '.dll.so.', 317 | '..exe.com.', 318 | '.hlp.', 319 | '.ini.cfg.conf.', {10} 320 | '.jpg.jpeg.png.gif.', 321 | '.rar.zip.tar.gz.7z.', 322 | '.mp3.ogg.wav.wv.flac.ape.m4a.shn.', 323 | '.sh.bat.cmd.', 324 | '.lfm.dfm.', {15} 325 | '.pas.lpr.dpr.', 326 | '.htm.html.', 327 | '.pdf.odt.', {18 Documents} 328 | '.xml.', 329 | '.css.' {20} 330 | ); 331 | 332 | maxDirs = 10; // Maximale Anzahl Pfade in der ComboBox 333 | 334 | SubItemIndexEXT = 0; 335 | SubItemIndexSize = 1; 336 | 337 | Procedure Nop(); 338 | Begin 339 | 340 | End; 341 | 342 | (* 343 | * Fügt den Aktuellen Wert der in der Combobox steht in die Dropdownliste hinzu (wenn noch nicht enthalten) 344 | * und kürzt ggf die Anzahl der Einträge auf maxCount Einträge herunter 345 | *) 346 | 347 | Procedure UpdateComboboxHistory(cb: TComboBox; maxCount: integer); 348 | Var 349 | tmp, directory: String; 350 | Begin 351 | tmp := cb.Text; 352 | directory := IncludeTrailingPathDelimiter(tmp); 353 | // DropDownListe füllen 354 | If (directory <> '') And (cb.Items.IndexOf(directory) < 0) Then // nur wenn noch nicht in Liste 355 | cb.Items.Insert(0, directory); 356 | // ggf Anzahl in Liste begrenzen 357 | If cb.Items.Count > MaxCount Then 358 | cb.Items.Delete(MaxCount); 359 | cb.Text := tmp; 360 | End; 361 | 362 | (* 363 | * Ermittelt den ImageIndex zu einer Gegebenen Dateiendung (Heuristisch) 364 | *) 365 | 366 | Function FileTypeToIndex(ext: String): Integer; 367 | Var 368 | i: integer; 369 | Begin 370 | result := ImageIndexUnknownFile; // Alle unbekannten File types bekommen diese Grafik. 371 | ext := lowercase(ext); 372 | For i := low(extlist) To high(extlist) Do Begin 373 | If pos(extra + ext + extra, extlist[i]) > 0 Then Begin 374 | result := i; 375 | break; 376 | End; 377 | End; 378 | End; 379 | 380 | Procedure SortListviewFromTo(Const Listview: TListview; aFrom, aTo: Integer; adir: Boolean; aItem: integer); 381 | (* 382 | * Im Prinzip die Umkehrfunktion zu FileSizeToString und zur Angabe wie viele Dateien in einem Verzeichnis sind .. 383 | * 149 B -> 149 384 | * 685,7MB -> 718281728 385 | * (29) -> 29 386 | *) 387 | Function SizeToInt(aSizeString: String): uint64; 388 | Var 389 | scale: uint64; 390 | index: integer; 391 | p, s: String; 392 | Begin 393 | index := pos('(', aSizeString); 394 | If index <> 0 Then Begin 395 | delete(aSizeString, index, 1); 396 | index := pos(')', aSizeString); 397 | If index <> 0 Then 398 | delete(aSizeString, index, 1); 399 | result := strtointdef(trim(aSizeString), 0); 400 | End 401 | Else Begin 402 | result := 0; 403 | p := ''; 404 | s := ''; 405 | index := pos(',', aSizeString); 406 | If index <> 0 Then Begin 407 | p := copy(aSizeString, 1, index - 1); 408 | delete(aSizeString, 1, index); 409 | s := copy(aSizeString, 1, length(aSizeString) - 2); 410 | delete(aSizeString, 1, Length(aSizeString) - 2); 411 | End 412 | Else Begin 413 | p := copy(aSizeString, 1, length(aSizeString) - 2); 414 | delete(aSizeString, 1, Length(aSizeString) - 2); 415 | End; 416 | If Length(aSizeString) <> 2 Then exit; 417 | scale := 1; 418 | While aSizeString[1] In ['K', 'M', 'G', 'T', 'P'] Do Begin 419 | scale := scale * 1024; 420 | Case aSizeString[1] Of 421 | 'K': aSizeString[1] := ' '; 422 | 'M': aSizeString[1] := 'K'; 423 | 'G': aSizeString[1] := 'M'; 424 | 'T': aSizeString[1] := 'G'; 425 | 'P': aSizeString[1] := 'T'; 426 | End; 427 | End; 428 | result := strtointdef(p, 0) * scale + strtointdef(s, 0) * (scale Div 1024); 429 | End; 430 | End; 431 | 432 | Function Comp(Const a, b: TListitem): Boolean; 433 | Begin 434 | result := false; 435 | Case aItem Of 436 | 0: result := lowercase(a.caption) < lowercase(b.Caption); 437 | 1: result := lowercase(a.SubItems[0]) < lowercase(b.SubItems[0]); 438 | 2: result := SizeToInt(a.SubItems[1]) < SizeToInt(b.SubItems[1]); 439 | End; 440 | If adir Then result := Not result; 441 | End; 442 | 443 | Var 444 | item, item2: TListitem; 445 | b: Boolean; 446 | i: Integer; 447 | Begin 448 | // Bubblesort, ist nicht gerade schnell, dafür aber ordnungsverträglich. 449 | b := True; 450 | While b Do Begin 451 | b := false; 452 | For i := aFrom + 1 To aTo Do Begin 453 | item := listview.Items[i]; 454 | item2 := listview.Items[i - 1]; 455 | If comp(Item, Item2) Then Begin 456 | listview.Items[i] := item2; 457 | listview.Items[i - 1] := item; 458 | b := true; 459 | End; 460 | End; 461 | dec(aTo); 462 | End; 463 | End; 464 | 465 | (* 466 | Wir machen alles von Hand. 467 | 0 = Name soll die Verzeichniss, und Dateinamen Auf Absteigend sortieren. 468 | 1 = Ext, nur Dateinamen, auf absteigend. 469 | 2 = Size, nur Dateinamen, auf absteigend. 470 | *) 471 | 472 | Procedure ListviewSort(Const Listview: TListview; Order: Integer); 473 | Var 474 | i, j, k, kk: Integer; 475 | item: TListitem; 476 | Begin 477 | listview.BeginUpdate; 478 | // 1. Separieren nach Dirs / Files 479 | j := 1; 480 | k := listview.Items.count - 1; 481 | For i := 1 To listview.Items.count - 1 Do Begin 482 | item := listview.Items[i]; 483 | If item.SubItems[SubItemIndexEXT] <> '<DIR>' Then Begin 484 | k := i - 1; 485 | break; 486 | End; 487 | End; 488 | kk := k; 489 | // Das Eigentliche Sortieren 490 | // Nun sortieren wir von j - k einschlieslich -> Verzeichnisse 491 | If k > j Then Begin 492 | SortListviewFromTo(Listview, j, k, order < 3, order Mod 3); 493 | End; 494 | // Sortieren Nach Dateinamen. 495 | j := kk + 1; 496 | k := Listview.items.count - 1; 497 | // Nun sortieren wir von j - k einschlieslich -> Dateien 498 | If k > j Then Begin 499 | SortListviewFromTo(Listview, j, k, order < 3, order Mod 3); 500 | End; 501 | listview.EndUpdate; 502 | End; 503 | 504 | (* 505 | * Wählt nur den Index aIndex an (alles andere ab, aber kein Fokus) 506 | *) 507 | 508 | Procedure ListViewSelectItemIndex(Const Listview: TListView; aIndex: integer); 509 | Var 510 | Idx: Integer; 511 | Begin 512 | If aindex >= Listview.Items.Count Then exit; 513 | Listview.BeginUpdate; 514 | Listview.ClearSelection; 515 | 516 | // So hinscrollen, dass man das man den aIndex uberhaupt sehen kann 517 | Listview.Items[aIndex].MakeVisible(False); 518 | 519 | // Der Versuch den ausgewählten Eintrag ungefähr "mittig" in der Listview an zu zeigen 520 | If assigned(Listview.TopItem) Then Begin 521 | Idx := Listview.TopItem.Index + (Listview.VisibleRowCount Div 2); 522 | If aIndex <> Idx Then 523 | Idx := aIndex + (aIndex - Idx); 524 | If (Idx < 0) Then 525 | Idx := 0; 526 | If (Idx >= Listview.Items.Count) Then 527 | Idx := Listview.Items.Count - 1; 528 | Listview.Items[Idx].MakeVisible(False); 529 | End; 530 | 531 | // Der Versuch den Eintrag auch so zu selektiern dass dieser 532 | // 1. Blau hinterlegt ist 533 | // 2. Wenn der User die Pfeiltasten verwendet von diesem auch weiter "navigiert" wird 534 | Listview.Items[aIndex].Selected := true; // Das macht den Eintrag "blau" 535 | // Den Eintrag tatsächlich auch Anwählen 536 | Listview.ItemIndex := aIndex; 537 | Listview.Selected := Listview.Items[aIndex]; 538 | Listview.ItemFocused := Listview.Items[aIndex]; 539 | Listview.EndUpdate; 540 | End; 541 | 542 | (* 543 | * Sucht in Listview den eintrag aIndex und wählt diesen aus (aber kein Fokus). 544 | *) 545 | 546 | Procedure ListViewSelectItem(Const Listview: TListView; aIndex: String); 547 | Var 548 | i: integer; 549 | Begin 550 | For i := 1 To Listview.Items.Count - 1 Do Begin 551 | If Listview.Items[i].Caption = aIndex Then Begin 552 | ListViewSelectItemIndex(Listview, i); 553 | exit; 554 | End; 555 | End; 556 | End; 557 | 558 | { TForm1 } 559 | 560 | Procedure TForm1.FormCreate(Sender: TObject); 561 | Begin 562 | (* 563 | * Historie : Siehe ganz oben 564 | *) 565 | Caption := 'Copycommander2 ver. 0.13'; 566 | (* 567 | * Mindest Anforderungen: 568 | * - Alle "Todo's" erledigt 569 | * Noch Offen: 570 | * -Kontext menü "show Size" -> Für Verzeichnisse 571 | *) 572 | finiFile := TIniFile.Create(GetAppConfigFileUTF8(false)); 573 | Width := finiFile.ReadInteger(iniGeneral, iniAppWidth, Width); 574 | Height := finiFile.ReadInteger(iniGeneral, iniAppHeight, Height); 575 | fShortCutButtons := Nil; 576 | LoadShortCutButtons; 577 | 578 | PairSplitter1.Align := alClient; 579 | Panel1.Caption := ''; 580 | Panel2.Caption := ''; 581 | 582 | fLeftView.ListView := ListView1; 583 | fLeftView.ComboBox := cbDirLeft; 584 | fLeftView.StatusBar := StatusBar1; 585 | 586 | fRightView.ListView := ListView2; 587 | fRightView.ComboBox := cbDirRight; 588 | fRightView.StatusBar := StatusBar2; 589 | startup := true; 590 | End; 591 | 592 | Procedure TForm1.FormClose(Sender: TObject; Var CloseAction: TCloseAction); 593 | Begin 594 | If fWorkThread.JobsPending Then Begin 595 | fWorkThread.OnFinishJob := Nil; // Der User Braucht auch nicht mehr sehen dass wir die Löschen 596 | fWorkThread.CancelAllJobs(); 597 | While fWorkThread.JobsPending Do Begin 598 | sleep(1); 599 | End; 600 | End; 601 | fWorkThread.Terminate; 602 | (* 603 | * theoretisch Idled der Thread im 1ms takt, d.h. nach 10ms ist er auf jeden Fall weg. 604 | *) 605 | Sleep(10); 606 | fWorkThread.free; 607 | fWorkThread := Nil; 608 | 609 | finiFile.WriteString(iniLeft, iniLastDir, cbDirLeft.text); 610 | finiFile.WriteString(iniRight, iniLastDir, cbDirRight.text); 611 | finiFile.WriteString(iniLeft, iniListDir, cbDirLeft.Items.CommaText); 612 | finiFile.WriteString(iniRight, iniListDir, cbDirRight.Items.CommaText); 613 | 614 | finiFile.WriteInteger(iniGeneral, iniAppWidth, Width); 615 | finiFile.WriteInteger(iniGeneral, iniAppHeight, Height); 616 | finiFile.Free; 617 | End; 618 | 619 | Procedure TForm1.FormCloseQuery(Sender: TObject; Var CanClose: Boolean); 620 | Begin 621 | If fWorkThread.JobsPending Then Begin 622 | If ID_NO = Application.MessageBox(pchar('File / Dir copying not yet finished.' + LineEnding + 'Are you shure you want to close, this will cancel all your jobs.'), 'Warning', MB_YESNO Or MB_ICONWARNING) Then Begin 623 | CanClose := false; 624 | End; 625 | End; 626 | End; 627 | 628 | Procedure TForm1.ApplicationProperties1Idle(Sender: TObject; Var Done: Boolean); 629 | Var 630 | j: TJob; 631 | Begin 632 | If assigned(fWorkThread) Then Begin 633 | If fWorkThread.HasErrorJobs Then Begin 634 | form4.AddErrorJob(fWorkThread.PopErrorJob()); 635 | End; 636 | If fWorkThread.HasQuestions And (Not form5.Visible) Then Begin 637 | (* 638 | * Wenn der User eine Antwort gibt, aber in der Queue sind schon mehrere Anfragen drin 639 | * klopft die App die hier alle ab und das läst sich nur verhindern wenn wir hier noch mal 640 | * explizit fragen ob es nicht doch schon ne Antwort gibt :-) 641 | *) 642 | If fWorkThread.AllResult <> jaNotChoosen Then Begin 643 | j := fWorkThread.PopQuestion(); 644 | j.Answer := fWorkThread.AllResult; 645 | AddJob(j); 646 | End 647 | Else Begin 648 | form5.ModalResult := mrNone; 649 | form5.CheckBox1.Checked := false; 650 | form5.Answer := jaNotChoosen; 651 | j := fWorkThread.TopQuestion(); 652 | form5.Label1.Caption := j.Source + LineEnding + '->' + LineEnding + j.Dest; 653 | form5.ShowModal; 654 | Case form5.Answer Of 655 | jaNotChoosen: Begin 656 | // nix da das wird in 1ms noch mal angefragt 657 | End; 658 | jaSkip: Begin 659 | j := fWorkThread.PopQuestion(); 660 | If form5.CheckBox1.Checked Then Begin 661 | j.ToAll := true; 662 | j.Answer := jaSkip; 663 | AddJob(j); 664 | End 665 | Else Begin 666 | j.free; 667 | End; 668 | End; 669 | jaReplace: Begin 670 | j := fWorkThread.PopQuestion(); 671 | j.ToAll := Form5.CheckBox1.Checked; 672 | j.Answer := jaReplace; 673 | AddJob(j); 674 | End; 675 | End; 676 | End; 677 | End; 678 | End; 679 | sleep(1); 680 | End; 681 | 682 | Procedure TForm1.btnDirLeftClick(Sender: TObject); 683 | Begin 684 | SelectDirectoryDialog1.Title := ''; 685 | If SelectDirectoryDialog1.Execute Then Begin 686 | cbDirLeft.Text := SelectDirectoryDialog1.FileName; 687 | LoadDir(cbDirLeft.text, fLeftView); 688 | End; 689 | End; 690 | 691 | Procedure TForm1.btnDirRightClick(Sender: TObject); 692 | Begin 693 | SelectDirectoryDialog1.Title := ''; 694 | If SelectDirectoryDialog1.Execute Then Begin 695 | cbDirRight.Text := SelectDirectoryDialog1.FileName; 696 | LoadDir(cbDirRight.text, fRightView); 697 | End; 698 | End; 699 | 700 | Procedure TForm1.cbDirLeftDblClick(Sender: TObject); 701 | Begin 702 | CreateShortcutL; 703 | End; 704 | 705 | Procedure TForm1.cbDirLeftKeyDown(Sender: TObject; Var Key: Word; 706 | Shift: TShiftState); 707 | Begin 708 | // STRG + S = Diff Viewer 709 | If (ssCtrl In shift) And (key = ord('S')) Then Begin 710 | DiffViewer(); 711 | exit; 712 | End; 713 | If key = VK_DOWN Then Begin 714 | If sender = cbDirLeft Then ListView1.SetFocus; 715 | If sender = cbDirRight Then ListView2.SetFocus; 716 | End; 717 | End; 718 | 719 | Procedure TForm1.cbDirLeftKeyPress(Sender: TObject; Var Key: char); 720 | Begin 721 | If Key = #13 Then Begin 722 | LoadDir(cbDirLeft.text, fLeftView); 723 | End; 724 | End; 725 | 726 | Procedure TForm1.cbDirLeftSelect(Sender: TObject); 727 | Begin 728 | LoadDir(cbDirLeft.text, fLeftView); 729 | End; 730 | 731 | Procedure TForm1.cbDirRightDblClick(Sender: TObject); 732 | Begin 733 | CreateShortcutR; 734 | End; 735 | 736 | Procedure TForm1.cbDirRightKeyDown(Sender: TObject; Var Key: Word; 737 | Shift: TShiftState); 738 | Begin 739 | // STRG + S = Diff Viewer 740 | If (ssCtrl In shift) And (key = ord('S')) Then Begin 741 | DiffViewer(); 742 | exit; 743 | End; 744 | If key = VK_DOWN Then Begin 745 | If sender = cbDirLeft Then ListView1.SetFocus; 746 | If sender = cbDirRight Then ListView2.SetFocus; 747 | End; 748 | End; 749 | 750 | Procedure TForm1.cbDirRightKeyPress(Sender: TObject; Var Key: char); 751 | Begin 752 | If Key = #13 Then Begin 753 | LoadDir(cbDirRight.Text, fRightView); 754 | End; 755 | End; 756 | 757 | Procedure TForm1.cbDirRightSelect(Sender: TObject); 758 | Begin 759 | LoadDir(cbDirRight.Text, fRightView); 760 | End; 761 | 762 | Procedure TForm1.FormActivate(Sender: TObject); 763 | Var 764 | ds, s: String; 765 | Begin 766 | // Laden der Letzten Verzeichnisse 767 | If startup Then Begin 768 | startup := false; // do it only once 769 | // Laden der Letzten Verzeichnisse 770 | ds := GetUserDir; 771 | // Laden der Drop-Down-Listen 772 | cbDirLeft.Items.AddCommaText(finiFile.ReadString(iniLeft, iniListDir, '')); 773 | cbDirRight.Items.AddCommaText(finiFile.ReadString(iniRight, iniListDir, '')); 774 | 775 | If ParamCount >= 1 Then Begin 776 | s := ParamStr(1) 777 | End 778 | Else Begin 779 | s := finiFile.ReadString(iniLeft, iniLastDir, ds); 780 | End; 781 | If Not DirectoryExists(s) Then Begin 782 | s := ds; 783 | End; 784 | LoadDir(s, fLeftView); 785 | If ParamCount > 1 Then Begin 786 | s := ParamStr(2) 787 | End 788 | Else 789 | s := finiFile.ReadString(iniRight, iniLastDir, ds); 790 | If Not DirectoryExists(s) Then Begin 791 | s := ds; 792 | End; 793 | LoadDir(s, fRightView); 794 | fWorkThread := TWorkThread.create(true); 795 | fWorkThread.FreeOnTerminate := false; 796 | fWorkThread.OnByteTransfereStatistic := @OnByteTransfereStatistic; 797 | fWorkThread.OnStartJob := @OnStartJob; 798 | fWorkThread.OnFinishJob := @OnFinishJob; 799 | fWorkThread.OnFileCopyProgress := @OnFileCopyProgress; 800 | fWorkThread.OnAddSubJobs := @OnAddSubJobs; 801 | fWorkThread.Start; 802 | End; 803 | End; 804 | 805 | Procedure TForm1.FormDropFiles(Sender: TObject; Const FileNames: Array Of String 806 | ); 807 | Var 808 | s: String; 809 | t: TControl; 810 | aListview: TListView; 811 | aView: PView; 812 | job: TJob; 813 | i: Integer; 814 | Begin 815 | // Auf welche Listview wurde gedropt ? 816 | aListview := Nil; 817 | t := FindControlAtPosition(Mouse.CursorPos, true); 818 | If t Is TListview Then Begin 819 | If t = ListView1 Then Begin 820 | aListview := ListView1; 821 | aView := @fLeftView; 822 | End; 823 | If t = ListView2 Then Begin 824 | aListview := ListView2; 825 | aView := @fRightView; 826 | End; 827 | End; 828 | If Not assigned(aListview) Then exit; 829 | If high(Filenames) = 0 Then Begin 830 | // Wenn es nur eine File ist, dann schalten wir um, 831 | s := IncludeTrailingBackslash(ExtractFilePath(Filenames[0])); 832 | LoadDir(s, aView^); 833 | End 834 | Else Begin 835 | // Wenn es mehrere Files sind, dann kopieren wir sie in den entsprechenden Ordner. 836 | For i := 0 To high(filenames) Do Begin 837 | job := TJob.Create; 838 | job.Dest := aView^.aDirectory; 839 | job.Source := filenames[i]; 840 | If DirectoryExistsutf8(filenames[i]) Then Begin 841 | job.JobType := jtCopyDir; 842 | End 843 | Else Begin 844 | job.JobType := jtCopyFile; 845 | job.Dest := job.Dest + ExtractFileName(job.Source); 846 | End; 847 | AddJob(job); 848 | End; 849 | End; 850 | End; 851 | 852 | Procedure TForm1.ListView1ColumnClick(Sender: TObject; Column: TListColumn); 853 | Begin 854 | // Links Sortieren 855 | (* 856 | Wir machen alles von Hand. 857 | 0 = Name soll die Verzeichniss, und Dateinamen Auf Absteigend sortieren. 858 | 1 = Ext, nur Dateinamen, auf absteigend. 859 | 2 = Size, nur Dateinamen, auf absteigend. 860 | *) 861 | If Column.Caption = 'Name' Then Begin 862 | If fLeftView.sortstate Mod 3 <> 0 Then 863 | fLeftView.sortstate := 0; 864 | ListviewSort(Listview1, fLeftView.sortstate); 865 | fLeftView.sortstate := (fLeftView.sortstate + 3) Mod 6; 866 | End; 867 | If Column.Caption = 'Ext' Then Begin 868 | If fLeftView.sortstate Mod 3 <> 1 Then 869 | fLeftView.sortstate := 1; 870 | ListviewSort(Listview1, fLeftView.sortstate); 871 | fLeftView.sortstate := (fLeftView.sortstate + 3) Mod 6; 872 | End; 873 | If Column.Caption = 'Size' Then Begin 874 | If fLeftView.sortstate Mod 3 <> 2 Then 875 | fLeftView.sortstate := 2; 876 | ListviewSort(Listview1, fLeftView.sortstate); 877 | fLeftView.sortstate := (fLeftView.sortstate + 3) Mod 6; 878 | End; 879 | End; 880 | 881 | Procedure TForm1.ListView2ColumnClick(Sender: TObject; Column: TListColumn); 882 | Begin 883 | // Rechts Sortieren 884 | (* 885 | Wir machen alles von Hand. 886 | 0 = Name soll die Verzeichniss, und Dateinamen Auf Absteigend sortieren. 887 | 1 = Ext, nur Dateinamen, auf absteigend. 888 | 2 = Size, nur Dateinamen, auf absteigend. 889 | *) 890 | If Column.Caption = 'Name' Then Begin 891 | If fRightView.sortstate Mod 3 <> 0 Then 892 | fRightView.sortstate := 0; 893 | ListviewSort(Listview2, fRightView.sortstate); 894 | fRightView.sortstate := (fRightView.sortstate + 3) Mod 6; 895 | End; 896 | If Column.Caption = 'Ext' Then Begin 897 | If fRightView.sortstate Mod 3 <> 1 Then 898 | fRightView.sortstate := 1; 899 | ListviewSort(Listview2, fRightView.sortstate); 900 | fRightView.sortstate := (fRightView.sortstate + 3) Mod 6; 901 | End; 902 | If Column.Caption = 'Size' Then Begin 903 | If fRightView.sortstate Mod 3 <> 2 Then 904 | fRightView.sortstate := 2; 905 | ListviewSort(Listview2, fRightView.sortstate); 906 | fRightView.sortstate := (fRightView.sortstate + 3) Mod 6; 907 | End; 908 | End; 909 | 910 | Procedure TForm1.ListView1DblClick(Sender: TObject); 911 | Var 912 | Key: Word; 913 | Begin 914 | Key := VK_RETURN; 915 | ListView1KeyDown(ListView1, key, []); 916 | End; 917 | 918 | Procedure TForm1.ListView1KeyDown(Sender: TObject; Var Key: Word; 919 | Shift: TShiftState); 920 | Var 921 | i, j: Integer; 922 | u, t, s, w: String; 923 | aListview, oListview: TListView; 924 | aView, oView: PView; // !! Achtung, hier muss mit den Pointern gearbeitet werden, sonst kann LoadDir die View nicht beschreiben ! 925 | Begin 926 | (* 927 | * Liste aller Aufrufe bei denen Es Egal ist aus welcher Listbox heraus sie aufgerufen werden 928 | *) 929 | // STRG + S = Diff Viewer 930 | If (ssCtrl In shift) And (key = ord('S')) Then Begin 931 | DiffViewer(); 932 | exit; 933 | End; 934 | // Swap Left Right 935 | If (ssCtrl In shift) And (key = VK_TAB) Then Begin 936 | s := fLeftView.aDirectory; 937 | u := ''; 938 | If assigned(fLeftView.ListView.ItemFocused) Then Begin 939 | u := fLeftView.ListView.ItemFocused.Caption; 940 | End; 941 | // Links mit Rechts neu Laden 942 | t := ''; 943 | If assigned(fRightView.ListView.ItemFocused) Then Begin 944 | t := fRightView.ListView.ItemFocused.Caption; 945 | End; 946 | LoadDir(fRightView.aDirectory, fLeftView); 947 | If t <> '' Then ListViewSelectItem(fLeftView.ListView, t); 948 | // Rechts mit Links neu Laden 949 | LoadDir(s, fRightView); 950 | If u <> '' Then ListViewSelectItem(fRightView.ListView, u); 951 | exit; 952 | End; 953 | (* 954 | * Initialisieren aller Pointer damit es den OnKeyDown Code nur 1 mal gibt. 955 | *) 956 | If sender = ListView1 Then Begin 957 | aListview := ListView1; 958 | aView := @fLeftView; 959 | oListview := ListView2; 960 | oView := @fRightView; 961 | End 962 | Else Begin 963 | If sender <> ListView2 Then Begin 964 | showmessage('Bug in "TForm1.ListView1KeyDown": Pull the plug and pray.'); 965 | exit; 966 | End; 967 | aListview := ListView2; 968 | aView := @fRightView; 969 | oListview := ListView1; 970 | oView := @fLeftView; 971 | End; 972 | (* 973 | * Liste aller Command die nicht unbedingt ein Angewähltes Element benötigen 974 | *) 975 | // Wechsel in die Andere Ansicht 976 | If key = VK_TAB Then Begin 977 | oListview.SetFocus; 978 | exit; 979 | End; 980 | // STRG + A = Alles Markieren 981 | If (ssCtrl In shift) And (key = ord('A')) Then Begin 982 | For i := 1 To aListview.Items.Count - 1 Do Begin 983 | aListview.Items[i].Selected := true; 984 | End; 985 | exit; 986 | End; 987 | // STRG + R = Verzeichnis neu Laden 988 | If (ssCtrl In shift) And (key = ord('R')) Then Begin 989 | aView^.ListView.BeginUpdate; 990 | // Merken des Vorher ausgewählten eintrages, sollte dieser Existieren 991 | t := ''; 992 | If assigned(aView^.ListView.ItemFocused) Then Begin 993 | t := aView^.ListView.ItemFocused.Caption; 994 | End; 995 | aView^.ComboBox.Text := ''; 996 | LoadDir(aView^.aDirectory, aView^); 997 | If t <> '' Then ListViewSelectItem(aView^.ListView, t); 998 | aView^.ListView.EndUpdate; 999 | exit; 1000 | End; 1001 | // Selektieren via Einfügen 1002 | If key = VK_INSERT Then Begin 1003 | For i := 0 To aListview.Items.Count - 1 Do Begin 1004 | If lisFocused In aListview.Items[i].GetStates Then Begin 1005 | // TODO: Unter Linux geht das nicht :(, dafür geht SHIFT + Pfeil nach unten 1006 | j := min(i + 1, aListview.Items.Count - 1); 1007 | aListview.Items[j].Selected := true; 1008 | aListview.Items[j].MakeVisible(False); 1009 | aListview.ItemFocused := aListview.Items[j]; 1010 | aListview.Items[i].Selected := true; 1011 | break; 1012 | End; 1013 | End; 1014 | exit; 1015 | End; 1016 | // Navigation einen Ordner Hoch muss vor der Auswertung auf VK_Return stehen. 1017 | If key = VK_BACK Then Begin 1018 | aListview.ClearSelection; 1019 | aListview.Items[0].Selected := true; 1020 | key := VK_RETURN; 1021 | End; 1022 | // F2 = Rename 1023 | If key = VK_F2 Then Begin 1024 | w := ''; 1025 | For i := 0 To aListview.Items.Count - 1 Do Begin 1026 | If aListview.Items[i].Selected Then Begin 1027 | aListview.Items[i].Selected := false; 1028 | If aListview.Items[i].Caption = '[..]' Then Continue; 1029 | s := aListview.Items[i].caption; 1030 | If pos('(', aListview.Items[i].SubItems[SubItemIndexSize]) = 1 Then Begin 1031 | // Hier wird ein Verzeichnis umbenannt -> Muss nichts weiter gemacht werden. 1032 | End 1033 | Else Begin 1034 | // Umbenennen einer Datei 1035 | s := s + '.' + aListview.Items[i].SubItems[SubItemIndexEXT]; 1036 | End; 1037 | t := InputBox('Rename', 'Please enter name', s); 1038 | If t <> s Then Begin // Umbenennen von s nach t 1039 | (* 1040 | * Anscheinend gibt es kein RenameDirectory das geht auch so .. 1041 | *) 1042 | If RenameFileUTF8(aView^.aDirectory + s, aView^.aDirectory + t) Then Begin 1043 | If pos('(', aListview.Items[i].SubItems[SubItemIndexSize]) = 1 Then Begin 1044 | // Hier wird ein Verzeichnis umbenannt 1045 | aListview.Items[i].caption := t; 1046 | End 1047 | Else Begin 1048 | // Umbenennen einer Datei 1049 | aListview.Items[i].caption := ExtractFileNameWithoutExt(t); 1050 | u := ExtractFileExt(t); 1051 | aListview.Items[i].SubItems[SubItemIndexEXT] := copy(u, 2, length(u)); 1052 | End; 1053 | // Wir merken uns den letzten umbenannten Eintrag und selektieren diesen am "ende" 1054 | w := aListview.Items[i].caption; 1055 | End; 1056 | End; 1057 | End; 1058 | End; 1059 | // Es wurde etwas umbenannt -> Die Verzeichnisse müssen neu geladen werden 1060 | If w <> '' Then Begin 1061 | // Aktualisieren der "bearbeitenden" Ansicht 1062 | LoadDir(aView^.aDirectory, aView^); 1063 | For i := 0 To aListview.Items.Count - 1 Do Begin 1064 | If aListview.Items[i].Caption = w Then Begin 1065 | ListViewSelectItemIndex(aListview, i); 1066 | break; 1067 | End; 1068 | End; 1069 | aView^.ListView.SetFocus; // Da ein anderer Dialog aufgegangen ist muss das Listview wieder den Fokus bekommen 1070 | If oview^.aDirectory = aView^.aDirectory Then Begin // Die Andere Ansicht muss auch neu geladen werden 1071 | // Aktualisieren der "anderen" Ansicht 1072 | w := oListview.ItemFocused.Caption; 1073 | LoadDir(oView^.aDirectory, oView^); 1074 | For i := 0 To oListview.Items.Count - 1 Do Begin 1075 | If oListview.Items[i].Caption = w Then Begin 1076 | ListViewSelectItemIndex(oListview, i); 1077 | break; 1078 | End; 1079 | End; 1080 | End; 1081 | End; 1082 | exit; 1083 | End; 1084 | // F7 = Make dir 1085 | If key = VK_F7 Then Begin 1086 | {$IFDEF Linux} 1087 | // Löscht man den Key nicht, dann kommt bei einer "Händischen" Eingabe der Dialog doppelt, da scheint wohl was mit der Key weiterleitung im Argen zu sein. 1088 | key := 0; 1089 | {$ENDIF} 1090 | If aview^.aDirectory = '' Then exit; 1091 | s := InputBox('Action', 'Please enter folder name', 'New Folder'); 1092 | If s <> '' Then Begin 1093 | If ForceDirectoriesUTF8(aView^.aDirectory + s) Then Begin 1094 | LoadDir(aView^.aDirectory, aView^); 1095 | For i := 0 To aListview.Items.Count - 1 Do Begin 1096 | If aListview.Items[i].Caption = s Then Begin 1097 | ListViewSelectItemIndex(aListview, i); 1098 | aListview.SetFocus; 1099 | break; 1100 | End; 1101 | End; 1102 | // Wenn Beide seiten das gleiche anzeigen, dann sollte die Andere Ansicht natürlich auch neu geladen werden .. 1103 | If oView^.aDirectory = aView^.aDirectory Then Begin 1104 | LoadDir(oView^.aDirectory, oView^); 1105 | End; 1106 | End 1107 | Else Begin 1108 | showmessage('Error, unable to create: ' + s); 1109 | End; 1110 | End; 1111 | exit; 1112 | End; 1113 | (* 1114 | * Für alles was jetzt kommt muss mindestens 1 Datensatz angewählt sein. 1115 | *) 1116 | If (aListview.SelCount = 0) Then Begin 1117 | exit; 1118 | End; 1119 | // Navigation mittels Return 1120 | If key = VK_RETURN Then Begin 1121 | // Ein Verzeichnis wird geöffnet 1122 | If aListview.Selected.SubItems[SubItemIndexEXT] = '<DIR>' Then Begin 1123 | // Ein Ordner Zurück 1124 | If aListview.Selected.caption = '[..]' Then Begin 1125 | s := ExcludeTrailingPathDelimiter(aView^.aDirectory); 1126 | t := ExtractFileName(s); 1127 | s := ExtractFileDir(s); 1128 | {$IFDEF Windows} 1129 | If length(aView^.aDirectory) = 3 Then Begin // Der User versucht ein Verzeichnis über c:\ zu navigieren -> Das geht natürlich nicht 1130 | LoadDir('', aView^); 1131 | ListViewSelectItemIndex(aListview, 0); 1132 | aListview.SetFocus; 1133 | exit; 1134 | End; 1135 | {$ENDIF} 1136 | LoadDir(s, aView^); 1137 | ListViewSelectItem(aListview, t); 1138 | aListview.SetFocus; 1139 | exit; 1140 | End 1141 | Else Begin 1142 | // Ein Ordner Tiefer 1143 | LoadDir(IncludeTrailingBackslash(aView^.aDirectory) + aListview.Selected.caption, aView^); 1144 | // ListViewSelectItemIndex(aListview, 0); -- Wird schon durch Load dir gemacht 1145 | aListview.SetFocus; 1146 | End; 1147 | End 1148 | Else Begin 1149 | {$IFDEF Windows} 1150 | If aListview.Selected.SubItems[SubItemIndexEXT] = '<DRIVE>' Then Begin 1151 | LoadDir(aListview.Selected.Caption, aView^); 1152 | ListViewSelectItemIndex(aListview, 0); 1153 | aListview.SetFocus; 1154 | exit; 1155 | End 1156 | Else Begin 1157 | {$ENDIF} 1158 | // Eine oder mehrere Dateien müssen auf die Kopierliste. 1159 | For i := 0 To aListview.items.count - 1 Do 1160 | If aListview.Items[i].Selected Then Begin 1161 | aListview.Items[i].Selected := false; 1162 | CreateAndAddJob(aListview.Items[i], jsCopy, aView^.aDirectory, oView^.aDirectory); 1163 | End; 1164 | {$IFDEF Windows} 1165 | End; 1166 | {$ENDIF} 1167 | End; 1168 | End; 1169 | // F5 = Copy 1170 | If key = VK_F5 Then Begin 1171 | If (aview^.aDirectory = '') Or (oView^.aDirectory = '') Then exit; 1172 | For i := 0 To aListview.items.count - 1 Do 1173 | If aListview.Items[i].Selected Then Begin 1174 | aListview.Items[i].Selected := false; 1175 | CreateAndAddJob(aListview.Items[i], jsCopy, aView^.aDirectory, oView^.aDirectory); 1176 | End; 1177 | End; 1178 | // F6 = Move 1179 | If key = VK_F6 Then Begin 1180 | If (aview^.aDirectory = '') Or (oView^.aDirectory = '') Then exit; 1181 | For i := 0 To aListview.items.count - 1 Do 1182 | If aListview.Items[i].Selected Then Begin 1183 | aListview.Items[i].Selected := false; 1184 | CreateAndAddJob(aListview.Items[i], jsMove, aView^.aDirectory, oView^.aDirectory); 1185 | End; 1186 | End; 1187 | // F8 = Delete 1188 | If key = VK_F8 Then Begin 1189 | If (aview^.aDirectory = '') Or (oView^.aDirectory = '') Then exit; 1190 | For i := 0 To aListview.items.count - 1 Do 1191 | If aListview.Items[i].Selected Then Begin 1192 | aListview.Items[i].Selected := false; 1193 | CreateAndAddJob(aListview.Items[i], jsDel, aView^.aDirectory, ''); 1194 | End; 1195 | End; 1196 | End; 1197 | 1198 | Procedure TForm1.ListView2DblClick(Sender: TObject); 1199 | Var 1200 | Key: Word; 1201 | Begin 1202 | Key := VK_RETURN; 1203 | ListView1KeyDown(ListView2, key, []); 1204 | End; 1205 | 1206 | Procedure TForm1.MenuItem12Click(Sender: TObject); 1207 | Var 1208 | key: word; 1209 | Begin 1210 | // Swap Left Right 1211 | key := VK_TAB; 1212 | ListView1KeyDown(Nil, key, [ssCtrl]); 1213 | End; 1214 | 1215 | Procedure TForm1.MenuItem14Click(Sender: TObject); 1216 | Var 1217 | key: word; 1218 | Begin 1219 | // Move Left -> Right 1220 | key := VK_F6; 1221 | ListView1KeyDown(ListView1, key, []); 1222 | End; 1223 | 1224 | Procedure TForm1.MenuItem15Click(Sender: TObject); 1225 | Var 1226 | key: word; 1227 | Begin 1228 | // Make Dir Left 1229 | key := VK_F7; 1230 | ListView1KeyDown(ListView1, key, []); 1231 | End; 1232 | 1233 | Procedure TForm1.MenuItem16Click(Sender: TObject); 1234 | Var 1235 | key: word; 1236 | Begin 1237 | // Move Right -> Left 1238 | key := VK_F6; 1239 | ListView1KeyDown(ListView2, key, []); 1240 | End; 1241 | 1242 | Procedure TForm1.MenuItem17Click(Sender: TObject); 1243 | Var 1244 | key: word; 1245 | Begin 1246 | // Make Dir Right 1247 | key := VK_F7; 1248 | ListView1KeyDown(ListView2, key, []); 1249 | End; 1250 | 1251 | Procedure TForm1.MenuItem23Click(Sender: TObject); 1252 | Begin 1253 | cbDirLeft.Items.Clear; 1254 | End; 1255 | 1256 | Procedure TForm1.MenuItem24Click(Sender: TObject); 1257 | Begin 1258 | cbDirRight.Items.Clear; 1259 | End; 1260 | 1261 | Procedure TForm1.mnCreateShortcutLClick(Sender: TObject); 1262 | Begin 1263 | CreateShortcutL; 1264 | End; 1265 | 1266 | Procedure TForm1.CreateShortCutL; // Create shortcut button on left panel 1267 | Var 1268 | cnt: Integer; 1269 | LinkName: String; 1270 | Begin 1271 | // Add Actual folder as Shortcut Button (Links) 1272 | If DirectoryExistsUTF8(cbDirLeft.Text) Then Begin 1273 | LinkName := InputBox('Question', 'Please enter a label for: ' + cbDirLeft.text, ''); 1274 | If LinkName = '' Then Begin 1275 | Showmessage('Invalid label.'); 1276 | exit; 1277 | End; 1278 | cnt := finiFile.ReadInteger(iniGeneral, iniShortcutButtonCount, 0); 1279 | finiFile.WriteInteger(iniGeneral, iniShortcutButtonCount, cnt + 1); 1280 | finiFile.WriteString(iniBtn, iniCaption + inttostr(cnt), LinkName); 1281 | finiFile.WriteString(iniBtn, iniLink + inttostr(cnt), cbDirleft.Text); 1282 | finiFile.WriteString(iniBtn, iniPosition + inttostr(cnt), iniLeft); 1283 | LoadShortCutButtons(); 1284 | End; 1285 | End; 1286 | 1287 | {2022-02-20 Added: Copy shortcut button to the other side [h-elsner]} 1288 | 1289 | Procedure TForm1.mnCopyBtnClick(Sender: TObject); 1290 | Begin 1291 | CopyShortcut; 1292 | End; 1293 | 1294 | Procedure TForm1.CopyShortcut; 1295 | Var 1296 | cnt: Integer; 1297 | psn: String; 1298 | 1299 | Begin 1300 | // Copy shortcut button to the other side 1301 | cnt := finiFile.ReadInteger(iniGeneral, iniShortcutButtonCount, 0); 1302 | finiFile.WriteInteger(iniGeneral, iniShortcutButtonCount, cnt + 1); 1303 | psn := finiFile.ReadString(iniBtn, iniPosition + IntToStr(fButtonPopupTag), iniLeft); 1304 | If psn = iniRight Then Begin 1305 | finiFile.WriteString(iniBtn, iniPosition + IntToStr(cnt), iniLeft); // to the other side 1306 | End 1307 | Else Begin 1308 | finiFile.WriteString(iniBtn, iniPosition + IntToStr(cnt), iniRight); 1309 | End; 1310 | finiFile.WriteString(iniBtn, iniCaption + inttostr(cnt), finiFile.ReadString(iniBtn, iniCaption + IntToStr(fButtonPopupTag), psn)); 1311 | finiFile.WriteString(iniBtn, iniLink + inttostr(cnt), finiFile.ReadString(iniBtn, iniLink + IntToStr(fButtonPopupTag), cbDirLeft.Text)); 1312 | LoadShortCutButtons(); 1313 | End; 1314 | 1315 | Procedure TForm1.mnCreateShortcutRClick(Sender: TObject); 1316 | Begin 1317 | CreateShortcutR; 1318 | End; 1319 | 1320 | Procedure TForm1.CreateShortcutR; // Create schortcut button on right panel 1321 | Var 1322 | cnt: Integer; 1323 | LinkName: String; 1324 | Begin 1325 | // Add Actual folder as Shortcut Button (Rechts) 1326 | If DirectoryExistsUTF8(cbDirRight.Text) Then Begin 1327 | LinkName := InputBox('Question', 'Please enter a label for: ' + cbDirRight.text, ''); 1328 | If LinkName = '' Then Begin 1329 | Showmessage('Invalid label.'); 1330 | exit; 1331 | End; 1332 | cnt := finiFile.ReadInteger(iniGeneral, iniShortcutButtonCount, 0); 1333 | finiFile.WriteInteger(iniGeneral, iniShortcutButtonCount, cnt + 1); 1334 | finiFile.WriteString(iniBtn, iniCaption + inttostr(cnt), LinkName); 1335 | finiFile.WriteString(iniBtn, iniLink + inttostr(cnt), cbDirRight.Text); 1336 | finiFile.WriteString(iniBtn, iniPosition + inttostr(cnt), iniRight); 1337 | LoadShortCutButtons(); 1338 | End; 1339 | End; 1340 | 1341 | Procedure TForm1.MenuItem19Click(Sender: TObject); 1342 | Var 1343 | key: word; 1344 | Begin 1345 | // Diff Viewer 1346 | key := ord('S'); 1347 | ListView1KeyDown(ListView2, key, [ssCtrl]); 1348 | End; 1349 | 1350 | Procedure TForm1.MenuItem2Click(Sender: TObject); 1351 | Var 1352 | key: word; 1353 | Begin 1354 | // Copy Left -> Right 1355 | key := VK_F5; 1356 | ListView1KeyDown(ListView1, key, []); 1357 | End; 1358 | 1359 | Procedure TForm1.MenuItem4Click(Sender: TObject); 1360 | Begin 1361 | // Show Progres Window 1362 | Form2.CheckBox1.Checked := true; 1363 | form2.Show; 1364 | End; 1365 | 1366 | Procedure TForm1.MenuItem5Click(Sender: TObject); 1367 | Var 1368 | key: word; 1369 | Begin 1370 | // Reload Directory 1371 | key := ord('R'); 1372 | ListView1KeyDown(ListView1, key, [ssCtrl]); 1373 | End; 1374 | 1375 | Procedure TForm1.MenuItem6Click(Sender: TObject); 1376 | Var 1377 | key: word; 1378 | Begin 1379 | // Delete Selection Left 1380 | key := VK_F8; 1381 | ListView1KeyDown(ListView1, key, []); 1382 | End; 1383 | 1384 | Procedure TForm1.MenuItem7Click(Sender: TObject); 1385 | Var 1386 | key: word; 1387 | Begin 1388 | // Reload Directory 1389 | key := ord('R'); 1390 | ListView1KeyDown(ListView2, key, [ssCtrl]); 1391 | End; 1392 | 1393 | Procedure TForm1.MenuItem8Click(Sender: TObject); 1394 | Var 1395 | key: word; 1396 | Begin 1397 | // Copy Right -> Left 1398 | key := VK_F5; 1399 | ListView1KeyDown(ListView2, key, []); 1400 | End; 1401 | 1402 | Procedure TForm1.MenuItem9Click(Sender: TObject); 1403 | Var 1404 | key: word; 1405 | Begin 1406 | // Delete Right 1407 | key := VK_F8; 1408 | ListView1KeyDown(ListView2, key, []); 1409 | End; 1410 | 1411 | Procedure TForm1.mnFilemanagerLClick(Sender: TObject); 1412 | Begin 1413 | If cbDirLeft.Text <> '' Then Begin 1414 | OpenDocument(IncludeTrailingPathDelimiter(cbDirLeft.Text)); 1415 | End; 1416 | End; 1417 | 1418 | Procedure TForm1.mnFileManagerRClick(Sender: TObject); 1419 | Begin 1420 | If cbDirRight.Text <> '' Then Begin 1421 | OpenDocument(IncludeTrailingPathDelimiter(cbDirRight.Text)); 1422 | End; 1423 | End; 1424 | 1425 | Procedure TForm1.mnMoveShortcutClick(Sender: TObject); // Move shortcut button to the other panel 1426 | Begin 1427 | CopyShortcut; 1428 | DeleteShortcut; 1429 | End; 1430 | 1431 | Procedure TForm1.PairSplitter1Resize(Sender: TObject); 1432 | Begin 1433 | PairSplitter1.Position := PairSplitter1.Width Div 2; 1434 | End; 1435 | 1436 | Procedure TForm1.ListView1Resize(Sender: TObject); 1437 | Begin 1438 | ListView1.Columns[0].Width := ListView1.Width - ListView1.Columns[1].Width - ListView1.Columns[2].Width; 1439 | End; 1440 | 1441 | Procedure TForm1.ListView2Resize(Sender: TObject); 1442 | Begin 1443 | ListView2.Columns[0].Width := ListView2.Width - ListView2.Columns[1].Width - ListView2.Columns[2].Width; 1444 | End; 1445 | 1446 | Procedure TForm1.DiffViewer; 1447 | Var 1448 | s: String; 1449 | b: Boolean; 1450 | Key: Word; 1451 | Begin 1452 | b := fWorkThread.JobPause; 1453 | If Not b Then Begin 1454 | form2.Button3.Click; // Das Kopieren Pausieren und es auch dem User Zeigen 1455 | Sleep(100); // Dem Thread Zeit lassen sich in der Idle Schleife zu fangen 1456 | End; 1457 | s := form3.LoadDirectories(fLeftView.aDirectory, fRightView.aDirectory); 1458 | If (Not b) And (fWorkThread.JobPause) Then Begin 1459 | form2.Button3.Click; // Das Pause wieder auffheben, falls das der User noch nicht gemacht haben sollte.. 1460 | End; 1461 | If s <> '' Then Begin 1462 | ShowMessage(s); 1463 | End 1464 | Else Begin 1465 | form3.ShowModal; 1466 | // Da sich der Inhalt beider Verzeichnisse geändert haben könnte, 1467 | // laden wir diese vorsichtshalber neu 1468 | key := ord('R'); 1469 | ListView1KeyDown(ListView1, Key, [ssCtrl]); 1470 | key := ord('R'); 1471 | ListView1KeyDown(ListView2, Key, [ssCtrl]); 1472 | End; 1473 | End; 1474 | 1475 | Procedure TForm1.CreateAndAddJob(Item: TListItem; JobType: TJobSubType; 1476 | SourceDir, DestDir: String); 1477 | Var 1478 | job: TJob; 1479 | Begin 1480 | If item.Caption = '[..]' Then exit; 1481 | job := TJob.Create; 1482 | job.Source := IncludeTrailingPathDelimiter(SourceDir) + Item.Caption; 1483 | job.Dest := IncludeTrailingPathDelimiter(DestDir); 1484 | If item.SubItems[SubItemIndexEXT] = '<DIR>' Then Begin 1485 | Case JobType Of 1486 | jsCopy: job.JobType := jtCopyDir; 1487 | jsMove: job.JobType := jtMoveDir; 1488 | jsDel: job.JobType := jtDelDir; 1489 | End; 1490 | End 1491 | Else Begin 1492 | Case JobType Of 1493 | jsCopy: job.JobType := jtCopyFile; 1494 | jsMove: job.JobType := jtMoveFile; 1495 | jsDel: job.JobType := jtDelFile; 1496 | End; 1497 | job.Dest := job.Dest + Item.Caption; 1498 | // Wenn die Datei keine Endung hat auch nichts anhängen. 1499 | If Item.SubItems[SubItemIndexEXT] <> '' Then Begin 1500 | job.Source := job.Source + '.' + Item.SubItems[SubItemIndexEXT]; 1501 | job.Dest := job.Dest + '.' + Item.SubItems[SubItemIndexEXT]; 1502 | End; 1503 | End; 1504 | AddJob(job); 1505 | // Wenn Die Jobliste eh schon sichtbar ist, dann zeigen wir, das wir sie Aktualisiert haben ;) 1506 | If Form2.Visible Then Begin 1507 | Form2.BringToFront; 1508 | End; 1509 | End; 1510 | 1511 | Procedure TForm1.AddJob(Const Job: TJob); 1512 | Var 1513 | n: TTreeNode; 1514 | Begin 1515 | // Anzeigen in der LCL 1516 | n := form2.TreeView1.Items.Add(Nil, JobToString(job)); 1517 | n.Data := job; 1518 | form2.Invalidate; 1519 | // Aufnehmen in die Arbeiter Klasse ;) 1520 | fWorkThread.AddJob(job); 1521 | End; 1522 | 1523 | Procedure TForm1.OnByteTransfereStatistic(Sender: TObject; 1524 | Statistic: TTransfereStatistic); 1525 | Begin 1526 | (* Wird alle 1000ms durch den WorkerThread aufgerufen und gibt die Anzahl der Übertragenen Bytes seit dem Letzten mal an *) 1527 | form2.AddNewData(Statistic); 1528 | End; 1529 | 1530 | Procedure TForm1.OnStartJob(Sender: TObject; Job: TJob); 1531 | //Var 1532 | // f: textfile; 1533 | Begin 1534 | //If FileExists('Logfile.txt') Then Begin 1535 | // AssignFile(f, 'Logfile.txt'); 1536 | // Append(f); 1537 | //End 1538 | //Else Begin 1539 | // AssignFile(f, 'Logfile.txt'); 1540 | // Rewrite(f); 1541 | //End; 1542 | //WriteLn(f, job.Dest + ' -> ' + job.Dest); 1543 | //CloseFile(f); 1544 | 1545 | (* Wird jedes mal aufgerufen, wenn ein Job gestartet wird *) 1546 | form2.ProgressBar1.Position := 0; 1547 | Case job.JobType Of 1548 | jtCopyDir, jtCopyFile: form2.Label2.Caption := 'Copy: ' + ExtractFileName(Job.Source); 1549 | jtMoveDir, jtMoveFile: form2.Label2.Caption := 'Move: ' + ExtractFileName(Job.Source); 1550 | jtDelDir, jtDelFile: form2.Label2.Caption := 'Delete: ' + ExtractFileName(Job.Source); 1551 | End; 1552 | If Not Form2.Visible Then Begin 1553 | Form2.Show; 1554 | End; 1555 | End; 1556 | 1557 | Procedure TForm1.OnFinishJob(Sender: TObject; Job: TJob); 1558 | Var 1559 | s: String; 1560 | i: Integer; 1561 | Begin 1562 | (* Wird jedes mal aufgerufen, wenn ein Job erfolgreich beendet wurde *) 1563 | Case Job.JobType Of 1564 | jtCopyFile, jtMoveFile, 1565 | jtCopyDir, jtMoveDir: Begin 1566 | s := IncludeTrailingPathDelimiter(ExtractFilePath(job.Dest)); 1567 | If s = fLeftView.aDirectory Then LoadDir(s, fLeftView); 1568 | If s = fRightView.aDirectory Then LoadDir(s, fRightView); 1569 | // Wurde die Datei Verschoben muss die Quelle auch Aktualisiert werden 1570 | If (Job.JobType In [jtMoveFile, jtMoveDir]) Then Begin 1571 | s := IncludeTrailingPathDelimiter(ExtractFilePath(job.Source)); 1572 | If s = fLeftView.aDirectory Then LoadDir(s, fLeftView); 1573 | If s = fRightView.aDirectory Then LoadDir(s, fRightView); 1574 | End; 1575 | End; 1576 | jtDelFile, jtDelDir: Begin 1577 | s := IncludeTrailingPathDelimiter(ExtractFilePath(job.Source)); 1578 | If s = fLeftView.aDirectory Then LoadDir(s, fLeftView); 1579 | If s = fRightView.aDirectory Then LoadDir(s, fRightView); 1580 | End; 1581 | End; 1582 | // Den Job aus der Jobliste austragen 1583 | For i := 0 To Form2.TreeView1.Items.Count - 1 Do Begin 1584 | If TJob(Form2.TreeView1.items[i].Data) = job Then Begin 1585 | Form2.TreeView1.items[i].Delete; 1586 | Form2.Invalidate; 1587 | break; 1588 | End; 1589 | End; 1590 | // Alles Ab gearbeitet -> Fortschrittsfenster wieder schließen ? 1591 | form2.Label2.Caption := '-'; 1592 | form2.ProgressBar1.Position := 0; 1593 | If (form2.TreeView1.Items.Count = 0) And (Not Form2.CheckBox1.Checked) Then Begin 1594 | form2.Hide; 1595 | End; 1596 | End; 1597 | 1598 | Procedure TForm1.OnFileCopyProgress(Sender: TObject; Const Job: TJob; 1599 | Percent: Byte); 1600 | Begin 1601 | form2.ProgressBar1.Position := Percent; 1602 | End; 1603 | 1604 | Procedure TForm1.OnAddSubJobs(Sender: TObject; Const Job: TJob; 1605 | Const SubJobs: TJobArray); 1606 | Var 1607 | i, j: Integer; 1608 | n: TTreeNode; 1609 | Begin 1610 | // 1. Suchen des Haupt Jobs 1611 | For i := 0 To Form2.TreeView1.Items.Count - 1 Do Begin 1612 | If TJob(Form2.TreeView1.Items[i].Data) = Job Then Begin 1613 | For j := 0 To high(SubJobs) Do Begin 1614 | n := Form2.TreeView1.Items.AddChild(Form2.TreeView1.Items[i], JobToString(SubJobs[j])); 1615 | n.Data := SubJobs[j]; 1616 | End; 1617 | Form2.Invalidate; 1618 | break; 1619 | End; 1620 | End; 1621 | End; 1622 | 1623 | {2022-02-20 Überarbeitete Version; Shortcut Buttons nur links oder rechts [h-elsner]} 1624 | 1625 | Procedure TForm1.LoadShortCutButtons; 1626 | Var 1627 | cnt, i: Integer; 1628 | 1629 | Begin 1630 | For i := 0 To high(fShortCutButtons) Do Begin // Delete all buttons 1631 | fShortCutButtons[i].Button.Free; 1632 | End; 1633 | cnt := finiFile.ReadInteger(iniGeneral, iniShortcutButtonCount, 0); 1634 | setlength(fShortCutButtons, cnt); 1635 | For i := 0 To high(fShortCutButtons) Do Begin // Create shortcut buttons 1636 | fShortCutButtons[i].Side := finiFile.ReadString(iniBtn, iniPosition + inttostr(i), iniLeft); 1637 | If fShortCutButtons[i].Side = iniRight Then Begin // To right panel 1638 | fShortCutButtons[i].Button := TButton.Create(Panel2); 1639 | fShortCutButtons[i].Button.Parent := Panel2; 1640 | End 1641 | Else Begin // To left panel 1642 | fShortCutButtons[i].Button := TButton.Create(Panel1); 1643 | fShortCutButtons[i].Button.Parent := Panel1; 1644 | End; 1645 | fShortCutButtons[i].Button.Name := 'ShortcutBtn' + inttostr(i); 1646 | fShortCutButtons[i].Button.Caption := finiFile.ReadString(iniBtn, iniCaption + inttostr(i), ''); 1647 | fShortCutButtons[i].Button.Tag := i; 1648 | fShortCutButtons[i].Button.top := 7; 1649 | fShortCutButtons[i].Button.left := 7 + i * fShortCutButtons[0].button.width; 1650 | fShortCutButtons[i].Button.OnClick := @OnButtonClick; 1651 | fShortCutButtons[i].Button.PopupMenu := PopupMenu5; 1652 | fShortCutButtons[i].Button.OnContextPopup := @OnButtonContextPopup; 1653 | fShortCutButtons[i].Link := finiFile.ReadString(iniBtn, iniLink + inttostr(i), ''); 1654 | End; 1655 | Panel1Resize(Panel1); 1656 | Panel2Resize(Panel2); 1657 | End; 1658 | 1659 | 1660 | {2022-02-20 Überarbeitete Version; Shortcut Buttons nur links oder rechts [h-elsner]} 1661 | 1662 | Procedure TForm1.Panel1Resize(Sender: TObject); // left panel 1663 | Var 1664 | w, n, i, p: Integer; 1665 | Begin 1666 | If high(fShortCutButtons) = -1 Then exit; 1667 | n := 0; 1668 | For i := 0 To high(fShortCutButtons) Do Begin 1669 | If fShortCutButtons[i].Side = iniLeft Then 1670 | inc(n); // Number buttons on panel 1671 | End; 1672 | If n > 0 Then Begin 1673 | w := (Panel1.width - 14) Div n; 1674 | p := 0; 1675 | For i := 0 To high(fShortCutButtons) Do Begin 1676 | If fShortCutButtons[i].Side = iniLeft Then Begin 1677 | fShortCutButtons[i].Button.width := w; 1678 | fShortCutButtons[i].Button.left := 7 + p * w; 1679 | inc(p); // Count buttons left 1680 | End; 1681 | End; 1682 | End; 1683 | End; 1684 | 1685 | {2022-02-20 Überarbeitete Version; Shortcut Buttons nur links oder rechts [h-elsner]} 1686 | 1687 | Procedure TForm1.Panel2Resize(Sender: TObject); // right panel 1688 | Var 1689 | w, n, i, p: Integer; 1690 | Begin 1691 | If high(fShortCutButtons) = -1 Then exit; 1692 | n := 0; 1693 | For i := 0 To high(fShortCutButtons) Do Begin 1694 | If fShortCutButtons[i].Side = iniRight Then 1695 | inc(n); // Number buttons on panel 1696 | End; 1697 | If n > 0 Then Begin 1698 | w := (Panel2.width - 14) Div n; 1699 | p := 0; 1700 | For i := 0 To high(fShortCutButtons) Do Begin 1701 | If fShortCutButtons[i].Side = iniRight Then Begin 1702 | fShortCutButtons[i].Button.width := w; 1703 | fShortCutButtons[i].Button.left := 7 + p * w; 1704 | inc(p); // Count buttons right 1705 | End; 1706 | End; 1707 | End; 1708 | End; 1709 | 1710 | {2022-02-20 Überarbeitete Version; Shortcut Buttons nur links oder rechts [h-elsner]} 1711 | 1712 | Procedure TForm1.OnButtonClick(Sender: TObject); 1713 | Begin 1714 | If fShortCutButtons[TButton(sender).Tag].Side = iniRight Then Begin 1715 | LoadDir(fShortCutButtons[TButton(sender).Tag].Link, fRightView) 1716 | End 1717 | Else Begin // left side is default 1718 | LoadDir(fShortCutButtons[TButton(sender).Tag].Link, fLeftView); 1719 | End; 1720 | End; 1721 | 1722 | Procedure TForm1.OnButtonContextPopup(Sender: TObject; MousePos: TPoint; 1723 | Var Handled: Boolean); 1724 | Begin 1725 | fButtonPopupTag := TButton(sender).Tag; 1726 | End; 1727 | 1728 | {2022-02-20 Überarbeitete Version; Shortcut Buttons nur links oder rechts [h-elsner]} 1729 | 1730 | Procedure TForm1.mnDeleteShortcutClick(Sender: TObject); 1731 | Begin 1732 | DeleteShortcut; 1733 | End; 1734 | 1735 | Procedure TForm1.DeleteShortcut; 1736 | Var 1737 | cnt, i: Integer; 1738 | Begin 1739 | // Delete Shortcutbutton Entry 1740 | cnt := finiFile.ReadInteger('General', 'ShortcutButtonCount', 0); 1741 | For i := fButtonPopupTag To cnt - 1 Do Begin // Set new button number above the button to be deleted 1742 | finiFile.WriteString(iniBtn, iniLink + inttostr(i), finiFile.ReadString(iniBtn, iniLink + inttostr(i + 1), '')); 1743 | finiFile.WriteString(iniBtn, iniCaption + inttostr(i), finiFile.ReadString(iniBtn, iniCaption + inttostr(i + 1), '')); 1744 | finiFile.WriteString(iniBtn, iniPosition + inttostr(i), finiFile.ReadString(iniBtn, iniPosition + inttostr(i + 1), '')); 1745 | End; 1746 | finiFile.DeleteKey(iniBtn, iniLink + inttostr(cnt - 1)); 1747 | finiFile.DeleteKey(iniBtn, iniCaption + inttostr(cnt - 1)); 1748 | finiFile.DeleteKey(iniBtn, iniPosition + inttostr(cnt - 1)); 1749 | finiFile.WriteInteger(iniGeneral, iniShortcutButtonCount, cnt - 1); 1750 | 1751 | LoadShortCutButtons(); 1752 | End; 1753 | 1754 | Procedure TForm1.LoadDir(Dir: String; Var View: TView); 1755 | 1756 | (* 1757 | * Gibt die Anzahl an Elementen (Dateien / Ordner) in einem Verzeichnis zurück 1758 | *) 1759 | Function GetElemtcount(Folder: String): integer; 1760 | Var 1761 | sr: TSearchRec; 1762 | Begin 1763 | result := 0; 1764 | Folder := IncludeTrailingPathDelimiter(Folder); 1765 | If FindFirstutf8(Folder + '*', faAnyFile, SR) = 0 Then Begin 1766 | Repeat 1767 | If (SR.Attr And FaDirectory = FaDirectory) Then Begin 1768 | If (sr.Name <> '.') And (sr.Name <> '..') Then Begin 1769 | inc(result); 1770 | End; 1771 | End 1772 | Else Begin 1773 | inc(result); 1774 | End; 1775 | Until FindNextutf8(SR) <> 0; 1776 | FindCloseutf8(SR); 1777 | End; 1778 | End; 1779 | 1780 | Procedure Quick(Li, Re: integer); 1781 | Var 1782 | l, r: Integer; 1783 | p: String; 1784 | Begin 1785 | If Li < Re Then Begin 1786 | // Achtung, das Pivotelement darf nur einam vor den While schleifen ausgelesen werden, danach nicht mehr !! 1787 | p := lowercase(View.ListView.Items[Trunc((li + re) / 2)].Caption); // Auslesen des Pivo Elementes 1788 | l := Li; 1789 | r := re; 1790 | While l < r Do Begin 1791 | While CompareStr(lowercase(View.ListView.Items[l].Caption), p) < 0 Do 1792 | inc(l); 1793 | While CompareStr(lowercase(View.ListView.Items[r].Caption), p) > 0 Do 1794 | dec(r); 1795 | If L <= R Then Begin 1796 | If l <> r Then Begin 1797 | View.ListView.Items.Exchange(l, r); 1798 | End; 1799 | inc(l); 1800 | dec(r); 1801 | End; 1802 | End; 1803 | quick(li, r); 1804 | quick(l, re); 1805 | End; 1806 | End; 1807 | 1808 | Var 1809 | s: String; 1810 | sr: TSearchRec; 1811 | item: TListItem; 1812 | StartOfFiles, i, FileCount, DirectoryCount: integer; 1813 | TotalFileSize: Int64; 1814 | {$IFDEF Windows} 1815 | sl: TStringList; 1816 | {$ENDIF} 1817 | Begin 1818 | DirectoryCount := 0; 1819 | FileCount := 0; 1820 | View.ListView.Clear; 1821 | View.ComboBox.Text := dir; 1822 | View.sortstate := 0; 1823 | TotalFileSize := 0; 1824 | {$IFDEF Windows} 1825 | If (dir) <> '' Then Begin 1826 | {$ENDIF} 1827 | Dir := IncludeTrailingPathDelimiter(dir); 1828 | View.aDirectory := Dir; 1829 | If Not DirectoryExistsUTF8(Dir) Then Begin 1830 | view.StatusBar.Panels[0].Text := inttostr(DirectoryCount) + ' Folders, ' + inttostr(FileCount) + ' Files (' + FileSizeToString(TotalFileSize) + ')'; 1831 | showmessage('Warning: "' + dir + '" does not exist.'); 1832 | exit; //-- Da ist was Komisch, das ignorieren wir mal lieber 1833 | End; 1834 | UpdateComboboxHistory(View.ComboBox, maxDirs); 1835 | View.ListView.BeginUpdate; 1836 | // Verzeichniss zurück 1837 | item := View.ListView.items.add; 1838 | item.Caption := '[..]'; 1839 | item.ImageIndex := ImageIndexBack; 1840 | item.SubItems.add('<DIR>'); 1841 | item.SubItems.add(''); 1842 | // Alle Verzeichnisse 1843 | If FindFirstutf8(dir + '*', faAnyFile, SR) = 0 Then Begin 1844 | Repeat 1845 | If (SR.Attr And FaDirectory = FaDirectory) Then Begin 1846 | If (sr.Name <> '.') And (sr.Name <> '..') Then Begin 1847 | item := view.listview.Items.Add; 1848 | item.Caption := sr.Name; 1849 | item.ImageIndex := ImageIndexFolder; 1850 | item.SubItems.add('<DIR>'); 1851 | item.SubItems.add(format('(%d)', [GetElemtcount(dir + sr.Name)])); 1852 | inc(DirectoryCount); 1853 | End; 1854 | End 1855 | Until FindNextutf8(SR) <> 0; 1856 | FindCloseutf8(SR); 1857 | End; 1858 | // Alle Dateien 1859 | If FindFirstutf8(dir + '*', faAnyFile, SR) = 0 Then Begin 1860 | Repeat 1861 | If (SR.Attr And FaDirectory = 0) Then Begin 1862 | If (sr.Name <> '.') And (sr.Name <> '..') Then Begin 1863 | (* 1864 | ACHTUNG dieser Code mus gleich zu dem Code in 1865 | 1866 | UpdateListView 1867 | 1868 | gehalten werden !! 1869 | *) 1870 | inc(FileCount); 1871 | item := view.listview.Items.Add; 1872 | If pos('.', sr.name) = 1 Then Begin 1873 | item.Caption := sr.Name; 1874 | item.SubItems.add(''); 1875 | End 1876 | Else Begin 1877 | item.Caption := ExtractFileNameOnly(sr.Name); 1878 | s := ExtractFileExt(sr.name); 1879 | s := copy(s, 2, length(s)); 1880 | item.SubItems.add(s); 1881 | End; 1882 | item.ImageIndex := FileTypeToIndex(s); 1883 | item.SubItems.add(FileSizeToString(sr.Size)); 1884 | TotalFileSize := TotalFileSize + sr.Size; 1885 | End; 1886 | End 1887 | Until FindNextutf8(SR) <> 0; 1888 | FindCloseutf8(SR); 1889 | End; 1890 | // Sortieren der Listview 1891 | StartOfFiles := 1; 1892 | For i := 1 To View.ListView.items.Count - 1 Do Begin 1893 | If View.ListView.items[i].SubItems[SubItemIndexEXT] <> '<DIR>' Then Begin 1894 | StartOfFiles := i; 1895 | break; 1896 | End; 1897 | End; 1898 | // Sortieren der Verzeichnisse 1 .. StartOfFiles -1 1899 | Quick(1, StartOfFiles - 1); 1900 | // Sortieren der Dateien StartOfFiles .. Ende 1901 | Quick(StartOfFiles, View.ListView.items.Count - 1); 1902 | // Ein paar User Infos ausgeben. 1903 | view.StatusBar.Panels[0].Text := inttostr(DirectoryCount) + ' Folders, ' + inttostr(FileCount) + ' Files (' + FileSizeToString(TotalFileSize) + '), Free disk space: ' + FileSizeToString(GetFreeDiskSpaceOf(Dir)); 1904 | {$IFDEF Windows} 1905 | End 1906 | Else Begin 1907 | // Der User will die Verzeichnissliste haben 1908 | View.aDirectory := ''; 1909 | View.ListView.BeginUpdate; 1910 | sl := GetAllAvailableDrives(); 1911 | For i := 0 To sl.Count - 1 Do Begin 1912 | item := view.listview.Items.Add; 1913 | item.Caption := sl[i]; 1914 | item.ImageIndex := ImageIndexHDD; 1915 | item.SubItems.add('<DRIVE>'); 1916 | item.SubItems.add(''); 1917 | inc(DirectoryCount); 1918 | End; 1919 | // Ein paar User Infos ausgeben. 1920 | view.StatusBar.Panels[0].Text := inttostr(DirectoryCount) + ' Folders, ' + inttostr(FileCount) + ' Files (' + FileSizeToString(TotalFileSize) + ')'; 1921 | sl.free; 1922 | End; 1923 | {$ENDIF} 1924 | ListViewSelectItemIndex(View.ListView, 0); 1925 | View.ListView.EndUpdate; 1926 | End; 1927 | 1928 | End. 1929 | 1930 | -------------------------------------------------------------------------------- /src/unit2.lfm: -------------------------------------------------------------------------------- 1 | object Form2: TForm2 2 | Left = 393 3 | Height = 631 4 | Top = 191 5 | Width = 999 6 | Caption = 'Form2' 7 | ClientHeight = 631 8 | ClientWidth = 999 9 | Position = poScreenCenter 10 | LCLVersion = '3.99.0.0' 11 | OnClose = FormClose 12 | OnCreate = FormCreate 13 | object Panel1: TPanel 14 | Left = 0 15 | Height = 230 16 | Top = 0 17 | Width = 999 18 | Align = alTop 19 | Caption = 'Panel1' 20 | ClientHeight = 230 21 | ClientWidth = 999 22 | TabOrder = 0 23 | object Label1: TLabel 24 | Left = 16 25 | Height = 15 26 | Top = 8 27 | Width = 40 28 | Caption = 'Aktual :' 29 | end 30 | object Label2: TLabel 31 | Left = 72 32 | Height = 15 33 | Top = 8 34 | Width = 34 35 | Caption = 'Label2' 36 | end 37 | object ProgressBar1: TProgressBar 38 | Left = 16 39 | Height = 20 40 | Top = 32 41 | Width = 969 42 | Anchors = [akTop, akLeft, akRight] 43 | TabOrder = 0 44 | end 45 | object Label3: TLabel 46 | Left = 16 47 | Height = 15 48 | Top = 88 49 | Width = 38 50 | Caption = 'Speed :' 51 | end 52 | object Label4: TLabel 53 | Left = 72 54 | Height = 15 55 | Top = 88 56 | Width = 34 57 | Caption = 'Label4' 58 | end 59 | object Chart1: TChart 60 | Left = 2 61 | Height = 101 62 | Top = 112 63 | Width = 996 64 | AxisList = < 65 | item 66 | Marks.LabelBrush.Style = bsClear 67 | Minors = <> 68 | Title.LabelFont.Orientation = 900 69 | Title.LabelBrush.Style = bsClear 70 | OnMarkToText = Chart1AxisList0MarkToText 71 | end 72 | item 73 | Alignment = calBottom 74 | Marks.LabelBrush.Style = bsClear 75 | Minors = <> 76 | Title.LabelBrush.Style = bsClear 77 | OnMarkToText = Chart1AxisList1MarkToText 78 | end> 79 | Foot.Brush.Color = clForm 80 | Title.Brush.Color = clForm 81 | Title.Text.Strings = ( 82 | 'TAChart' 83 | ) 84 | Anchors = [akTop, akLeft, akRight, akBottom] 85 | object Chart1LineSeries1: TLineSeries 86 | end 87 | object Chart1LineSeries2: TLineSeries 88 | end 89 | end 90 | object Label5: TLabel 91 | Left = 16 92 | Height = 15 93 | Top = 215 94 | Width = 34 95 | Anchors = [akLeft, akBottom] 96 | Caption = 'Label5' 97 | end 98 | object ProgressBar2: TProgressBar 99 | Left = 16 100 | Height = 20 101 | Top = 56 102 | Width = 969 103 | Anchors = [akTop, akLeft, akRight] 104 | TabOrder = 2 105 | end 106 | end 107 | object Panel2: TPanel 108 | Left = 0 109 | Height = 60 110 | Top = 571 111 | Width = 999 112 | Align = alBottom 113 | Caption = 'Panel2' 114 | ClientHeight = 60 115 | ClientWidth = 999 116 | TabOrder = 1 117 | object Button1: TButton 118 | Left = 16 119 | Height = 25 120 | Top = 24 121 | Width = 121 122 | Caption = 'Delete Job' 123 | TabOrder = 0 124 | OnClick = Button1Click 125 | end 126 | object Button2: TButton 127 | Left = 864 128 | Height = 25 129 | Top = 24 130 | Width = 121 131 | Anchors = [akTop, akRight] 132 | Caption = 'Cancel all' 133 | TabOrder = 1 134 | OnClick = Button2Click 135 | end 136 | object Button3: TButton 137 | Left = 152 138 | Height = 25 139 | Top = 24 140 | Width = 699 141 | Anchors = [akTop, akLeft, akRight] 142 | Caption = 'Pause' 143 | TabOrder = 2 144 | OnClick = Button3Click 145 | end 146 | object CheckBox1: TCheckBox 147 | Left = 1 148 | Height = 19 149 | Top = 0 150 | Width = 73 151 | Caption = 'keep open' 152 | TabOrder = 3 153 | end 154 | end 155 | object StatusBar1: TStatusBar 156 | Left = 0 157 | Height = 23 158 | Top = 548 159 | Width = 999 160 | Panels = < 161 | item 162 | Width = 50 163 | end> 164 | SimplePanel = False 165 | end 166 | object Splitter1: TSplitter 167 | Cursor = crVSplit 168 | Left = 0 169 | Height = 5 170 | Top = 230 171 | Width = 999 172 | Align = alTop 173 | ResizeAnchor = akTop 174 | end 175 | object TreeView1: TTreeView 176 | Left = 8 177 | Height = 168 178 | Top = 240 179 | Width = 193 180 | TabOrder = 4 181 | end 182 | end 183 | -------------------------------------------------------------------------------- /src/unit2.pas: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* *) 3 | (* Author : Uwe Schächterle (Corpsman) *) 4 | (* *) 5 | (* This file is part of CopyCommander2 *) 6 | (* *) 7 | (* See the file license.md, located under: *) 8 | (* https://github.com/PascalCorpsman/Software_Licenses/blob/main/license.md *) 9 | (* for details about the license. *) 10 | (* *) 11 | (* It is not allowed to change or remove this text from any *) 12 | (* source file of the project. *) 13 | (* *) 14 | (******************************************************************************) 15 | Unit Unit2; 16 | 17 | {$MODE ObjFPC}{$H+} 18 | 19 | Interface 20 | 21 | Uses 22 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, 23 | ComCtrls, TAGraph, TASeries, ucopycommander; 24 | 25 | Type 26 | 27 | { TForm2 } 28 | 29 | TForm2 = Class(TForm) 30 | Button1: TButton; 31 | Button2: TButton; 32 | Button3: TButton; 33 | Chart1: TChart; 34 | Chart1LineSeries1: TLineSeries; 35 | Chart1LineSeries2: TLineSeries; 36 | CheckBox1: TCheckBox; 37 | Label1: TLabel; 38 | Label2: TLabel; 39 | Label3: TLabel; 40 | Label4: TLabel; 41 | Label5: TLabel; 42 | Panel1: TPanel; 43 | Panel2: TPanel; 44 | ProgressBar1: TProgressBar; 45 | ProgressBar2: TProgressBar; 46 | Splitter1: TSplitter; 47 | StatusBar1: TStatusBar; 48 | TreeView1: TTreeView; 49 | Procedure Button1Click(Sender: TObject); 50 | Procedure Button2Click(Sender: TObject); 51 | Procedure Button3Click(Sender: TObject); 52 | Procedure Chart1AxisList0MarkToText(Var AText: String; AMark: Double); 53 | Procedure Chart1AxisList1MarkToText(Var AText: String; AMark: Double); 54 | Procedure FormClose(Sender: TObject; Var CloseAction: TCloseAction); 55 | Procedure FormCreate(Sender: TObject); 56 | private 57 | fTPBufferSum: QWord; 58 | fTPBuffer: Array[0..9] Of QWord; 59 | fTPBuffer_ptr: integer; 60 | public 61 | Procedure AddNewData(Const Statistic: TTransfereStatistic); 62 | End; 63 | 64 | Var 65 | Form2: TForm2; 66 | 67 | Implementation 68 | 69 | {$R *.lfm} 70 | 71 | Uses unit1, math; 72 | 73 | 74 | (* 75 | * Formatiert TimeInmS als möglich hübsche Zeiteinheit 76 | * 77 | * 0ms bis x Tage [ Jahre werden nicht unterstützt da sonst schaltjahre und ettliches mehr berücksichtigt werden müssen 78 | * 0 => 0ms 79 | * 500 => 500ms 80 | * 1000 => 1s 81 | * 1500 => 1,5s 82 | * 65000 => 1:05min 83 | * 80000 => 1:20min 84 | * 3541000 => 59:01min 85 | * 3600000 => 1h 86 | * 3660000 => 1:01h 87 | * 86400000 => 1d 88 | * 129600000 => 1d 12h 89 | * 30762000000 => 356d 1h 90 | *) 91 | 92 | Function PrettyTime(Time_in_ms: UInt64): String; 93 | Var 94 | hs, digits, sts, sep, s: String; 95 | st, i: integer; 96 | b: Boolean; 97 | Begin 98 | s := 'ms'; 99 | hs := ''; 100 | sep := DefaultFormatSettings.DecimalSeparator; 101 | st := 0; 102 | b := false; 103 | digits := '3'; 104 | // [0 .. 60[ s 105 | If Time_in_ms >= 1000 Then Begin 106 | st := Time_in_ms Mod 1000; 107 | Time_in_ms := Time_in_ms Div 1000; 108 | s := 's'; 109 | b := true; 110 | End; 111 | // [1 .. 60[ min 112 | If (Time_in_ms >= 60) And b Then Begin 113 | st := Time_in_ms Mod 60; 114 | Time_in_ms := Time_in_ms Div 60; 115 | s := 'min'; 116 | sep := DefaultFormatSettings.TimeSeparator; 117 | digits := '2'; 118 | End 119 | Else 120 | b := false; 121 | // [1 .. 24[ h 122 | If (Time_in_ms >= 60) And b Then Begin 123 | st := Time_in_ms Mod 60; 124 | Time_in_ms := Time_in_ms Div 60; 125 | s := 'h'; 126 | End 127 | Else 128 | b := false; 129 | // [1 .. d 130 | If (Time_in_ms >= 24) And b Then Begin 131 | st := Time_in_ms Mod 24; 132 | Time_in_ms := Time_in_ms Div 24; 133 | hs := 'd'; 134 | If st <> 0 Then s := 'h'; 135 | sep := ' '; 136 | digits := '1'; 137 | End 138 | Else 139 | b := false; 140 | // Ausgabe mit oder ohne Nachkomma 141 | If st <> 0 Then Begin 142 | sts := format('%0.' + digits + 'd', [st]); 143 | If (s = 's') Then Begin // Bei Sekunden die endenden 0-en löschen 144 | For i := length(sts) Downto 1 Do Begin 145 | If sts[i] = '0' Then Begin 146 | delete(sts, i, 1); 147 | End 148 | Else Begin 149 | break; 150 | End; 151 | End; 152 | End; 153 | result := inttostr(Time_in_ms) + hs + sep + sts + s; 154 | End 155 | Else Begin 156 | result := inttostr(Time_in_ms) + s; 157 | End; 158 | End; 159 | 160 | { TForm2 } 161 | 162 | Procedure TForm2.FormCreate(Sender: TObject); 163 | Var 164 | i: Integer; 165 | Begin 166 | ProgressBar1.Position := 0; 167 | Label2.caption := ''; 168 | label4.caption := ''; 169 | Panel1.Caption := ''; 170 | Panel2.Caption := ''; 171 | TreeView1.Align := alClient; 172 | caption := 'Job Progress.'; 173 | Chart1LineSeries1.SeriesColor := clGreen; 174 | Chart1LineSeries2.SeriesColor := $00C000; 175 | For i := 0 To high(fTPBuffer) Do Begin 176 | fTPBuffer[i] := 0; 177 | End; 178 | fTPBuffer_ptr := 0; 179 | fTPBufferSum := 0; 180 | Splitter1.MinSize := Panel1.Height; 181 | End; 182 | 183 | Procedure TForm2.AddNewData(Const Statistic: TTransfereStatistic); 184 | Var 185 | TimeInmS, AvgPerS: Int64; 186 | totalpercent: UInt64; 187 | Begin 188 | Chart1LineSeries1.Add(Statistic.TransferedBytesInLast1000ms); 189 | 190 | // Tiefpass über die letzten 10s 191 | fTPBufferSum := fTPBufferSum + Statistic.TransferedBytesInLast1000ms - fTPBuffer[fTPBuffer_ptr]; 192 | fTPBuffer[fTPBuffer_ptr] := Statistic.TransferedBytesInLast1000ms; 193 | fTPBuffer_ptr := (fTPBuffer_ptr + 9) Mod length(fTPBuffer); 194 | Chart1LineSeries2.Add(fTPBufferSum / length(fTPBuffer)); 195 | AvgPerS := fTPBufferSum div length(fTPBuffer); 196 | TimeInmS := 0; 197 | If AvgPerS <> 0 Then Begin 198 | TimeInmS := 1000; // Force Calculations to be done in uint64 199 | TimeInmS := (Statistic.BytesToCopyToFinishJobs * TimeInmS) div AvgPerS; 200 | End; 201 | TimeInmS := TimeInmS - (TimeInmS Mod 1000); // die ms 0en das macht so eigentlich keinen Sinn. 202 | Label4.Caption := 'Average: ' + FileSizeToString(AvgPerS) + '/s, actual: ' + FileSizeToString(Statistic.TransferedBytesInLast1000ms) + '/s'; 203 | label5.caption := 'Progress: ' + FileSizeToString(Statistic.BytesToCopyToFinishJobs) + ' to copy, will take aprox: ' + PrettyTime(TimeInmS); 204 | // max 100 Datenpunkte 205 | If Chart1Lineseries1.Count > 100 Then Begin 206 | Chart1Lineseries1.Delete(0); 207 | Chart1Lineseries2.Delete(0); 208 | End; 209 | If Statistic.TotalJobBytes <> 0 Then Begin 210 | totalpercent := 100; // Force Calculations to be done in uint64 211 | totalpercent := (Statistic.BytesCopiedInJobs * totalpercent) Div Statistic.TotalJobBytes; 212 | ProgressBar2.Position := totalpercent; 213 | End 214 | Else Begin 215 | ProgressBar2.Position := 0; 216 | End; 217 | StatusBar1.Panels[0].Text := format('Pending jobs (subjobs): %d (%d)', [Statistic.JobsToDo, Statistic.SubJobsTodo]); 218 | End; 219 | 220 | Procedure TForm2.Button3Click(Sender: TObject); 221 | Begin 222 | If Button3.Caption = 'Pause' Then Begin 223 | Button3.Caption := 'Continue'; 224 | form1.fWorkThread.JobPause := true; 225 | End 226 | Else Begin 227 | Button3.Caption := 'Pause'; 228 | form1.fWorkThread.JobPause := false; 229 | End; 230 | End; 231 | 232 | Procedure TForm2.Button2Click(Sender: TObject); 233 | Begin 234 | form1.fWorkThread.CancelAllJobs; 235 | ProgressBar1.Position := 0; 236 | End; 237 | 238 | Procedure TForm2.Button1Click(Sender: TObject); 239 | Begin 240 | // Delete Job 241 | If TreeView1.Selected <> Nil Then Begin 242 | form1.fWorkThread.CancelJob(TJob(TJob(TreeView1.Selected.Data))); 243 | End; 244 | End; 245 | 246 | Procedure TForm2.Chart1AxisList0MarkToText(Var AText: String; AMark: Double); 247 | Begin 248 | AText := FileSizeToString(trunc(AMark)); 249 | End; 250 | 251 | Procedure TForm2.Chart1AxisList1MarkToText(Var AText: String; AMark: Double); 252 | Var 253 | x: integer; 254 | Begin 255 | // TODO: evtl könnte man hier die "Komma" werte die ganz am Anfang entstehen noch auf '' setzen 256 | x := Chart1LineSeries1.count - trunc(aMark - Chart1LineSeries1.XValue[0]); 257 | atext := inttostr(-x); 258 | End; 259 | 260 | Procedure TForm2.FormClose(Sender: TObject; Var CloseAction: TCloseAction); 261 | Begin 262 | Form2.CheckBox1.Checked := false; 263 | End; 264 | 265 | End. 266 | 267 | -------------------------------------------------------------------------------- /src/unit3.lfm: -------------------------------------------------------------------------------- 1 | object Form3: TForm3 2 | Left = 355 3 | Height = 485 4 | Top = 129 5 | Width = 632 6 | Caption = 'Form3' 7 | ClientHeight = 485 8 | ClientWidth = 632 9 | Position = poScreenCenter 10 | LCLVersion = '4.99.0.0' 11 | OnCreate = FormCreate 12 | OnResize = FormResize 13 | OnShow = FormShow 14 | object Button1: TButton 15 | Left = 548 16 | Height = 25 17 | Top = 448 18 | Width = 75 19 | Anchors = [akRight, akBottom] 20 | Caption = '&OK' 21 | TabOrder = 0 22 | OnClick = Button1Click 23 | end 24 | object Button2: TButton 25 | Left = 8 26 | Height = 25 27 | Top = 448 28 | Width = 75 29 | Anchors = [akLeft, akBottom] 30 | Caption = '&Cancel' 31 | TabOrder = 1 32 | OnClick = Button2Click 33 | end 34 | object StatusBar1: TStatusBar 35 | Left = 8 36 | Height = 24 37 | Top = 415 38 | Width = 615 39 | Align = alNone 40 | Anchors = [akLeft, akRight, akBottom] 41 | Panels = < 42 | item 43 | Width = 50 44 | end> 45 | SimplePanel = False 46 | end 47 | object StringGrid1: TStringGrid 48 | Left = 8 49 | Height = 408 50 | Top = 8 51 | Width = 615 52 | Anchors = [akTop, akLeft, akRight, akBottom] 53 | ColCount = 3 54 | Columns = < 55 | item 56 | Title.Caption = 'Title' 57 | end 58 | item 59 | Title.Caption = '' 60 | end 61 | item 62 | Title.Caption = 'Title' 63 | end> 64 | FixedCols = 0 65 | Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSelect, goSmoothScroll] 66 | PopupMenu = PopupMenu1 67 | RangeSelectMode = rsmMulti 68 | TabOrder = 3 69 | OnDrawCell = StringGrid1DrawCell 70 | OnKeyDown = StringGrid1KeyDown 71 | end 72 | object PopupMenu1: TPopupMenu 73 | Images = Form1.AppIcons 74 | Left = 312 75 | Top = 320 76 | object MenuItem1: TMenuItem 77 | Caption = 'Copy -> [R]' 78 | ImageIndex = 6 79 | OnClick = MenuItem1Click 80 | end 81 | object MenuItem3: TMenuItem 82 | Caption = 'Do nothing [N]' 83 | ImageIndex = 7 84 | OnClick = MenuItem3Click 85 | end 86 | object MenuItem2: TMenuItem 87 | Caption = 'Copy <- [L]' 88 | ImageIndex = 3 89 | OnClick = MenuItem2Click 90 | end 91 | object MenuItem6: TMenuItem 92 | Caption = '-' 93 | end 94 | object MenuItem7: TMenuItem 95 | Caption = 'Open left folder' 96 | ImageIndex = 13 97 | OnClick = MenuItem7Click 98 | end 99 | object MenuItem9: TMenuItem 100 | Caption = 'Open right folder' 101 | ImageIndex = 14 102 | OnClick = MenuItem9Click 103 | end 104 | object MenuItem8: TMenuItem 105 | Caption = '-' 106 | end 107 | object MenuItem4: TMenuItem 108 | Caption = 'Del left' 109 | ImageIndex = 16 110 | OnClick = MenuItem4Click 111 | end 112 | object MenuItem5: TMenuItem 113 | Caption = 'Del right' 114 | ImageIndex = 17 115 | OnClick = MenuItem5Click 116 | end 117 | object Separator1: TMenuItem 118 | Caption = '-' 119 | end 120 | object MenuItem11: TMenuItem 121 | Caption = 'Reload [CTRL + R]' 122 | ImageIndex = 5 123 | OnClick = MenuItem11Click 124 | end 125 | object MenuItem10: TMenuItem 126 | Caption = 'Save diff as .csv' 127 | ImageIndex = 20 128 | OnClick = MenuItem10Click 129 | end 130 | end 131 | object SaveDialog1: TSaveDialog 132 | DefaultExt = '.csv' 133 | Filter = 'Comma separated file|*.csv|All|*.*' 134 | Left = 184 135 | Top = 320 136 | end 137 | end 138 | -------------------------------------------------------------------------------- /src/unit3.pas: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* *) 3 | (* Author : Uwe Schächterle (Corpsman) *) 4 | (* *) 5 | (* This file is part of CopyCommander2 *) 6 | (* *) 7 | (* See the file license.md, located under: *) 8 | (* https://github.com/PascalCorpsman/Software_Licenses/blob/main/license.md *) 9 | (* for details about the license. *) 10 | (* *) 11 | (* It is not allowed to change or remove this text from any *) 12 | (* source file of the project. *) 13 | (* *) 14 | (******************************************************************************) 15 | Unit Unit3; 16 | 17 | {$MODE ObjFPC}{$H+} 18 | 19 | Interface 20 | 21 | Uses 22 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, StdCtrls, 23 | Menus, Grids, Types; 24 | 25 | Type 26 | 27 | tStringgridData = Record 28 | Left, Right: String; 29 | Direction: integer; 30 | End; 31 | 32 | { TForm3 } 33 | 34 | TForm3 = Class(TForm) 35 | Button1: TButton; 36 | Button2: TButton; 37 | MenuItem1: TMenuItem; 38 | MenuItem10: TMenuItem; 39 | MenuItem11: TMenuItem; 40 | MenuItem2: TMenuItem; 41 | MenuItem3: TMenuItem; 42 | MenuItem4: TMenuItem; 43 | MenuItem5: TMenuItem; 44 | MenuItem6: TMenuItem; 45 | MenuItem7: TMenuItem; 46 | MenuItem8: TMenuItem; 47 | MenuItem9: TMenuItem; 48 | PopupMenu1: TPopupMenu; 49 | SaveDialog1: TSaveDialog; 50 | Separator1: TMenuItem; 51 | StatusBar1: TStatusBar; 52 | StringGrid1: TStringGrid; 53 | Procedure Button1Click(Sender: TObject); 54 | Procedure Button2Click(Sender: TObject); 55 | Procedure FormCreate(Sender: TObject); 56 | Procedure FormResize(Sender: TObject); 57 | Procedure FormShow(Sender: TObject); 58 | Procedure MenuItem10Click(Sender: TObject); 59 | Procedure MenuItem11Click(Sender: TObject); 60 | Procedure MenuItem1Click(Sender: TObject); 61 | Procedure MenuItem2Click(Sender: TObject); 62 | Procedure MenuItem3Click(Sender: TObject); 63 | Procedure MenuItem4Click(Sender: TObject); 64 | Procedure MenuItem5Click(Sender: TObject); 65 | Procedure MenuItem7Click(Sender: TObject); 66 | Procedure MenuItem9Click(Sender: TObject); 67 | Procedure StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer; 68 | aRect: TRect; aState: TGridDrawState); 69 | Procedure StringGrid1KeyDown(Sender: TObject; Var Key: Word; 70 | Shift: TShiftState); 71 | private 72 | fLeftRootDirectory, fRightRootDirectory: String; 73 | fStringgridData: Array Of tStringgridData; 74 | Procedure UpdatePanelInfo; 75 | 76 | Procedure IterThroughAllSelected(aDirection: String); 77 | public 78 | Function LoadDirectories(LeftDir, RightDir: String): String; 79 | End; 80 | 81 | Var 82 | Form3: TForm3; 83 | 84 | Implementation 85 | 86 | {$R *.lfm} 87 | 88 | Uses LazFileUtils, ucopycommander, Unit1, lclintf, LCLType, math; 89 | 90 | Const 91 | IndexDoNothing = 7; 92 | IndexLeftToRight = 6; 93 | IndexRightToLeft = 3; 94 | 95 | Type 96 | TccFile = Record 97 | FileName: String; 98 | //LastModifiedTimeStamp: Longint; -- Das wäre Cool aber das erzeugt nur schrott, ggf kann uCopyCommander.pas (GetFileModifiedTime) das besser ? 99 | FileSize: int64; 100 | End; 101 | 102 | TccFileList = Array Of TccFile; 103 | 104 | TFilecontainer = Record 105 | Files: TccFileList; 106 | FilesPtr: Integer; // Anzahl der Gültigen Einträge in Files 107 | End; 108 | 109 | 110 | Procedure Scan(Var FileContainer: TFilecontainer; Const ScanRoot: String; adirectory: String); 111 | 112 | Procedure ProceedFind(Filename: String; FileSize: int64); 113 | Begin 114 | delete(Filename, 1, length(ScanRoot)); 115 | FileContainer.Files[FileContainer.FilesPtr].FileName := Filename; 116 | FileContainer.Files[FileContainer.FilesPtr].FileSize := FileSize; 117 | FileContainer.FilesPtr := FileContainer.FilesPtr + 1; 118 | If FileContainer.FilesPtr > high(FileContainer.Files) Then Begin 119 | setlength(FileContainer.Files, length(FileContainer.Files) + 1024); 120 | End; 121 | End; 122 | 123 | Var 124 | SR: TSearchRec; 125 | Begin 126 | adirectory := IncludeTrailingPathDelimiter(adirectory); 127 | If (FindFirstUTF8(aDirectory + '*', faAnyFile, SR) = 0) Then Begin 128 | Repeat 129 | // Dank dieser Variante sind wir case insensitiv, obwohl es das Betriebsystem eventuell ist ! 130 | If (SR.Name <> '.') And (SR.Name <> '..') And (SR.Attr And FaDirectory <> FaDirectory) Then Begin 131 | ProceedFind(aDirectory + SR.Name, sr.Size); 132 | End; 133 | (* 134 | * Rekursiver Abstieg 135 | *) 136 | If (SR.Name <> '.') And (SR.Name <> '..') And (SR.Attr And FaDirectory = FaDirectory) Then 137 | Scan(FileContainer, ScanRoot, aDirectory + SR.Name); 138 | Until (FindNextUTF8(SR) <> 0); 139 | FindCloseUTF8(SR); 140 | End; 141 | End; 142 | 143 | Procedure Quick(Var arr: TccFileList; li, re: integer); 144 | Var 145 | l, r: integer; 146 | h: TccFile; 147 | p: String; 148 | Begin 149 | If Li < Re Then Begin 150 | // Achtung, das Pivotelement darf nur einmal vor den While schleifen ausgelesen werden, danach nicht mehr !! 151 | p := arr[Trunc((li + re) / 2)].Filename; // Auslesen des Pivo Elementes 152 | l := Li; 153 | r := re; 154 | While l < r Do Begin 155 | While CompareStr(arr[l].Filename, p) < 0 Do 156 | inc(l); 157 | While CompareStr(arr[r].Filename, p) > 0 Do 158 | dec(r); 159 | If L <= R Then Begin 160 | h := arr[l]; 161 | arr[l] := arr[r]; 162 | arr[r] := h; 163 | inc(l); 164 | dec(r); 165 | End; 166 | End; 167 | quick(arr, li, r); 168 | quick(arr, l, re); 169 | End; 170 | End; 171 | 172 | { TForm3 } 173 | 174 | Procedure TForm3.FormCreate(Sender: TObject); 175 | Begin 176 | Caption := 'Synchronise..'; 177 | End; 178 | 179 | Procedure TForm3.Button2Click(Sender: TObject); 180 | Begin 181 | // Close 182 | Close; 183 | End; 184 | 185 | Procedure TForm3.Button1Click(Sender: TObject); 186 | Var 187 | i: integer; 188 | dFile, sFile: String; 189 | job: TJob; 190 | Begin 191 | // OK -> Generieren der Jobs und Los gehts ;) 192 | For i := 1 To StringGrid1.RowCount - 1 Do Begin 193 | job := Nil; 194 | Case StringGrid1.Cells[1, i] Of 195 | chr(IndexLeftToRight + ord('0')): Begin 196 | sFile := fLeftRootDirectory + fStringgridData[i - 1].Left; 197 | If FileExistsUTF8(sFile) Then Begin 198 | job := TJob.Create; 199 | job.JobType := jtCopyFile; 200 | job.Source := sFile; 201 | job.Dest := fRightRootDirectory + fStringgridData[i - 1].Left; 202 | End 203 | Else Begin 204 | // Der User will dass die Zieldatei gelöscht wird, weil die Quelldatei nicht existiert 205 | dFile := fRightRootDirectory + fStringgridData[i - 1].Right; 206 | If Not DeleteFileUTF8(dFile) Then Begin 207 | Showmessage('Unable to delete: ' + dFile); 208 | End; 209 | End; 210 | End; 211 | chr(IndexRightToLeft + ord('0')): Begin 212 | sFile := fRightRootDirectory + fStringgridData[i - 1].Right; 213 | If FileExistsUTF8(sFile) Then Begin 214 | job := TJob.Create; 215 | job.JobType := jtCopyFile; 216 | job.Source := sFile; 217 | job.Dest := fLeftRootDirectory + fStringgridData[i - 1].Right; 218 | End 219 | Else Begin 220 | // Der User will dass die Zieldatei gelöscht wird, weil die Quelldatei nicht existiert 221 | dFile := fLeftRootDirectory + fStringgridData[i - 1].Left; 222 | If Not DeleteFileUTF8(dFile) Then Begin 223 | Showmessage('Unable to delete: ' + dFile); 224 | End; 225 | End; 226 | End; 227 | End; 228 | If assigned(job) Then Begin 229 | (* 230 | * Da der User Explizit gewünscht hat hier zu überschreiben, brauchen 231 | * wir nachher nicht mehr zu fragen und können die Zieldatei 232 | * jetzt schon löschen 233 | *) 234 | If FileExistsUTF8(job.Dest) Then Begin 235 | If Not DeleteFileUTF8(job.Dest) Then Begin 236 | Showmessage('Unable to delete: ' + job.Dest); 237 | End; 238 | End; 239 | form1.AddJob(job); 240 | End; 241 | End; 242 | close; 243 | End; 244 | 245 | Procedure TForm3.FormResize(Sender: TObject); 246 | Begin 247 | StringGrid1.Columns[0].Width := width Div 2 - 40; 248 | StringGrid1.Columns[1].Width := 20; 249 | StringGrid1.Columns[2].Width := width Div 2 - 40; 250 | End; 251 | 252 | Procedure TForm3.FormShow(Sender: TObject); 253 | Var 254 | i: Integer; 255 | Begin 256 | If StringGrid1.RowCount <> length(fStringgridData) Then Begin 257 | StringGrid1.BeginUpdate; 258 | StringGrid1.Clear; 259 | StringGrid1.RowCount := length(fStringgridData) + 1; 260 | For i := 0 To high(fStringgridData) Do Begin 261 | StringGrid1.cells[0, i + 1] := fStringgridData[i].Left; 262 | StringGrid1.cells[1, i + 1] := inttostr(fStringgridData[i].Direction); 263 | StringGrid1.cells[2, i + 1] := fStringgridData[i].Right; 264 | End; 265 | StringGrid1.EndUpdate(true); 266 | UpdatePanelInfo; 267 | End; 268 | End; 269 | 270 | Procedure TForm3.MenuItem10Click(Sender: TObject); 271 | Var 272 | i: integer; 273 | Begin 274 | // Den Diff als .csv Speichern 275 | If SaveDialog1.Execute Then Begin 276 | // Indexe in "hübsch" umschreiben 277 | For i := 1 To StringGrid1.RowCount - 1 Do Begin 278 | Case StringGrid1.Cells[1, i] Of 279 | chr(IndexDoNothing + ord('0')): Begin 280 | StringGrid1.Cells[1, i] := 'ignore'; 281 | End; 282 | chr(IndexLeftToRight + ord('0')): Begin 283 | StringGrid1.Cells[1, i] := '-->'; 284 | End; 285 | chr(IndexRightToLeft + ord('0')): Begin 286 | StringGrid1.Cells[1, i] := '<--'; 287 | End; 288 | End; 289 | End; 290 | StringGrid1.SaveToCSVFile(SaveDialog1.FileName, ';', true, true); 291 | For i := 1 To StringGrid1.RowCount - 1 Do Begin 292 | Case StringGrid1.Cells[1, i] Of 293 | 'ignore': Begin 294 | StringGrid1.Cells[1, i] := chr(IndexDoNothing + ord('0')); 295 | End; 296 | '-->': Begin 297 | StringGrid1.Cells[1, i] := chr(IndexLeftToRight + ord('0')); 298 | End; 299 | '<--': Begin 300 | StringGrid1.Cells[1, i] := chr(IndexRightToLeft + ord('0')); 301 | End; 302 | End; 303 | End; 304 | End; 305 | End; 306 | 307 | Procedure TForm3.MenuItem11Click(Sender: TObject); 308 | Var 309 | i: Integer; 310 | Begin 311 | // Reload 312 | i := StringGrid1.Selection.Top; 313 | LoadDirectories(fLeftRootDirectory, fRightRootDirectory); 314 | FormShow(Nil); 315 | i := min(i, StringGrid1.RowCount - 1); 316 | StringGrid1.Selection := rect(0, i, StringGrid1.ColCount - 1, i); 317 | If i > StringGrid1.TopRow Then StringGrid1.TopRow := i; 318 | End; 319 | 320 | Procedure TForm3.StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer; 321 | aRect: TRect; aState: TGridDrawState); 322 | Begin 323 | If (aCol = 1) And (arow <> 0) Then Begin 324 | StringGrid1.Canvas.Rectangle(aRect.Left - 1, aRect.Top - 1, aRect.Right, aRect.Bottom); 325 | Case StringGrid1.Cells[aCol, aRow] Of 326 | chr(IndexDoNothing + ord('0')): Begin 327 | form1.AppIcons.Draw(StringGrid1.Canvas, arect.Left + 2, aRect.Top + 2, IndexDoNothing); 328 | End; 329 | chr(IndexLeftToRight + ord('0')): Begin 330 | form1.AppIcons.Draw(StringGrid1.Canvas, arect.Left + 2, aRect.Top + 2, IndexLeftToRight); 331 | End; 332 | chr(IndexRightToLeft + ord('0')): Begin 333 | form1.AppIcons.Draw(StringGrid1.Canvas, arect.Left + 2, aRect.Top + 2, IndexRightToLeft); 334 | End; 335 | End; 336 | End; 337 | End; 338 | 339 | Procedure TForm3.StringGrid1KeyDown(Sender: TObject; Var Key: Word; 340 | Shift: TShiftState); 341 | Var 342 | r: TRect; 343 | Begin 344 | // STRG + A = Alles Markieren 345 | If (ssCtrl In shift) And (key = ord('A')) Then Begin 346 | r.top := 0; 347 | r.Left := 0; 348 | r.Right := 2; 349 | r.Bottom := StringGrid1.RowCount - 1; 350 | StringGrid1.Selection := r; 351 | exit; 352 | End; 353 | // Reload 354 | If (ssCtrl In Shift) And (key = ord('R')) Then Begin 355 | LoadDirectories(fLeftRootDirectory, fRightRootDirectory); 356 | exit; 357 | End; 358 | If key = ord('N') Then Begin 359 | IterThroughAllSelected(IntToStr(IndexDoNothing)); 360 | End; 361 | If key = ord('R') Then Begin 362 | IterThroughAllSelected(IntToStr(IndexLeftToRight)); 363 | End; 364 | If key = ord('L') Then Begin 365 | IterThroughAllSelected(IntToStr(IndexRightToLeft)); 366 | End; 367 | If key = VK_ESCAPE Then Begin 368 | close; 369 | exit; 370 | End; 371 | UpdatePanelInfo; 372 | End; 373 | 374 | Procedure TForm3.MenuItem1Click(Sender: TObject); 375 | Var 376 | key: Word; 377 | Begin 378 | // Copy -> 379 | key := Ord('R'); 380 | StringGrid1KeyDown(Nil, key, []); 381 | End; 382 | 383 | Procedure TForm3.MenuItem2Click(Sender: TObject); 384 | Var 385 | key: Word; 386 | Begin 387 | // Copy <- 388 | key := Ord('L'); 389 | StringGrid1KeyDown(Nil, key, []); 390 | End; 391 | 392 | Procedure TForm3.MenuItem3Click(Sender: TObject); 393 | Var 394 | key: Word; 395 | Begin 396 | // Do Nothing 397 | key := Ord('N'); 398 | StringGrid1KeyDown(Nil, key, []); 399 | End; 400 | 401 | Procedure TForm3.MenuItem4Click(Sender: TObject); 402 | Var 403 | j, i, k: Integer; 404 | sel: TGridRect; 405 | fn: String; 406 | Begin 407 | // Del Left 408 | For i := StringGrid1.SelectedRangeCount - 1 Downto 0 Do Begin 409 | sel := StringGrid1.SelectedRange[i]; 410 | For j := sel.Bottom Downto sel.Top Do Begin 411 | fn := fLeftRootDirectory + fStringgridData[j - 1].Left; 412 | If DeleteFileUTF8(fn) Then Begin 413 | fStringgridData[j - 1].Left := ''; 414 | // Rechts ists auch Leer -> Die Zeile kann Weg 415 | If fStringgridData[j - 1].Right = '' Then Begin 416 | StringGrid1.DeleteRow(j); 417 | For k := j - 1 To high(fStringgridData) - 1 Do Begin 418 | fStringgridData[k] := fStringgridData[k + 1]; 419 | End; 420 | setlength(fStringgridData, high(fStringgridData)); 421 | End 422 | Else Begin 423 | // Rechts gibt es -> die Zeile bleibt da 424 | StringGrid1.Cells[0, j] := ''; 425 | StringGrid1.Cells[1, j] := inttostr(IndexRightToLeft); 426 | End; 427 | End; 428 | End; 429 | End; 430 | StringGrid1.ClearSelections; 431 | UpdatePanelInfo; 432 | End; 433 | 434 | Procedure TForm3.MenuItem5Click(Sender: TObject); 435 | Var 436 | j, i, k: Integer; 437 | sel: TGridRect; 438 | fn: String; 439 | Begin 440 | // Del Right 441 | For i := StringGrid1.SelectedRangeCount - 1 Downto 0 Do Begin 442 | sel := StringGrid1.SelectedRange[i]; 443 | For j := sel.Bottom Downto sel.Top Do Begin 444 | fn := fRightRootDirectory + fStringgridData[j - 1].Right; 445 | If DeleteFileUTF8(fn) Then Begin 446 | fStringgridData[j - 1].Right := ''; 447 | // Links ists auch Leer -> Die Zeile kann Weg 448 | If fStringgridData[j - 1].Left = '' Then Begin 449 | StringGrid1.DeleteRow(j); 450 | For k := j - 1 To high(fStringgridData) - 1 Do Begin 451 | fStringgridData[k] := fStringgridData[k + 1]; 452 | End; 453 | setlength(fStringgridData, high(fStringgridData)); 454 | End 455 | Else Begin 456 | // Links gibt es -> die Zeile bleibt da 457 | StringGrid1.Cells[2, j] := ''; 458 | StringGrid1.Cells[1, j] := inttostr(IndexLeftToRight); 459 | End; 460 | End; 461 | End; 462 | End; 463 | StringGrid1.ClearSelections; 464 | UpdatePanelInfo; 465 | End; 466 | 467 | Procedure TForm3.MenuItem7Click(Sender: TObject); 468 | Var 469 | folder, filename: String; 470 | Begin 471 | // Openleft Folder 472 | filename := fLeftRootDirectory + fStringgridData[StringGrid1.Selection.Top].Left; 473 | folder := ExtractFileDir(filename); 474 | If DirectoryExistsUTF8(folder) And (folder <> '') Then Begin 475 | OpenURL(folder); 476 | End; 477 | End; 478 | 479 | Procedure TForm3.MenuItem9Click(Sender: TObject); 480 | Var 481 | folder, filename: String; 482 | Begin 483 | // Open Right Folder 484 | filename := fLeftRootDirectory + fStringgridData[StringGrid1.Selection.Top].Right; 485 | folder := ExtractFileDir(filename); 486 | If DirectoryExistsUTF8(folder) And (folder <> '') Then Begin 487 | OpenURL(folder); 488 | End; 489 | End; 490 | 491 | Procedure TForm3.UpdatePanelInfo; 492 | Var 493 | i: integer; 494 | ltor, rtol: integer; 495 | Begin 496 | ltor := 0; 497 | rtol := 0; 498 | For i := 0 To StringGrid1.RowCount - 1 Do Begin 499 | If StringGrid1.Cells[1, i] = chr(IndexRightToLeft + ord('0')) Then inc(rtol); 500 | If StringGrid1.Cells[1, i] = chr(IndexLeftToRight + ord('0')) Then inc(ltor); 501 | End; 502 | StatusBar1.Panels[0].Text := format('%d files ->, %d files <-', [ltor, rtol]); 503 | End; 504 | 505 | Procedure TForm3.IterThroughAllSelected(aDirection: String); 506 | Var 507 | j, i: Integer; 508 | sel: TGridRect; 509 | Begin 510 | For i := 0 To StringGrid1.SelectedRangeCount - 1 Do Begin 511 | sel := StringGrid1.SelectedRange[i]; 512 | For j := sel.Top To sel.Bottom Do Begin 513 | StringGrid1.Cells[1, j] := aDirection; 514 | End; 515 | End; 516 | End; 517 | 518 | Function TForm3.LoadDirectories(LeftDir, RightDir: String): String; 519 | Var 520 | StringGridRowCount: Integer; 521 | 522 | Procedure Add(aLeft, ARight: String; aDir: Integer); 523 | Begin 524 | fStringgridData[StringGridRowCount].Left := aLeft; 525 | fStringgridData[StringGridRowCount].Right := ARight; 526 | fStringgridData[StringGridRowCount].Direction := aDir; 527 | inc(StringGridRowCount); 528 | If StringGridRowCount >= high(fStringgridData) Then Begin 529 | SetLength(fStringgridData, length(fStringgridData) + 1024); 530 | End; 531 | End; 532 | 533 | Var 534 | LeftFiles, RightFiles: TFilecontainer; 535 | i, j: integer; 536 | Begin 537 | (* 538 | * Der Unten stehende Code ansich ist eigentlich recht schnell, 539 | * das Problem ist aber, dass wenn man in die Listview richtig viele Elemente rein 540 | * lädt, dann dauert das Showmodal ewig zum Anzeigen :-\ 541 | *) 542 | result := ''; 543 | If LeftDir = RightDir Then Begin 544 | result := 'Error, same path on both sides.'; 545 | exit; 546 | End; 547 | If Not DirectoryExistsUTF8(LeftDir) Then Begin 548 | result := 'Error, left directory does not exist.'; 549 | exit; 550 | End; 551 | If Not DirectoryExistsUTF8(RightDir) Then Begin 552 | result := 'Error, right directory does not exist.'; 553 | exit; 554 | End; 555 | StringGridRowCount := 0; 556 | SetLength(fStringgridData, 1024); 557 | StringGrid1.Columns[0].Title.Caption := ExcludeTrailingPathDelimiter(LeftDir); 558 | StringGrid1.Columns[2].Title.Caption := ExcludeTrailingPathDelimiter(RightDir); 559 | LeftDir := IncludeTrailingPathDelimiter(LeftDir); 560 | RightDir := IncludeTrailingPathDelimiter(RightDir); 561 | fLeftRootDirectory := LeftDir; 562 | fRightRootDirectory := RightDir; 563 | // Zusammen suchen der Dateien 564 | LeftFiles.Files := Nil; 565 | SetLength(LeftFiles.Files, 1024); 566 | LeftFiles.FilesPtr := 0; 567 | scan(LeftFiles, fLeftRootDirectory, fLeftRootDirectory); 568 | setlength(LeftFiles.Files, LeftFiles.FilesPtr); 569 | RightFiles.Files := Nil; 570 | SetLength(RightFiles.Files, 1024); 571 | RightFiles.FilesPtr := 0; 572 | scan(RightFiles, fRightRootDirectory, fRightRootDirectory); 573 | setlength(RightFiles.Files, RightFiles.FilesPtr); 574 | // Scan findet zwar alles aber "unordentlich" ohne Sortierung geht das nicht.. 575 | Quick(LeftFiles.Files, 0, high(LeftFiles.Files)); 576 | Quick(RightFiles.Files, 0, high(RightFiles.Files)); 577 | // Nun da wir alles haben kann Verglichen werden 578 | i := 0; 579 | j := 0; 580 | While (i <= high(LeftFiles.Files)) And (j <= high(RightFiles.Files)) Do Begin 581 | {$IFDEF Windows} 582 | If lowercase(LeftFiles.Files[i].Filename) = lowercase(RightFiles.Files[j].Filename) Then Begin 583 | {$ELSE} 584 | If LeftFiles.Files[i].Filename = RightFiles.Files[j].Filename Then Begin 585 | {$ENDIF} 586 | If LeftFiles.Files[i].FileSize <> RightFiles.Files[j].FileSize Then Begin 587 | // Die Datei existiert auf beiden Seiten hat aber unterschiedliche "Größen" 588 | // Die Bevorzugte Kopierrichtung ist Groß Überlebt weil wird wohl neuer sein. 589 | If LeftFiles.Files[i].FileSize < RightFiles.Files[j].FileSize Then Begin 590 | Add(LeftFiles.Files[i].FileName, RightFiles.Files[j].FileName, IndexRightToLeft); 591 | End 592 | Else Begin 593 | Add(LeftFiles.Files[i].FileName, RightFiles.Files[j].FileName, IndexLeftToRight); 594 | End; 595 | End; 596 | inc(i); 597 | inc(j); 598 | End 599 | Else Begin 600 | // Das Alpha Numerisch "Kleinere" wird behandelt und weiter gezählt 601 | If CompareStr(LeftFiles.Files[i].Filename, RightFiles.Files[j].Filename) < 0 Then Begin 602 | Add(LeftFiles.Files[i].FileName, '', IndexLeftToRight); 603 | inc(i); 604 | End 605 | Else Begin 606 | Add('', RightFiles.Files[j].FileName, IndexRightToLeft); 607 | inc(j); 608 | End; 609 | End; 610 | End; 611 | // Liste der neu Hinzu gekommen Dateien 612 | While i <= High(LeftFiles.Files) Do Begin 613 | Add(LeftFiles.Files[i].FileName, '', IndexLeftToRight); 614 | inc(i); 615 | End; 616 | // Liste der Gelöschten Dateien 617 | While j <= High(RightFiles.Files) Do Begin 618 | Add('', RightFiles.Files[j].FileName, IndexRightToLeft); 619 | inc(j); 620 | End; 621 | SetLength(fStringgridData, StringGridRowCount); 622 | SetLength(RightFiles.Files, 0); 623 | SetLength(LeftFiles.Files, 0); 624 | If StringGridRowCount = 0 Then Begin 625 | result := 'Folders are equal.'; 626 | End; 627 | // Auf jeden Fall ein "Neu" erzeugen der Liste erzwingen (siehe FormShow) 628 | StringGrid1.RowCount := StringGridRowCount + 1; 629 | End; 630 | 631 | End. 632 | 633 | -------------------------------------------------------------------------------- /src/unit4.lfm: -------------------------------------------------------------------------------- 1 | object Form4: TForm4 2 | Left = 463 3 | Height = 522 4 | Top = 328 5 | Width = 907 6 | Caption = 'Form4' 7 | ClientHeight = 522 8 | ClientWidth = 907 9 | OnCreate = FormCreate 10 | OnDestroy = FormDestroy 11 | Position = poScreenCenter 12 | LCLVersion = '2.3.0.0' 13 | object Button1: TButton 14 | Left = 8 15 | Height = 25 16 | Top = 486 17 | Width = 888 18 | Anchors = [akLeft, akRight, akBottom] 19 | Caption = 'Confirm all and close' 20 | OnClick = Button1Click 21 | TabOrder = 0 22 | end 23 | object ListBox1: TListBox 24 | Left = 8 25 | Height = 472 26 | Top = 8 27 | Width = 888 28 | Anchors = [akTop, akLeft, akRight, akBottom] 29 | ItemHeight = 0 30 | PopupMenu = PopupMenu1 31 | TabOrder = 1 32 | TopIndex = -1 33 | end 34 | object PopupMenu1: TPopupMenu 35 | Images = Form1.AppIcons 36 | Left = 133 37 | Top = 92 38 | object MenuItem1: TMenuItem 39 | Caption = 'Re add to queue' 40 | ImageIndex = 15 41 | OnClick = MenuItem1Click 42 | end 43 | end 44 | end 45 | -------------------------------------------------------------------------------- /src/unit4.pas: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* *) 3 | (* Author : Uwe Schächterle (Corpsman) *) 4 | (* *) 5 | (* This file is part of CopyCommander2 *) 6 | (* *) 7 | (* See the file license.md, located under: *) 8 | (* https://github.com/PascalCorpsman/Software_Licenses/blob/main/license.md *) 9 | (* for details about the license. *) 10 | (* *) 11 | (* It is not allowed to change or remove this text from any *) 12 | (* source file of the project. *) 13 | (* *) 14 | (******************************************************************************) 15 | Unit Unit4; 16 | 17 | {$MODE ObjFPC}{$H+} 18 | 19 | Interface 20 | 21 | Uses 22 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Menus, 23 | ucopycommander; 24 | 25 | Type 26 | 27 | { TForm4 } 28 | 29 | TForm4 = Class(TForm) 30 | Button1: TButton; 31 | ListBox1: TListBox; 32 | MenuItem1: TMenuItem; 33 | PopupMenu1: TPopupMenu; 34 | Procedure Button1Click(Sender: TObject); 35 | Procedure FormCreate(Sender: TObject); 36 | Procedure FormDestroy(Sender: TObject); 37 | Procedure MenuItem1Click(Sender: TObject); 38 | private 39 | Procedure Clear; 40 | public 41 | Procedure AddErrorJob(EJ: TErrorJob); 42 | 43 | End; 44 | 45 | Var 46 | Form4: TForm4; 47 | 48 | Implementation 49 | 50 | {$R *.lfm} 51 | 52 | Uses Unit1; 53 | 54 | { TForm4 } 55 | 56 | Procedure TForm4.Button1Click(Sender: TObject); 57 | Begin 58 | Clear; 59 | Close; 60 | End; 61 | 62 | Procedure TForm4.FormCreate(Sender: TObject); 63 | Begin 64 | caption := 'Errorlog..'; 65 | End; 66 | 67 | Procedure TForm4.FormDestroy(Sender: TObject); 68 | Begin 69 | Clear; 70 | End; 71 | 72 | Procedure TForm4.MenuItem1Click(Sender: TObject); 73 | Begin 74 | If listbox1.ItemIndex <> -1 Then Begin 75 | form1.AddJob(TJob(ListBox1.Items.Objects[listbox1.ItemIndex])); 76 | ListBox1.Items.Delete(listbox1.ItemIndex); 77 | End; 78 | End; 79 | 80 | Procedure TForm4.Clear; 81 | Var 82 | i: Integer; 83 | Begin 84 | // Alle Fehler Jobs Frei geben 85 | For i := 0 To ListBox1.Items.Count - 1 Do Begin 86 | ListBox1.Items.Objects[i].Free; 87 | End; 88 | ListBox1.Clear; 89 | End; 90 | 91 | Procedure TForm4.AddErrorJob(EJ: TErrorJob); 92 | Begin 93 | ListBox1.AddItem(ej.ErrorMessage + ': ' + ej.Job.Source, ej.Job); 94 | If Visible Then Begin 95 | BringToFront; 96 | End 97 | Else Begin 98 | Show; 99 | End; 100 | End; 101 | 102 | End. 103 | 104 | -------------------------------------------------------------------------------- /src/unit5.lfm: -------------------------------------------------------------------------------- 1 | object Form5: TForm5 2 | Left = 323 3 | Height = 116 4 | Top = 130 5 | Width = 408 6 | Caption = 'Form5' 7 | ClientHeight = 116 8 | ClientWidth = 408 9 | OnCreate = FormCreate 10 | Position = poScreenCenter 11 | LCLVersion = '2.3.0.0' 12 | object Button1: TButton 13 | Left = 8 14 | Height = 25 15 | Top = 80 16 | Width = 120 17 | Anchors = [akLeft, akBottom] 18 | Caption = '&Replace' 19 | OnClick = Button1Click 20 | TabOrder = 0 21 | end 22 | object Label1: TLabel 23 | Left = 16 24 | Height = 16 25 | Top = 0 26 | Width = 41 27 | Caption = 'Label1' 28 | end 29 | object Button2: TButton 30 | Left = 144 31 | Height = 25 32 | Top = 80 33 | Width = 120 34 | Anchors = [akLeft, akBottom] 35 | Caption = '&Skip file' 36 | OnClick = Button2Click 37 | TabOrder = 1 38 | end 39 | object Button3: TButton 40 | Left = 280 41 | Height = 25 42 | Top = 80 43 | Width = 120 44 | Anchors = [akLeft, akRight, akBottom] 45 | Caption = 'Cancel all' 46 | OnClick = Button3Click 47 | TabOrder = 2 48 | end 49 | object CheckBox1: TCheckBox 50 | Left = 8 51 | Height = 22 52 | Top = 56 53 | Width = 94 54 | Anchors = [akLeft, akBottom] 55 | Caption = 'Apply to all' 56 | TabOrder = 3 57 | end 58 | end 59 | -------------------------------------------------------------------------------- /src/unit5.pas: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* *) 3 | (* Author : Uwe Schächterle (Corpsman) *) 4 | (* *) 5 | (* This file is part of CopyCommander2 *) 6 | (* *) 7 | (* See the file license.md, located under: *) 8 | (* https://github.com/PascalCorpsman/Software_Licenses/blob/main/license.md *) 9 | (* for details about the license. *) 10 | (* *) 11 | (* It is not allowed to change or remove this text from any *) 12 | (* source file of the project. *) 13 | (* *) 14 | (******************************************************************************) 15 | Unit Unit5; 16 | 17 | {$MODE ObjFPC}{$H+} 18 | 19 | Interface 20 | 21 | Uses 22 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ucopycommander; 23 | 24 | Type 25 | 26 | { TForm5 } 27 | 28 | TForm5 = Class(TForm) 29 | Button1: TButton; 30 | Button2: TButton; 31 | Button3: TButton; 32 | CheckBox1: TCheckBox; 33 | Label1: TLabel; 34 | Procedure Button1Click(Sender: TObject); 35 | Procedure Button2Click(Sender: TObject); 36 | Procedure Button3Click(Sender: TObject); 37 | Procedure FormCreate(Sender: TObject); 38 | private 39 | 40 | public 41 | Answer: TJobAnswers; 42 | End; 43 | 44 | Var 45 | Form5: TForm5; 46 | 47 | Implementation 48 | 49 | {$R *.lfm} 50 | 51 | Uses unit1; 52 | 53 | { TForm5 } 54 | 55 | Procedure TForm5.FormCreate(Sender: TObject); 56 | Begin 57 | caption := 'Question'; 58 | End; 59 | 60 | Procedure TForm5.Button1Click(Sender: TObject); 61 | Begin 62 | // replace 63 | answer := jaReplace; 64 | close; 65 | End; 66 | 67 | Procedure TForm5.Button2Click(Sender: TObject); 68 | Begin 69 | // Skip File 70 | answer := jaSkip; 71 | close; 72 | End; 73 | 74 | Procedure TForm5.Button3Click(Sender: TObject); 75 | Begin 76 | // Cancel all 77 | form1.fWorkThread.CancelAllJobs(); 78 | CheckBox1.Checked := false; 79 | answer := jaSkip; 80 | close; 81 | End; 82 | 83 | End. 84 | 85 | --------------------------------------------------------------------------------