diff --git a/DiskModule/diskmoduleunit1.lfm b/DiskModule/diskmoduleunit1.lfm
index 8671382..1855542 100755
--- a/DiskModule/diskmoduleunit1.lfm
+++ b/DiskModule/diskmoduleunit1.lfm
@@ -3,7 +3,7 @@ object frmDiskHashingModule: TfrmDiskHashingModule
Height = 600
Top = 155
Width = 691
- Caption = 'QuickHash 2.6.7 (2011 - 2015) (c) Ted Smith - Disk Hashing Module'
+ Caption = 'QuickHash 2.6.8 (2011 - 2015) (c) Ted Smith - Disk Hashing Module'
ClientHeight = 600
ClientWidth = 691
Position = poScreenCenter
diff --git a/FindAllFilesEnhanced.pas b/FindAllFilesEnhanced.pas
index 11d103c..b195c5a 100755
--- a/FindAllFilesEnhanced.pas
+++ b/FindAllFilesEnhanced.pas
@@ -6,10 +6,10 @@
interface
uses
- Classes;
+ LazUTF8Classes, Classes;
function FindAllFilesEx(const SearchPath: string; SearchMask: string;
- SearchSubDirs: boolean; IncludeHidderDirs: boolean): TStringList;
+ SearchSubDirs: boolean; IncludeHidderDirs: boolean): TStringListUTF8;
implementation
uses
@@ -42,11 +42,11 @@ constructor TListFileSearcher.Create(AList: TStrings);
end;
function FindAllFilesEx(const SearchPath: string; SearchMask: string;
- SearchSubDirs: boolean; IncludeHidderDirs: boolean): TStringList;
+ SearchSubDirs: boolean; IncludeHidderDirs: boolean): TStringListUTF8;
var
Searcher: TListFileSearcher;
begin
- Result := TStringList.Create;
+ Result := TStringListUTF8.Create;
Searcher := TListFileSearcher.Create(Result);
Searcher.DirectoryAttribute := Searcher.DirectoryAttribute or faHidden;
try
diff --git a/project1.lpi b/project1.lpi
index 02cfdf9..d3f7739 100755
--- a/project1.lpi
+++ b/project1.lpi
@@ -46,11 +46,11 @@
-
+
-
+
@@ -90,8 +90,8 @@
-
-
+
+
@@ -160,7 +160,7 @@
-
+
@@ -169,7 +169,7 @@
-
+
@@ -249,8 +249,8 @@
-
-
+
+
@@ -261,9 +261,9 @@
-
+
-
+
@@ -323,14 +323,14 @@
-
+
-
-
-
-
+
+
+
+
@@ -411,10 +411,10 @@
-
+
-
+
@@ -497,127 +497,136 @@
+
+
+
+
+
+
+
+
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
-
+
+
-
-
+
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
-
+
-
+
-
+
-
+
-
-
+
+
-
-
+
+
-
+
-
+
-
+
-
+
diff --git a/unit2.lfm b/unit2.lfm
index a0f926f..71be5fe 100755
--- a/unit2.lfm
+++ b/unit2.lfm
@@ -1,10 +1,10 @@
object MainForm: TMainForm
- Left = 250
+ Left = 270
Height = 689
- Top = 97
+ Top = 57
Width = 1018
AllowDropFiles = True
- Caption = 'Quick Hash v2.6.7 (c) 2011-2016 - The easy and convenient way to hash data in both Linux, Apple Mac and Windows'
+ Caption = 'Quick Hash v2.6.8 (c) 2011-2016 - The easy and convenient way to hash data in both Linux, Apple Mac and Windows'
ClientHeight = 689
ClientWidth = 1018
OnCreate = FormCreate
@@ -21,6 +21,7 @@ object MainForm: TMainForm
ParentShowHint = False
TabIndex = 0
TabOrder = 0
+ OnChange = PageControl1Change
object TabSheet1: TTabSheet
Hint = 'Hash portions of text'
Caption = 'Te&xt'
@@ -689,19 +690,19 @@ object MainForm: TMainForm
object TabSheet4: TTabSheet
Hint = 'Choose a directory, have its content hashed, files are copied to destination, and re-hashed.'
Caption = '&Copy'
- ClientHeight = 617
- ClientWidth = 990
+ ClientHeight = 624
+ ClientWidth = 988
ParentShowHint = False
ShowHint = True
object CopyFilesHashingGroupBox: TGroupBox
Left = 120
Height = 598
Top = 8
- Width = 860
+ Width = 858
Anchors = [akTop, akLeft, akRight]
Caption = 'Hash files in chosen directory, copy them, and re-hash the copied files (recursive by default) '
ClientHeight = 580
- ClientWidth = 856
+ ClientWidth = 854
Color = clForm
ParentColor = False
ParentFont = False
@@ -710,10 +711,10 @@ object MainForm: TMainForm
Left = 16
Height = 176
Top = 16
- Width = 817
+ Width = 815
Anchors = [akTop, akLeft, akRight]
ClientHeight = 176
- ClientWidth = 817
+ ClientWidth = 815
TabOrder = 3
object CheckBoxListOfDirsOnly: TCheckBox
Left = 14
@@ -949,7 +950,7 @@ object MainForm: TMainForm
Left = 0
Height = 20
Top = 560
- Width = 856
+ Width = 854
Anchors = [akRight]
Panels = <>
end
@@ -965,7 +966,7 @@ object MainForm: TMainForm
ReadOnly = True
TabOrder = 5
OnClick = DirListAClick
- Options = [tvoAutoItemHeight, tvoHideSelection, tvoHotTrack, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw]
+ Options = [tvoAllowMultiselect, tvoAutoItemHeight, tvoHideSelection, tvoHotTrack, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw]
TreeLinePenStyle = psSolid
ObjectTypes = [otFolders, otHidden]
end
diff --git a/unit2.pas b/unit2.pas
index 48c20cf..a44e45b 100755
--- a/unit2.pas
+++ b/unit2.pas
@@ -258,6 +258,7 @@ TMainForm = class(TForm)
TabSheet7: TTabSheet;
TextHashingGroupBox: TGroupBox;
procedure cbToggleInputDataToOutputFileChange(Sender: TObject);
+ procedure PageControl1Change(Sender: TObject);
procedure sysRAMTimerTimer(Sender: TObject);
procedure AlgorithmChoiceRadioBox2SelectionChanged(Sender: TObject);
procedure AlgorithmChoiceRadioBox5SelectionChanged(Sender: TObject);
@@ -297,7 +298,7 @@ TMainForm = class(TForm)
procedure FormDropFiles(Sender: TObject; const FileNames: array of String);
procedure HashFile(FileIterator: TFileIterator);
procedure lblURLBannerClick(Sender: TObject);
- procedure ProcessDir(const SourceDirName: string);
+ procedure ProcessDir(SourceDirName: string);
procedure MisMatchFileCountCompare(HashListA, HashListB, FileAndHashListA, FileAndHashListB : TStringList);
procedure CompareTwoHashes(FileAHash, FileBHash : string);
procedure HashText(Sender: TObject);
@@ -340,6 +341,8 @@ TMainForm = class(TForm)
DirA, DirB : string;
sValue1 : string; // Set by GetWin32_DiskDriveInfo then used by ListDisks OnClick event - Windows only
+ slMultipleDirNames : TStringList;
+ MultipleDirsChosen : boolean;
const
{$IFDEF WINDOWS}
// For coping better with 260 MAX_PATH limits of Windows. Instead we invoke Unicode
@@ -793,6 +796,11 @@ procedure TMainForm.cbToggleInputDataToOutputFileChange(Sender: TObject);
else cbToggleInputDataToOutputFile.Caption := 'Source text INcluded in output';
end;
+procedure TMainForm.PageControl1Change(Sender: TObject);
+begin
+
+end;
+
{$IFDEF WINDOWS}
// http://stackoverflow.com/questions/7859978/get-total-and-available-memory-when-4-gb-installed
function TMainForm.GetSystemMem: string; { Returns installed RAM (as viewed by your OS) in Gb\Tb}
@@ -1311,7 +1319,7 @@ procedure TMainForm.btnCompareClick(Sender: TObject);
try
// First, list and hash the files in DirA
lblStatusB.Caption := 'Counting files in ' + DirA + ' ...please wait';
- TotalFilesDirA := TStringList.Create;
+ TotalFilesDirA := TStringListUTF8.Create;
TotalFilesDirA.Sorted := true;
TotalFilesDirA := FindAllFilesEx(LongPathOverrideA+DirA, '*', True, True);
TotalFilesDirA.Sort;
@@ -1357,7 +1365,7 @@ procedure TMainForm.btnCompareClick(Sender: TObject);
// Then, list and hash the files in DirB
lblStatusB.Caption := 'Counting and examining files in ' + DirB + ' ...please wait';
- TotalFilesDirB := TStringList.Create;
+ TotalFilesDirB := TStringListUTF8.Create;
TotalFilesDirB.Sorted := true;
TotalFilesDirB := FindAllFilesEx(LongPathOverrideB+DirB, '*', True, True);
TotalFilesDirB.Sort;
@@ -1651,6 +1659,8 @@ procedure TMainForm.EmptyDisplayGrid(Grid : TStringGrid);
end;
procedure TMainForm.Button8CopyAndHashClick(Sender: TObject);
+var
+ i : integer;
begin
frmDisplayGrid1.CopyAndHashGrid.Visible := false; // Hide the grid if it was left visible from an earlier run
lblNoOfFilesToExamine.Caption := '';
@@ -1660,6 +1670,7 @@ procedure TMainForm.Button8CopyAndHashClick(Sender: TObject);
lblTimeTaken6A.Caption := '...';
lblTimeTaken6B.Caption := '...';
lblTimeTaken6C.Caption := '...';
+ i := 0;
StatusBar3.Caption := ('Counting files...please wait');
Application.ProcessMessages;
@@ -1688,8 +1699,22 @@ procedure TMainForm.Button8CopyAndHashClick(Sender: TObject);
DirListAClick(Sender);
DirListBClick(Sender);
- // Now process the selected source and destination in non-UNC mode
- ProcessDir(SourceDir);
+ // Now process the selected source and destination folders in non-UNC mode
+ // If the user has chosen multiple folders...
+ if MultipleDirsChosen then
+ try
+ if slMultipleDirNames.Count > 0 then
+ begin
+ // give ProcessDir function the first folder name in the list for now...
+ // ProcessDir will then do the itterations itself using the same stringlist
+ SourceDir := slMultipleDirNames.Strings[0];
+ ProcessDir(SourceDir);
+ end
+ finally
+ if assigned(slMultipleDirNames) then slMultipleDirNames.free;
+ end
+ // or copy single selected folder as normal if only one folder selected
+ else ProcessDir(SourceDir);
if SourceDirValid AND DestDirValid = FALSE then
begin
@@ -2214,7 +2239,7 @@ procedure TMainForm.lblURLBannerClick(Sender: TObject);
OpenURL(QuickHashURL);
end;
-procedure TMainForm.ProcessDir(const SourceDirName: string);
+procedure TMainForm.ProcessDir(SourceDirName: string);
{$IFDEF WINDOWS}
type
@@ -2234,7 +2259,7 @@ procedure TMainForm.ProcessDir(const SourceDirName: string);
SystemDate, StartTime, EndTime, TimeDifference : TDateTime;
- FilesFoundToCopy, DirectoriesFoundList, SLCopyErrors : TStringList;
+ FilesFoundToCopy, DirectoriesFoundList, SLCopyErrors, slTemp : TStringList;
{$IFDEF WINDOWS}
DriveLetter : char; // For MS Windows drive letter irritances only
@@ -2258,7 +2283,7 @@ procedure TMainForm.ProcessDir(const SourceDirName: string);
k := 0;
m := 0;
- SLCopyErrors := TStringList.Create;
+ SLCopyErrors := TStringListUTF8.Create;
// Ensures the selected source directory is set as the directory to be searched
// and then finds all the files and directories within, storing as a StringList.
@@ -2286,7 +2311,7 @@ procedure TMainForm.ProcessDir(const SourceDirName: string);
// On Linux, though, we need different behaviour - see IFDEF below
if chkNoRecursiveCopy.Checked then // Does not want recursive
begin
- if FileTypeMaskCheckBox1.Checked then // ...and does want a file mask
+ if FileTypeMaskCheckBox1.Checked then // ...and does want a file mask
begin
FilesFoundToCopy := FindAllFilesEx(LongPathOverride+SourceDirName, FileMaskField.Text, False, True);
end
@@ -2296,17 +2321,77 @@ procedure TMainForm.ProcessDir(const SourceDirName: string);
end;
end;
- if not chkNoRecursiveCopy.Checked then // Does want recursive
+ if MultipleDirsChosen = false then // User has only selected one folder
begin
- if FileTypeMaskCheckBox1.Checked then // ...but does want a file mask
- begin
- FilesFoundToCopy := FindAllFilesEx(LongPathOverride+SourceDirName, FileMaskField.Text, True, True);
- end
- else // but does not want a file mask
+ if not chkNoRecursiveCopy.Checked then // and does want recursive copy
begin
- FilesFoundToCopy := FindAllFilesEx(LongPathOverride+SourceDirName, '*', True, True);
+ if FileTypeMaskCheckBox1.Checked then // ...but does want a file mask
+ begin
+ FilesFoundToCopy := FindAllFilesEx(LongPathOverride+SourceDirName, FileMaskField.Text, True, True);
+ end
+ else // ... but does NOT want a file mask
+ begin
+ FilesFoundToCopy := FindAllFilesEx(LongPathOverride+SourceDirName, '*', True, True);
+ end;
end;
+ end
+ else // User has selected multiple folders to copy
+ begin
+ if not chkNoRecursiveCopy.Checked then // and does want recursive
+ begin
+ if FileTypeMaskCheckBox1.Checked then // ...but does want a file mask for all selected folders
+ begin
+ FilesFoundToCopy := TStringListUTF8.Create;
+ FilesFoundToCopy.Sorted := true;
+ for i := 0 to slMultipleDirNames.Count -1 do
+ begin
+ SourceDirName := slMultipleDirNames.Strings[i];
+ slTemp := TStringListUTF8.Create;
+ slTemp.Sorted := true;
+ slTemp := FindAllFilesEx(LongPathOverride+SourceDirName, FileMaskField.Text, True, True);
+ for j := 0 to slTemp.Count -1 do
+ begin
+ FilesFoundToCopy.Add(slTemp.Strings[j]);
+ end;
+ slTemp.Free;
+ end;
+ end
+ else // ... but does NOT want a file mask for all selected folders
+ begin
+ FilesFoundToCopy := TStringListUTF8.Create;
+ FilesFoundToCopy.Sorted := true;
+ for i := 0 to slMultipleDirNames.Count -1 do
+ begin
+ SourceDirName := slMultipleDirNames.Strings[i];
+ slTemp := TStringListUTF8.Create;
+ slTemp.Sorted := true;
+ slTemp := FindAllFilesEx(LongPathOverride+SourceDirName, '*', True, True);
+ for j := 0 to slTemp.Count -1 do
+ begin
+ FilesFoundToCopy.Add(slTemp.Strings[j]);
+ end;
+ slTemp.Free;
+ end;
+ end;
+ end
+ else // User does not want recursive but does want a multiple selection. i.e sub directories of multiple dirs are to be ignored.
+ begin
+ FilesFoundToCopy := TStringListUTF8.Create;
+ FilesFoundToCopy.Sorted := true;
+ for i := 0 to slMultipleDirNames.Count -1 do
+ begin
+ SourceDirName := slMultipleDirNames.Strings[i];
+ slTemp := TStringListUTF8.Create;
+ slTemp.Sorted := true;
+ slTemp := FindAllFilesEx(LongPathOverride+SourceDirName, '*', False, True);
+ for j := 0 to slTemp.Count -1 do
+ begin
+ FilesFoundToCopy.Add(slTemp.Strings[j]);
+ end;
+ slTemp.Free;
+ end;
end;
+ end;
{$ENDIF}
{$IFDEF LINUX}
@@ -2966,20 +3051,55 @@ procedure TMainForm.chkUNCModeChange(Sender: TObject);
end;
procedure TMainForm.DirListAClick(Sender: TObject);
+var
+ NoOfDirsSelected, i : integer;
begin
- SourceDir := UTF8ToSys(DirListA.GetSelectedNodePath);
- if DirectoryExists(SourceDir) then
- begin
- Edit2SourcePath.Text := SourceDir;
- SourceDirValid := TRUE;
- if SourceDirValid AND DestDirValid = TRUE then
+ MultipleDirsChosen := false;
+ NoOfDirsSelected := DirListA.SelectionCount;
+ // If only one folder selected, do as as we always have
+ if NoOfDirsSelected = 1 then
+ begin
+ MultipleDirsChosen := false;
+ SourceDir := UTF8ToSys(DirListA.GetSelectedNodePath);
+ if DirectoryExists(SourceDir) then
begin
- // Now enable the 'Go!' button as both SourceDir and DestDir are valid
- Button8CopyAndHash.Enabled := true;
+ Edit2SourcePath.Text := SourceDir;
+ SourceDirValid := TRUE;
+ if SourceDirValid AND DestDirValid = TRUE then
+ begin
+ // Now enable the 'Go!' button as both SourceDir and DestDir are valid
+ Button8CopyAndHash.Enabled := true;
+ end;
+ end;
+ end
+ else if NoOfDirsSelected > 1 then
+ // The number of folders selected is greater than 1 so we must itterate
+ try
+ slMultipleDirNames := TStringList.Create;
+ begin
+ MultipleDirsChosen := true;
+ for i := 0 to NoOfDirsSelected -1 do
+ begin
+ {$ifdef Windows}
+ slMultipleDirNames.Add(StringReplace(DirListA.Selections[i].GetTextPath, '/', '\', [rfReplaceAll]));
+ {$else}
+ {$IFDEF Darwin}
+ slMultipleDirNames.Add(DirListA.Selections[i].GetTextPath);
+ {$else}
+ {$IFDEF UNIX and !$ifdef Darwin} // because Apple had to 'borrow' Unix for their OS!
+ slMultipleDirNames.Add(DirListA.Selections[i].GetTextPath);
+ {$ENDIF}
+ {$ENDIF}
+ {$endif}
+ end;
end;
- end;
+ finally
+ // nothing to do
+ end
+ else MultipleDirsChosen := false;
end;
+
procedure TMainForm.DirListBClick(Sender: TObject);
begin
DestDir := UTF8ToSys(DirListB.GetSelectedNodePath);