{ Picture Organizer (PicOrg) is a free open source Directory rename
tool created by Theo Langstraat and licensed under GNU/GPL.
@version
1.0.0.0 (February 9 2023)
1.1.0.0 (December 9 2023) Status form added
@copyright
Copyright (C) 2023 Theo Langstraat *) }
unit MainForm;
interface
uses
DB,
FireDAC.Comp.Client, FireDAC.Stan.Intf, FireDAC.Stan.Param,
FireDAC.Stan.Error,
FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf, FireDAC.Comp.DataSet,
FireDAC.Stan.Option,
System.Classes, System.Generics.Collections, System.IniFiles, System.IOUtils,
System.JSON, System.JSON.Readers, System.JSON.Types, System.UITypes,
System.StrUtils, System.SysUtils, System.Variants, System.Win.Registry,
Vcl.ComCtrls, Vcl.Controls, Vcl.DBCtrls, Vcl.DBGrids, Vcl.Dialogs,
Vcl.ExtCtrls,
Vcl.ExtDlgs, Vcl.FileCtrl, Vcl.Forms, Vcl.Grids, Vcl.StdCtrls,
Winapi.Messages, Winapi.ShlObj, Winapi.Windows, Vcl.OleCtrls, SHDocVw,
StatusForm, Util, TL.Components, SettingsForm, Vcl.Buttons;
type
TfrmMain = class(TForm)
btnDestinationDir: TButton;
btnExecute: TButton;
btnSourceDir: TButton;
btnStart: TButton;
FileOpenDialog: TFileOpenDialog;
gbSettings: TGroupBox;
lblDestinationDir: TLabel;
lblSourceDir: TLabel;
lvError: TListView;
OpenPictureDialog: TOpenPictureDialog;
pnlBottom: TPanel;
pnlButtons: TPanel;
pnlDetails: TPanel;
pnlError: TPanel;
pnlLists: TPanel;
pnlMain: TPanel;
pnlTop: TPanel;
StatusBar: TStatusBar;
tblImageProperties: TFDMemTable;
// Much faster then ListView in Report modus if more then 3000 items
tblImagePropertiesSourceFile: TStringField; // tblImageProperties.Fields[0]
tblImagePropertiesFileModifyDate: TStringField;
// tblImageProperties.Fields[1]
tblImagePropertiesFileCreateDate: TStringField;
// tblImageProperties.Fields[2]
tblImagePropertiesDateTimeOriginal: TStringField;
// tblImageProperties.Fields[3]
tblImagePropertiesOriginalDate: TStringField;
// tblImageProperties.Fields[4]
tblImagePropertiesOriginalYear: TStringField;
// tblImageProperties.Fields[5]
tblImagePropertiesDirectory: TStringField; // tblImageProperties.Fields[6]
tblImagePropertiesDestinationFile: TStringField;
// tblImageProperties.Fields[7]
tblImagePropertiesDuplicate: TStringField; // tblImageProperties.Fields[8]
lblSourceFile: TLabel;
lblFileModifyDate: TLabel;
lblFileCreateDate: TLabel;
lblDateTimeOriginal: TLabel;
lblOriginalDate: TLabel;
lblOriginalYear: TLabel;
lblDirectory: TLabel;
lblDestinationFile: TLabel;
lblDuplicate: TLabel;
dbgImageProperties: TDBGrid;
dbNavigator: TDBNavigator;
dsImageProperties: TDataSource;
dbtSourceFile: TDBText;
dbtFileModifyDate: TDBText;
dbtFileCreateDate: TDBText;
dbtDateTimeOriginal: TDBText;
dbtOriginalDate: TDBText;
dbtOriginalYear: TDBText;
dbtDirectory: TDBText;
dbtDestinationFile: TDBText;
dbtDuplicate: TDBText;
rgFileAction: TRadioGroup;
Button2: TButton;
LDBGrid1: TLDBGrid;
function GetFileType(FileName: string): TFileType;
function OpenIniFileInstance: TCustomIniFile;
procedure btnDestinationDirClick(Sender: TObject);
procedure btnExecuteClick(Sender: TObject);
procedure btnSourceDirClick(Sender: TObject);
procedure btnStartClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure LoadConfig;
procedure lvErrorResize(Sender: TObject);
procedure SaveConfig;
function Scan(Path: string): TFunctionResult;
procedure rgFileActionClick(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
SourceDir: string;
DestinationDir: string;
FileCounter: integer;
TotalFilesDetected: integer;
State: TState;
file_list: TStringlist;
ImageExt, RawExt, WebExt, VideoExt, RemoveExt, OtherExt: string;
ImageDir, RawDir, WebDir, VideoDir, RemoveDir, NoEXIFDir, OtherDir: string;
duplicatesDir: string;
Sr: TStringReader;
Reader: TJsonTextReader; // Fastest JSON implementation
function CountFilesInFolder(Path: string): integer;
function CreateDestName(SourceFile, OriginalDate, OriginalYear,
Directory: string): string;
function GetWhatsAppDate(FileName: string): string;
procedure CreateReader(Str: string);
function GetExifData: TFunctionResult;
procedure RestructureDirectory;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
frmStatus: TfrmStatus;
FileListName: string;
implementation
{$R *.dfm}
uses
ExifTool;
procedure TfrmMain.CreateReader(Str: string);
begin
if Reader <> nil then
Reader.Free;
if Sr <> nil then
Sr.Free;
Sr := TStringReader.Create(Str);
Reader := TJsonTextReader.Create(Sr);
end;
function TfrmMain.OpenIniFileInstance: TCustomIniFile;
begin
{ HKEY_CURRENT_USER\Software\... }
Result := TRegistryIniFile.Create('Software\Langstraat\' + Application.Title);
end;
function GetSpecialFolderPath(CSIDLFolder: integer): string;
var
FilePath: array [0 .. MAX_PATH] of char;
begin
SHGetFolderPath(0, CSIDLFolder, 0, 0, FilePath);
Result := FilePath;
end;
procedure TfrmMain.SaveConfig;
var
ConfigFile: TCustomIniFile;
begin
ConfigFile := OpenIniFileInstance();
with ConfigFile do
try
WriteString('general', 'Copyright', 'Theo Langstraat - 2024');
WriteString('general', 'Version', '1.2');
WriteString('general', 'Date', '7-5-2024');
WriteString('locations', 'SourceDir', SourceDir);
WriteString('locations', 'DestinationBaseDir', DestinationDir);
WriteString('locations', 'ImageDir', ImageDir);
WriteString('locations', 'RawDir', RawDir);
WriteString('locations', 'WebDir', WebDir);
WriteString('locations', 'VideoDir', VideoDir);
WriteString('locations', 'RemoveDir', RemoveDir);
WriteString('locations', 'NoEXIFDir', NoEXIFDir);
WriteString('locations', 'OtherDir', OtherDir);
WriteString('locations', 'DuplicatesDir', DuplicatesDir);
WriteString('filetypes', 'image', ImageExt);
WriteString('filetypes', 'raw', RawExt);
WriteString('filetypes', 'web', WebExt);
WriteString('filetypes', 'video', VideoExt);
WriteString('filetypes', 'remove', RemoveExt);
WriteString('filetypes', 'other', OtherExt);
if WindowState <> wsMaximized then
begin
WriteInteger('frmMain', 'Top', frmMain.Top);
WriteInteger('frmMain', 'Left', frmMain.Left);
WriteInteger('frmMain', 'Height', frmMain.Height);
WriteInteger('frmMain', 'Width', frmMain.Width);
end;
WriteBool('frmMain', 'WindowState', WindowState = wsMaximized);
WriteDateTime('general', 'LastRun', Now);
WriteInteger('fileaction', 'Action', rgFileAction.ItemIndex);
finally
Free;
end;
end;
procedure TfrmMain.LoadConfig;
var
ConfigFile: TCustomIniFile;
begin
ConfigFile := OpenIniFileInstance();
with ConfigFile do
try
SourceDir := ReadString('locations', 'SourceDir',
GetSpecialFolderPath(CSIDL_MYPICTURES));
DestinationDir := ReadString('locations', 'DestinationBaseDir',
DestinationDir);
ImageDir := ReadString('locations', 'ImageDir', '\01 - image');
RawDir := ReadString('locations', 'RawDir', '\02 - raw');
VideoDir := ReadString('locations', 'VideoDir', '\03 - video');
WebDir := ReadString('locations', 'WebDir', '\04 - web');
DuplicatesDir := ReadString('locations', 'DuplicatesDir', '\05 - duplicates');
NoEXIFDir := ReadString('locations', 'NoEXIFDir', '\06 - noexif');
OtherDir := ReadString('locations', 'OtherDir', '\07 - other');
RemoveDir := ReadString('locations', 'RemoveDir', '\08 - remove');
ImageExt := ReadString('filetypes', 'image', ImageExt).ToLower;
RawExt := ReadString('filetypes', 'raw', RawExt).ToLower;
WebExt := ReadString('filetypes', 'web', WebExt).ToLower;
VideoExt := ReadString('filetypes', 'video', VideoExt).ToLower;
RemoveExt := ReadString('filetypes', 'remove', RemoveExt).ToLower;
OtherExt := ReadString('filetypes', 'other', OtherExt).ToLower;
frmMain.Top := ReadInteger('frmMain', 'Top', frmMain.Top);
frmMain.Left := ReadInteger('frmMain', 'Left', frmMain.Left);
frmMain.Height := ReadInteger('frmMain', 'Height', frmMain.Height);
frmMain.Width := ReadInteger('frmMain', 'Width', frmMain.Width);
case ReadBool('frmMain', 'WindowState', WindowState = wsMaximized) of
true:
WindowState := wsMaximized;
false:
WindowState := wsNormal;
end;
rgFileAction.ItemIndex := ReadInteger('fileaction', 'Action', 1);
finally
Free;
end;
end;
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
SaveConfig;
if frmStatus <> nil then
frmStatus.Free;
if file_list <> nil then
file_list.Free;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
var
Col: TListColumn;
begin
btnExecute.Enabled := false;
lvError.Clear;
lvError.Columns.Clear;
Col := lvError.Columns.Add;
Col.Caption := StrMessagesFromEXIFTo;
Col.Alignment := taLeftJustify;
Col.Width := frmMain.Width - 10;
file_list := TStringlist.Create;
frmStatus := TfrmStatus.Create(Self);
{ Default filters }
ImageExt := '.jpeg .JPG .tif .tiff';
RawExt := '.afphoto .CR2 .CR3 .CRW .dng .psd';
WebExt := '.bmp .png';
VideoExt := '.MOV .mp4';
RemoveExt := '.info .ini .json .mxc3 .pp2 .pp3 .THM .url .xml .xmp';
OtherExt := '.AAE .bib .BridgeSort .CTG .dat .docx .pdf';
LoadConfig;
TotalFilesDetected := CountFilesInFolder(SourceDir);
lblSourceDir.Caption := 'Number of Files: ' + IntToStr(TotalFilesDetected) +
' - ' + SourceDir;
lblDestinationDir.Caption := DestinationDir;
rgFileActionClick(Sender);
Self.Caption := 'Picture directory organizer ' +
TL.Components.Folder.AppVersion + ' - © 2024 Theo Langstraat';
end;
procedure TfrmMain.FormResize(Sender: TObject);
var
i, j: integer;
begin
j := 0;
for i := 0 to 8 do // Calculate total fixed width for first 0..8 panels
j := j + StatusBar.Panels[i].Width;
StatusBar.Panels[9].Width := StatusBar.Width - j;
// Calculate remaining width for panel 9 comprising the File name in progress
end;
function TfrmMain.CountFilesInFolder(Path: string): integer;
var
c: integer;
procedure CountFiles(Path: string);
const
Success: integer = 0;
var
f: TSearchRec;
begin
if FindFirst(Path + '\*.*', faAnyFile, f) = Success then
begin
repeat // until FindNext(f) <> Success
if (f.Attr and faDirectory) <> 0 then
begin // is directory
if (f.Name[1] <> '.') then // not current or parent directory
CountFiles(Path + '\' + f.Name); // recurses all sub-directories
end // f.attr = faDirectory
else // // is not directory
Inc(c);
until FindNext(f) <> Success;
System.SysUtils.FindClose(f);
end; // FindFirst(Path + '\*.*', faDirectory, f) = Success
end;
begin
c := 0;
CountFiles(Path);
Result := c;
end;
procedure TfrmMain.btnSourceDirClick(Sender: TObject);
begin
with FileOpenDialog do
begin
DefaultFolder := SourceDir;
Options := [fdoPickFolders];
if Execute then
begin
SourceDir := FileName;
TotalFilesDetected := CountFilesInFolder(SourceDir);
lblSourceDir.Caption := 'Number of Files: ' + IntToStr(TotalFilesDetected)
+ ' - ' + SourceDir;
end;
end;
SaveConfig;
end;
procedure TfrmMain.btnDestinationDirClick(Sender: TObject);
begin
with FileOpenDialog do
begin
DefaultFolder := DestinationDir;
Options := [fdoPickFolders];
if Execute then
begin
DestinationDir := FileName;
lblDestinationDir.Caption := DestinationDir;
end;
end;
SaveConfig;
end;
procedure TfrmMain.btnStartClick(Sender: TObject);
begin
State := stInit;
while State <> stCompleted do
begin
case State of // State Machine
stInit:
begin
frmMain.Enabled := false;
btnExecute.Enabled := false;
{ Selection of the desired EXIF fields are put in the first lines of the file_list.args file }
file_list.Clear;
file_list.Add('-SourceFile');
file_list.Add('-FileModifyDate');
file_list.Add('-FileCreateDate');
file_list.Add('-DateTimeOriginal');
FileCounter := 0;
{ clear all values in Statusbar.Panels }
for var i := 0 to StatusBar.Panels.Count - 1 do
if Odd(i) then // odd Panels are values, even Panels are fixed texts
StatusBar.Panels[i].Text := '';
{ Clear MemTable }
tblImageProperties.Active := false;
tblImageProperties.Active := true;
lvError.Clear;
FileCounter := 0;
frmStatus.FilesMoved := 0;
frmStatus.DuplicateFiles := 0;
frmStatus.FilesProcessed := FileCounter;
frmStatus.FilesDetected := TotalFilesDetected;
frmStatus.TotalFilesDetected := TotalFilesDetected;
frmStatus.Cancel := false;
frmStatus.btnOk.Enabled := false;
frmStatus.btnCancel.Enabled := true;
frmStatus.Caption := 'Scanning...';
frmStatus.Show;
State := stScan;
end;
stScan:
begin
frmStatus.State := State;
case Scan(SourceDir) of // starting directory for Scan
frOk:
begin
frmStatus.FilesProcessed := FileCounter;
State := stGetExif
end;
frCancel:
State := stCancel;
frError:
begin
MessageDlg(SourceDir + StrNoFilesFoundIn, mtInformation,
[mbOk], 0, mbOk);
State := stCancel;
end;
end;
end;
stGetExif:
begin
frmStatus.State := State;
if file_list.Count > 4 then // something to process?
begin
Application.ProcessMessages;
{ EXIFTool works not well with ANSI charset therefore we use UTF8 file_list.args file }
file_list.SaveToFile(FileListName, TEncoding.UTF8);
GetExifData;
btnExecute.Enabled := true;
end
else // ' not found or folder is empty.'
MessageDlg(SourceDir + StrNoFilesFoundIn, mtInformation,
[mbOk], 0, mbOk);
if not frmStatus.Cancel then
State := stCompleting
else
State := stCancel;
end;
stCompleting:
begin
State := stCompleted;
frmStatus.State := State;
frmStatus.ProcessingFile := '';
frmStatus.btnOk.Enabled := true;
frmStatus.btnCancel.Enabled := false;
frmStatus.Hide;
frmStatus.ShowModal;
frmStatus.Hide;
frmMain.Enabled := true;
frmMain.SetFocus;
end;
stCancel:
begin
State := stCompleted;
{ clear all values in Statusbar.Panels }
for var i := 0 to StatusBar.Panels.Count - 1 do
if Odd(i) then // odd Panels are values, even Panels are fixed texts
StatusBar.Panels[i].Text := '';
frmStatus.State := State;
frmStatus.btnOk.Enabled := true;
frmStatus.Hide;
frmMain.Enabled := true;
frmMain.SetFocus;
end;
stCompleted:
;
end; // State Machine
Application.ProcessMessages;
end;
State := stNone;
end;
procedure TfrmMain.Button2Click(Sender: TObject);
// ImageExt, RawExt, WebExt, VideoExt, RemoveExt, OtherExt: string;
// ImageDir, RawDir, WebDir, VideoDir, RemoveDir, NoEXIFDir, OtherDir: string;
begin
frmSettings.LabeledEdit1.Text := ImageExt;
frmSettings.LabeledEdit2.Text := RawExt;
frmSettings.LabeledEdit3.Text := VideoExt;
frmSettings.LabeledEdit4.Text := WebExt;
frmSettings.LabeledEdit5.Text := OtherExt;
frmSettings.LabeledEdit6.Text := RemoveExt;
frmSettings.LabeledEdit7.Text := ImageDir;
frmSettings.LabeledEdit8.Text := RawDir;
frmSettings.LabeledEdit9.Text := VideoDir;
frmSettings.LabeledEdit10.Text := WebDir;
frmSettings.LabeledEdit11.Text := OtherDir;
frmSettings.LabeledEdit12.Text := RemoveDir;
frmSettings.LabeledEdit13.Text := DuplicatesDir;
if frmSettings.ShowModal = mrOk then
begin
ImageExt := frmSettings.LabeledEdit1.Text;
RawExt := frmSettings.LabeledEdit2.Text;
VideoExt := frmSettings.LabeledEdit3.Text;
WebExt := frmSettings.LabeledEdit4.Text;
OtherExt := frmSettings.LabeledEdit5.Text;
RemoveExt := frmSettings.LabeledEdit6.Text;
ImageDir := frmSettings.LabeledEdit7.Text;
RawDir := frmSettings.LabeledEdit8.Text;
VideoDir := frmSettings.LabeledEdit9.Text;
WebDir := frmSettings.LabeledEdit10.Text;
OtherDir := frmSettings.LabeledEdit11.Text;
RemoveDir := frmSettings.LabeledEdit12.Text;
DuplicatesDir := frmSettings.LabeledEdit13.Text;
SaveConfig;
end;
end;
procedure TfrmMain.btnExecuteClick(Sender: TObject);
begin
frmMain.Enabled := false;
frmStatus.Show;
frmStatus.btnOk.Enabled := false;
RestructureDirectory;
btnExecute.Enabled := false;
State := stCompleted;
frmStatus.State := State;
frmStatus.ProcessingFile := '';
frmStatus.btnOk.Enabled := true;
frmStatus.btnCancel.Enabled := false;
frmStatus.Hide;
frmStatus.ShowModal;
frmStatus.Hide;
frmMain.Enabled := true;
frmMain.SetFocus;
end;
function TfrmMain.GetWhatsAppDate(FileName: string): string;
var
Str: string;
Splitted: TArray<String>;
Prefix, ImageDate, ImageName: string;
begin
{ WhatsApp Filename Format: IMG-YYYYMMDD-WAXXXX.jpg
Where YYYY is year, MM is month and DD is day.
The WAXXXX just increments by one for every image taken on the same day, ex. WA0000, WA0001, etc. }
Result := '';
Str := ExtractFileName(FileName);
Splitted := Str.Split(['-'], 3);
If Length(Splitted) = 3 then
begin
Prefix := Splitted[0];
ImageDate := Splitted[1];
ImageName := Splitted[2];
if (Prefix.ToUpper.StartsWith('IMG')) and
(ImageName.ToUpper.StartsWith('WA')) then
Result := ImageDate.Substring(0, 4) + '-' + ImageDate.Substring(4, 2) +
'-' + ImageDate.Substring(6, 2)
end;
end;
function TfrmMain.GetFileType(FileName: string): TFileType;
var
FileExt: string;
begin
FileExt := ExtractFileExt(FileName).ToLower;
if ImageExt.Contains(FileExt) then
Result := ftImage
else if RawExt.Contains(FileExt) then
Result := ftRaw
else if VideoExt.Contains(FileExt) then
Result := ftVideo
else if WebExt.Contains(FileExt) then
Result := ftWeb
else if RemoveExt.Contains(FileExt) then
Result := ftRemove
else if OtherExt.Contains(FileExt) then
Result := ftOther
else
Result := ftNone;
end;
procedure TfrmMain.lvErrorResize(Sender: TObject);
begin
lvError.Columns[0].Width := frmMain.Width - 10;
end;
function TfrmMain.CreateDestName(SourceFile, OriginalDate, OriginalYear,
Directory: string): string;
var
DestFileName: string;
PartialFileName: string;
begin
{ all extensions in lowercase and use jpg as uniform file extension for all jpeg images }
DestFileName := ChangeFileExt(SourceFile, ExtractFileExt(SourceFile)
.ToLower.Replace('jpeg', 'jpg'));
if not OriginalYear.IsEmpty then // Shot date is available
begin
PartialFileName := '\' + Directory + '\' + OriginalYear + '\' + OriginalDate
+ '\' + ExtractFileName(DestFileName);
Case GetFileType(SourceFile) of
ftUndefined:
DestFileName := '';
ftImage:
DestFileName := DestinationDir + ImageDir + PartialFileName;
ftRaw:
DestFileName := DestinationDir + RawDir + PartialFileName;
ftVideo:
DestFileName := DestinationDir + VideoDir + PartialFileName;
ftWeb:
DestFileName := DestinationDir + WebDir + PartialFileName;
ftRemove:
DestFileName := DestinationDir + RemoveDir + PartialFileName;
ftOther:
DestFileName := DestinationDir + OtherDir + PartialFileName;
ftNone:
DestFileName := DestinationDir + OtherDir + PartialFileName;
End
end
else
Case GetFileType(SourceFile) of
ftUndefined:
DestFileName := '';
ftImage:
DestFileName := DestinationDir + NoEXIFDir + '\' +
ExtractFileName(DestFileName);
ftRaw:
DestFileName := DestinationDir + NoEXIFDir + '\' +
ExtractFileName(DestFileName);
ftVideo:
DestFileName := DestinationDir + NoEXIFDir + '\' +
ExtractFileName(DestFileName);
ftWeb:
DestFileName := DestinationDir + NoEXIFDir + '\' +
ExtractFileName(DestFileName);
ftRemove:
DestFileName := DestinationDir + RemoveDir + '\' +
ExtractFileName(DestFileName);
ftOther:
DestFileName := DestinationDir + OtherDir + '\' +
ExtractFileName(DestFileName);
ftNone:
DestFileName := DestinationDir + OtherDir + '\' +
ExtractFileName(DestFileName);
End;
Result := DestFileName;
end;
function TfrmMain.GetExifData: TFunctionResult;
var
cmd: string;
Itm: TListItem;
Output, Errors: TStringlist;
c: integer;
p: string;
begin
Output := TStringlist.Create;
Errors := TStringlist.Create;
c := -1;
{ EXIFTool works not well with ANSI charset therefore we use UTF8 in file_list.args file
Selection of the desired EXIF fields is done in btnStartClick and
put in the first lines of the file_list.args file }
cmd := 'exiftool ' + // exiftool.exe
'-d "%Y-%m-%d" ' + // datetimeformat YYYY-MM-DD
'-j ' + // JSON output
'-fast2 ' + // most efficient for our goal
'-charset FileName=UTF8 ' +
// Filenames in arguments filelist in UTF8 encoding
'-@ ' + FileListName.QuotedString('"');
// Arguments filelist including fields to select
Result := ExecuteExifTool(cmd, Output, Errors);
case Result of
frOk:
begin
if Errors.Count > 0 then
for var i := 0 to Errors.Count - 1 do
begin
Itm := lvError.Items.Add;
Itm.Caption := UTF8ToString(RawByteString(Errors[i]));
end;
if Output.Count > 0 then
begin
CreateReader(UTF8ToString(RawByteString(Output.Text)));
tblImageProperties.DisableControls;
while Reader.read do
case Reader.TokenType of
TJsonToken.startobject:
tblImageProperties.Append;
TJsonToken.StartArray:
;
TJsonToken.PropertyName:
begin
p := Reader.Value.ToString;
if p = 'SourceFile' then
c := 0; // tblImageProperties.Fields[0]
if p = 'FileModifyDate' then
c := 1; // tblImageProperties.Fields[1]
if p = 'FileCreateDate' then
c := 2; // tblImageProperties.Fields[2]
if p = 'DateTimeOriginal' then
c := 3; // tblImageProperties.Fields[3]
end; // TJsonToken.PropertyName
TJsonToken.String:
begin
tblImageProperties.edit;
case c of
// EXIFTool uses Unix style path names
0:
tblImageProperties.Fields[c].AsString :=
Reader.Value.ToString.Replace('/', '\');
1 .. 3:
tblImageProperties.Fields[c].AsString :=
Reader.Value.ToString;
end;
end; // TJsonToken.String
TJsonToken.Integer:
;
TJsonToken.Float:
;
TJsonToken.Boolean:
;
TJsonToken.Null:
;
TJsonToken.EndArray:
;
TJsonToken.EndObject:
begin
tblImageProperties.edit;
{ EXIF data value for DateTimeOriginal available? }
if not tblImagePropertiesDateTimeOriginal.AsString.IsEmpty
then
tblImagePropertiesOriginalDate.AsString :=
tblImagePropertiesDateTimeOriginal.AsString
else
begin
{ WhatsApp image }
tblImagePropertiesOriginalDate.AsString :=
GetWhatsAppDate(tblImagePropertiesSourceFile.AsString);
if tblImagePropertiesOriginalDate.AsString.IsEmpty then
// No WhatsApp Image
{ then use FileCreateDate, not very accurate but better then nothing. }
tblImagePropertiesOriginalDate.AsString :=
tblImagePropertiesFileCreateDate.AsString;
end;
tblImagePropertiesOriginalYear.AsString :=
tblImagePropertiesOriginalDate.AsString.Substring(0, 4);
tblImagePropertiesDirectory.AsString := // yyy0-yyy9
tblImagePropertiesOriginalYear.AsString.Substring(0, 3) +
'0' + '-' + tblImagePropertiesOriginalYear.AsString.
Substring(0, 3) + '9';
tblImagePropertiesDestinationFile.AsString :=
CreateDestName(tblImagePropertiesSourceFile.AsString,
tblImagePropertiesOriginalDate.AsString,
tblImagePropertiesOriginalYear.AsString,
tblImagePropertiesDirectory.AsString);
end; // TJsonToken.EndObject
end; // case Reader.TokenType
tblImageProperties.EnableControls;
end // if Output.Count > 0
end; // case Result = frOk
frError:
ShowMessage('exiftool.exe not found!?');
frCancel:
;
end; // case Result
end;
procedure TfrmMain.RestructureDirectory;
var
i: integer;
DuplicateFiles: integer;
Guid: TGUID;
AltDestFileName: string;
begin
CreateGUID(Guid); // DirectoryName for duplicate files in BaseDir\duplicates
DuplicateFiles := 0;
i := 0;
StatusBar.Panels[5].Text := i.ToString;
StatusBar.Panels[9].Text := '';
frmStatus.FilesMoved := i;
frmStatus.ProcessingFile := '';
frmStatus.State := stRestructure;
frmStatus.btnCancel.Enabled := true;
case rgFileAction.ItemIndex of
0:
frmStatus.Caption := 'Performing file moving...';
1:
frmStatus.Caption := 'Performing File Copying...';
end;
Application.ProcessMessages;
tblImageProperties.First;
while not tblImageProperties.eof and not frmStatus.Cancel do
begin
Inc(i);
StatusBar.Panels[5].Text := i.ToString;
StatusBar.Panels[9].Text :=
TruncateFileName(tblImagePropertiesSourceFile.AsString,
StatusBar.Panels[9].Width div 9);
frmStatus.FilesMoved := i;
frmStatus.ProcessingFile := tblImagePropertiesSourceFile.AsString;
frmStatus.Progress := i;
// Creates a new directory, including the creation of parent directories as needed
if not System.SysUtils.ForceDirectories
(ExtractFilePath(tblImagePropertiesDestinationFile.AsString)) then
raise Exception.Create
(ExtractFilePath(tblImagePropertiesDestinationFile.AsString));
if not FileExists(tblImagePropertiesDestinationFile.AsString) then
case rgFileAction.ItemIndex of
0:
TFile.Move(tblImagePropertiesSourceFile.AsString,
tblImagePropertiesDestinationFile.AsString);
1:
TFile.Copy(tblImagePropertiesSourceFile.AsString,
tblImagePropertiesDestinationFile.AsString);
end
else
begin
Inc(DuplicateFiles);
StatusBar.Panels[7].Text := DuplicateFiles.ToString;
frmStatus.DuplicateFiles := DuplicateFiles;
AltDestFileName := DestinationDir + 'duplicatesDir' + '\' +
GUIDToString(Guid) + '\' + Format('%.5d-', [DuplicateFiles]) +
ExtractFileName(tblImagePropertiesDestinationFile.AsString);
if not System.SysUtils.ForceDirectories(ExtractFilePath(AltDestFileName))
then
raise Exception.Create(ExtractFilePath(AltDestFileName));
case rgFileAction.ItemIndex of
0:
TFile.Move(tblImagePropertiesSourceFile.AsString, AltDestFileName);
1:
TFile.Copy(tblImagePropertiesSourceFile.AsString, AltDestFileName);
end;
tblImageProperties.edit;
tblImagePropertiesDuplicate.AsString := AltDestFileName;
tblImageProperties.Post;
end;
Application.ProcessMessages;
tblImageProperties.Next;
end; // while not tblImageProperties.eof and not frmStatus.Cancel
frmStatus.State := stCompleted;
end;
procedure TfrmMain.rgFileActionClick(Sender: TObject);
begin
frmStatus.FileAction := TFileAction(rgFileAction.ItemIndex);
if Assigned(frmStatus) then
StatusBar.Panels[4].Text := FileActionStr[frmStatus.FileAction];
end;
function TfrmMain.Scan(Path: string): TFunctionResult;
{ scans directory for files, recurses for directories found
Path does not have final backslash }
const
Success: integer = 0;
var
f: TSearchRec;
FileName: string;
begin
Result := frError;
if FindFirst(Path + '\*.*', faAnyFile, f) = Success then
begin
repeat // until FindNext(f) <> Success
if (f.Attr and faDirectory) <> 0 then
begin // is directory
if (f.Name[1] <> '.') then
begin // not current or parent directory
Result := Scan(Path + '\' + f.Name); // recurses all sub-directories
end; // if fname not .. or . (ie not this or parent directory)
end // f.attr = faDirectory
else // // is not directory
begin
FileName := Path + '\' + f.Name;
file_list.Add(FileName);
Inc(FileCounter);
end;
Application.ProcessMessages;
until (FindNext(f) <> Success) or frmStatus.Cancel;
if frmStatus.Cancel or (Result = frCancel) then
Result := frCancel
else
Result := frOk;
System.SysUtils.FindClose(f);
{ Show only final values for better performance }
StatusBar.Panels[1].Text := FileCounter.ToString;
StatusBar.Panels[9].Text := TruncateFileName(Path + '\' + f.Name,
(StatusBar.Panels[9].Width - 10) div 9);
frmStatus.FilesProcessed := FileCounter;
frmStatus.ProcessingFile := Path + '\' + f.Name;
end; // FindFirst(Path + '\*.*', faDirectory, f) = Success
end;
initialization
begin
FileListName := TL.Components.Folder.LocalAppData +
'\Langstraat\PicOrg\file_list.args';
if not System.SysUtils.ForceDirectories(ExtractFilePath(FileListName)) then
raise Exception.Create('Can not create: ' + FileListName);
end;
end.
