You've already forked lazarus-ccr
4cc8928508
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6776 8e941d3f-bd1b-0410-a28a-d453659cc2b4
541 lines
15 KiB
ObjectPascal
541 lines
15 KiB
ObjectPascal
unit mrtmain;
|
|
|
|
{$IFDEF FPC}
|
|
{$mode objfpc}{$H+}
|
|
{$ENDIF}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF FPC}
|
|
FileUtil,
|
|
{$ELSE}
|
|
Windows, ImgList, {$IFDEF UNICODE}ImageList,{$ENDIF}
|
|
{$ENDIF}
|
|
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
|
ComCtrls, ExtCtrls,
|
|
fpeMetaData;
|
|
|
|
type
|
|
|
|
{ TMainForm }
|
|
|
|
TMainForm = class(TForm)
|
|
Bevel1: TBevel;
|
|
Bevel2: TBevel;
|
|
BtnReadFiles: TButton;
|
|
BtnCreateTxtFiles: TButton;
|
|
BtnRunTest: TButton;
|
|
BtnUncheckAll: TButton;
|
|
BtnCheckAll: TButton;
|
|
EdImageDir: TEdit;
|
|
StateImages: TImageList;
|
|
MismatchInfo: TLabel;
|
|
Memo: TMemo;
|
|
Panel1: TPanel;
|
|
Panel2: TPanel;
|
|
Panel3: TPanel;
|
|
FileTreeView: TTreeView;
|
|
Panel4: TPanel;
|
|
Panel5: TPanel;
|
|
Splitter1: TSplitter;
|
|
ImageList1: TImageList;
|
|
BtnInfo: TButton;
|
|
procedure BtnInfoClick(Sender: TObject);
|
|
procedure BtnReadFilesClick(Sender: TObject);
|
|
procedure BtnRunTestClick(Sender: TObject);
|
|
procedure BtnCreateTxtFilesClick(Sender: TObject);
|
|
procedure BtnUncheckAllClick(Sender: TObject);
|
|
procedure InfoClick(Sender: TObject);
|
|
procedure FileTreeViewClick(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
private
|
|
FTotalCount: Integer;
|
|
FMismatchCount: Integer;
|
|
function CreateRefTags(ANode: TTreeNode; AFileName: String): Boolean;
|
|
function ExtractRefTags(ANode: TTreeNode; AList: TStringList): Boolean;
|
|
function GetImageDir: String;
|
|
procedure Log(AMsg: String);
|
|
procedure RunTest(ANode: TTreeNode);
|
|
public
|
|
|
|
end;
|
|
|
|
var
|
|
MainForm: TMainForm;
|
|
|
|
implementation
|
|
|
|
{$IFDEF FPC}
|
|
{$R *.lfm}
|
|
{$ELSE}
|
|
{$R *.dfm}
|
|
{$ENDIF}
|
|
|
|
uses
|
|
{$IFDEF FPC}
|
|
Process, StrUtils,
|
|
{$ELSE}
|
|
ShellApi,
|
|
{$ENDIF}
|
|
fpeGlobal, fpeUtils, fpeTags, fpeExifData;
|
|
|
|
{ TMainForm }
|
|
|
|
const
|
|
EXIFTOOL_CMD = '..\..\tools\exiftool.exe';
|
|
|
|
IMG_INDEX_WORKING = 0;
|
|
IMG_INDEX_FAIL = 1;
|
|
IMG_INDEX_IGNORE = 1;
|
|
IMG_INDEX_EXIF = 2;
|
|
IMG_INDEX_SUCCESS = 3;
|
|
|
|
IMG_UNCHECKED = 2; //0;
|
|
IMG_CHECKED = 1;
|
|
|
|
{ Finds all image files in the image folder (--> GetImageDir). For every image
|
|
there is a text file containing the meta data written by ExifTool. Reads this
|
|
reference file and stores the meta data in the nodes af the FileTreeView. }
|
|
procedure TMainForm.BtnReadFilesClick(Sender: TObject);
|
|
var
|
|
info: TSearchRec;
|
|
imgDir: String;
|
|
node: TTreeNode;
|
|
tagFile: String;
|
|
L: TStringList;
|
|
s: String;
|
|
begin
|
|
FileTreeView.Items.Clear;
|
|
imgDir := GetImageDir;
|
|
if FindFirst(imgDir + '*.jpg', faAnyFile and faDirectory, info) = 0 then
|
|
begin
|
|
repeat
|
|
if (info.Name <> '.') and (info.Name <> '..') and (info.Attr and faDirectory = 0) then
|
|
begin
|
|
node := FileTreeview.Items.AddChild(nil, ExtractFileName(info.Name));
|
|
node.ImageIndex := IMG_INDEX_IGNORE;
|
|
tagFile := ChangeFileExt(imgDir + info.Name, '.txt');
|
|
if FileExists(tagFile) then
|
|
begin
|
|
L := TStringList.Create;
|
|
try
|
|
L.LoadFromFile(tagFile);
|
|
// Note: ExifTool wrote the file in UTF8 --> We must convert this for Delphi
|
|
{$IFNDEF FPC}
|
|
{$IFDEF UNICODE}
|
|
L.Text := UTF8Decode(L.Text);
|
|
{$ELSE}
|
|
s := L.Text;
|
|
// s := UTF8Decode(s);
|
|
s := fpeUtils.UTF8ToAnsi(s);
|
|
L.Text := s;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
if ExtractRefTags(node, L) then begin
|
|
node.ImageIndex := IMG_INDEX_EXIF;
|
|
node.StateIndex := IMG_CHECKED;
|
|
end;
|
|
finally
|
|
L.Free;
|
|
end;
|
|
end;
|
|
node.SelectedIndex := node.ImageIndex;
|
|
end;
|
|
until FindNext(info) <> 0;
|
|
end;
|
|
FindClose(info);
|
|
end;
|
|
|
|
procedure TMainForm.BtnRunTestClick(Sender: TObject);
|
|
var
|
|
node: TTreeNode;
|
|
begin
|
|
Memo.Lines.Clear;
|
|
FMismatchCount := 0;
|
|
FTotalCount := 0;
|
|
node := FileTreeView.Items.GetFirstNode;
|
|
while node <> nil do begin
|
|
RunTest(node);
|
|
node := node.GetNextSibling;
|
|
end;
|
|
MismatchInfo.Caption := Format('%d mismatches out of %d tests (%.0f%%)', [
|
|
FMismatchCount, FTotalCount, FMismatchCount/FTotalCount*100]);
|
|
MismatchInfo.Show;
|
|
end;
|
|
|
|
procedure TMainForm.BtnUncheckAllClick(Sender: TObject);
|
|
var
|
|
node: TTreeNode;
|
|
checkNode: Boolean;
|
|
begin
|
|
checkNode := (Sender = BtnCheckAll);
|
|
node := FileTreeView.Items.GetFirstNode;
|
|
while node <> nil do begin
|
|
if checkNode and (node.StateIndex = IMG_UNCHECKED) then
|
|
node.StateIndex := IMG_CHECKED
|
|
else if not checkNode and (node.StateIndex = IMG_CHECKED) then
|
|
node.StateIndex := IMG_UNCHECKED;
|
|
node := node.GetNextSibling;
|
|
end;
|
|
end;
|
|
|
|
procedure TMainForm.InfoClick(Sender: TObject);
|
|
begin
|
|
Memo.Lines.LoadfromFile('readme.txt');
|
|
end;
|
|
|
|
procedure TMainForm.BtnCreateTxtFilesClick(Sender: TObject);
|
|
var
|
|
imgDir: String;
|
|
node: TTreeNode;
|
|
begin
|
|
if not FileExists(EXIFTOOL_CMD) then
|
|
begin
|
|
MessageDlg(Format('Program "ExifTool" not found in folder "%s".', [
|
|
ExtractFileDir(ExpandFilename(EXIFTOOL_CMD))
|
|
]), mtError, [mbOK], 0
|
|
);
|
|
exit;
|
|
end;
|
|
|
|
imgDir := GetImageDir;
|
|
|
|
node := FileTreeView.Items.GetFirstNode;
|
|
while (node <> nil) do begin
|
|
node.DeleteChildren;
|
|
node.ImageIndex := -1;
|
|
node := node.GetNextSibling;
|
|
end;
|
|
|
|
node := FileTreeView.Items.GetFirstNode;
|
|
while (node <> nil) do begin
|
|
node.ImageIndex := IMG_INDEX_WORKING;
|
|
Application.ProcessMessages;
|
|
if not CreateRefTags(node, imgDir + node.Text) then begin
|
|
node.ImageIndex := IMG_INDEX_IGNORE;
|
|
end else
|
|
node.ImageIndex := IMG_INDEX_EXIF;
|
|
node.SelectedIndex := node.ImageIndex;
|
|
node.StateIndex := IMG_CHECKED;
|
|
node := node.GetNextSibling;
|
|
end;
|
|
end;
|
|
|
|
procedure TMainForm.BtnInfoClick(Sender: TObject);
|
|
begin
|
|
Memo.Lines.LoadFromFile('readme.txt');
|
|
end;
|
|
|
|
function TMainForm.CreateRefTags(ANode: TTreeNode; AFileName: String): Boolean;
|
|
var
|
|
destFile: String;
|
|
output: String;
|
|
L: TStringList;
|
|
{$IFNDEF FPC}
|
|
params: String;
|
|
res: Integer;
|
|
s: String;
|
|
const
|
|
DEG_SYMBOL: ansistring = #176;
|
|
{$ENDIF}
|
|
begin
|
|
Result := false;
|
|
destFile := ChangeFileExt(AFileName, '.txt');
|
|
|
|
{$IFDEF FPC}
|
|
if RunCommand(EXIFTOOL_CMD, ['-a', '-H', '-s', '-G', '-c', '"%d° %d'' %.2f"\"', AFileName], output) then
|
|
// -a ... extract all tags, also duplicates.
|
|
// -H ... extract hex tag id if possible
|
|
// -s ... short tag name (hopefully this is the dExif tag name)
|
|
// -G ... print group name for each tag
|
|
// -c ... format for GPS coordinates
|
|
begin
|
|
if (output = '') then
|
|
exit;
|
|
|
|
L := TStringList.Create;
|
|
try
|
|
L.Text := output;
|
|
if ExtractReftags(ANode, L) then
|
|
ANode.ImageIndex := IMG_INDEX_EXIF else
|
|
ANode.ImageIndex := IMG_INDEX_IGNORE;
|
|
ANode.SelectedIndex := ANode.ImageIndex;
|
|
L.SaveToFile(destFile);
|
|
Result := true;
|
|
finally
|
|
L.Free;
|
|
end;
|
|
end;
|
|
{$ELSE}
|
|
// params := '/c ' + EXIFTOOL_CMD + ' -a -H -s -G -c "%d' + DEG_SYMBOL + ' %d'' %.2f"\"' + AFileName + ' > ' + destFile;
|
|
params := '/c ' + EXIFTOOL_CMD + ' -a -H -s -G -c "%d° %d'' %.2f"\"' + AFileName + ' > ' + destFile;
|
|
res := ShellExecute(Application.Handle, 'open', PChar('cmd'), PChar(params), '', SW_HIDE);
|
|
if (res <= 32) or not FileExists(destFile) then
|
|
exit;
|
|
L := TStringList.Create;
|
|
try
|
|
L.LoadFromFile(destFile);
|
|
// Note: ExifTool wrote the file in UTF8 --> We must convert this for Delphi
|
|
{$IFDEF UNICODE}
|
|
L.Text := UTF8Decode(L.Text);
|
|
{$ELSE}
|
|
s := UTF8ToAnsi(L.Text);
|
|
L.Text := s;
|
|
{$ENDIF}
|
|
if ExtractRefTags(ANode, L) then
|
|
ANode.ImageIndex := IMG_INDEX_EXIF else
|
|
ANode.ImageIndex := IMG_INDEX_IGNORE;
|
|
ANode.SelectedIndex := ANode.ImageIndex;
|
|
Result := true;
|
|
finally
|
|
L.Free;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TMainForm.ExtractRefTags(ANode: TTreeNode; AList: TStringList): Boolean;
|
|
const
|
|
GROUP_START = 1;
|
|
GROUP_LEN = 15;
|
|
TAGID_START = 19;
|
|
TAGID_LEN = 4;
|
|
NAME_START = 24;
|
|
NAME_LEN = 32;
|
|
VALUE_START = 58;
|
|
var
|
|
i: Integer;
|
|
p: Integer;
|
|
s: String;
|
|
sGroup: String;
|
|
sTagID: String;
|
|
sTagName: String;
|
|
sTagValue: String;
|
|
tagID: Word;
|
|
node: TTreeNode;
|
|
begin
|
|
Result := false;
|
|
for i:=0 to AList.Count-1 do begin
|
|
s := AList[i];
|
|
sGroup := trim(Copy(s, GROUP_START, GROUP_LEN));
|
|
sTagID := trim(Copy(s, TAGID_START, TAGID_LEN));
|
|
sTagName := trim(Copy(s, NAME_START, NAME_LEN));
|
|
sTagValue := trim(Copy(s, VALUE_START, MaxInt));
|
|
|
|
if sTagID = '-' then
|
|
Continue;
|
|
|
|
// So far, consider only EXIF-Tag
|
|
if sGroup <> '[EXIF]' then
|
|
Continue;
|
|
|
|
tagID := StrToInt('$' + sTagID);
|
|
node := ANode.Owner.AddChild(ANode, sTagName + ': ' + sTagValue);
|
|
node.Data := Pointer(PtrInt(tagID));
|
|
end;
|
|
Result := ANode.Count > 0;
|
|
end;
|
|
|
|
procedure TMainForm.FileTreeViewClick(Sender: TObject);
|
|
var
|
|
P: TPoint;
|
|
ht: THitTests;
|
|
node: TTreeNode;
|
|
begin
|
|
P := FileTreeView.ScreenToClient(Mouse.CursorPos);
|
|
ht := FileTreeView.GetHitTestInfoAt(P.X, P.Y);
|
|
if htOnStateIcon in ht then begin
|
|
node := FileTreeView.GetNodeAt(P.X, P.Y);
|
|
if node.StateIndex = IMG_CHECKED then
|
|
node.StateIndex := IMG_UNCHECKED else
|
|
node.StateIndex := IMG_CHECKED;
|
|
end;
|
|
end;
|
|
|
|
procedure TMainForm.FormCreate(Sender: TObject);
|
|
begin
|
|
fpExifFmtSettings.ListSeparator := ' ';
|
|
if EdImageDir.Text <> '' then
|
|
BtnReadFilesClick(nil);
|
|
end;
|
|
|
|
function TMainForm.GetImageDir: String;
|
|
begin
|
|
Result := IncludeTrailingPathDelimiter(ExpandFilename(EdImageDir.Text));
|
|
Caption := Result;
|
|
end;
|
|
|
|
procedure TMainForm.Log(AMsg: String);
|
|
begin
|
|
Memo.Lines.Add(AMsg);
|
|
Memo.SelStart := Length(Memo.Lines.Text);
|
|
end;
|
|
|
|
{ Loads the image file represented by the specified node, reads the meta data,
|
|
and compares with the reference file. }
|
|
procedure TMainForm.RunTest(ANode: TTreeNode);
|
|
const
|
|
{$IFDEF FPC}
|
|
GPS_MASK = '%0:.0f° %1:.0f'' %2:.2f"';
|
|
{$ELSE}
|
|
{$IFDEF UNICODE}
|
|
GPS_MASK = '%0:.0f° %1:.0f'' %2:.2f"';
|
|
{$ELSE}
|
|
GPS_MASK = '%0:.0f'#176' %1:.0f'' %2:.2f"';
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
var
|
|
imgInfo: TImgInfo;
|
|
tagName: String;
|
|
uctagname: String;
|
|
expectedTagValue: String;
|
|
currTagValue: String;
|
|
s: String;
|
|
p: Integer;
|
|
node: TTreeNode;
|
|
tagID: TTagID;
|
|
lTag: TTag;
|
|
lTagDef: TTagDef;
|
|
// v: Variant;
|
|
offs: Int64;
|
|
localMismatchCount: Integer;
|
|
begin
|
|
if ANode.StateIndex = IMG_UNCHECKED then
|
|
exit;
|
|
|
|
if ANode.Count = 0 then begin
|
|
Log('Skipping image "' + ANode.Text + '":');
|
|
Log(' No EXIF data found by ExifTool.');
|
|
Log('');
|
|
exit;
|
|
end;
|
|
|
|
localMismatchCount := 0;
|
|
Log('Testing image "' + ANode.Text + '":');
|
|
imgInfo := TImgInfo.Create;
|
|
try
|
|
imgInfo.LoadFromFile(GetImageDir + ANode.Text);
|
|
if not imgInfo.HasExif then begin
|
|
Log('Skipping "' + ANode.Text + '":');
|
|
Log(' No EXIF data found by fpExif.');
|
|
Log('');
|
|
exit;
|
|
end;
|
|
|
|
node := ANode.GetFirstChild;
|
|
while node <> nil do begin
|
|
s := node.Text;
|
|
p := pos(':', s);
|
|
if p = 0 then begin
|
|
node := node.GetNextSibling;
|
|
Log(' Skipping tag "' + s + '": Has no value');
|
|
continue;
|
|
end;
|
|
|
|
tagName := trim(Copy(s, 1, p-1));
|
|
uctagName := Uppercase(tagName);
|
|
|
|
lTagDef := FindExifTagDefWithoutParent(PtrInt(node.Data));
|
|
if lTagDef = nil then begin
|
|
Log(' Skipping tag "' + tagName + '": tag definition not found.');
|
|
node := node.GetNextSibling;
|
|
Continue;
|
|
end;
|
|
tagID := lTagDef.TagID;
|
|
|
|
if (tagID = TAGPARENT_EXIF + $EA1C) then begin // "Padding"
|
|
Log(Format(' Skipping tag "%s" ($%.4x): no useful data', [tagName, TTagIDRec(tagID).Tag]));
|
|
node := node.GetNextSibling;
|
|
Continue;
|
|
end;
|
|
|
|
lTag := imgInfo.ExifData.FindTagByID(tagID);
|
|
if lTag = nil then begin
|
|
Log(Format('Tag "%s (ID $%.04x) not found.', [tagName, TTagIDRec(tagID).Tag]));
|
|
node := node.GetNextSibling;
|
|
continue;
|
|
end;
|
|
|
|
// Modify fpExif's tag format to match that used by ExifTool.
|
|
case lTag.TagID of
|
|
TAGPARENT_GPS + $0000: // GPSVersionID
|
|
lTag.ListSeparator := '.';
|
|
TAGPARENT_EXIF + $9102, // CompressedBitsPerPixel
|
|
TAGPARENT_EXIF + $A20E, // FocalPlaneXResolution
|
|
TAGPARENT_EXIF + $A20F: // FocalPlaneYResolution
|
|
if lTag is TFloatTag then TFloatTag(lTag).FormatStr := '%2:.3f';
|
|
TAGPARENT_EXIF + $A405: // FocalLengthIn35mmFilm
|
|
if lTag is TIntegerTag then TFloatTag(lTag).FormatStr := '%d mm';
|
|
else
|
|
if lTag is TDateTimeTag then
|
|
TDateTimeTag(lTag).FormatStr := EXIF_DATETIME_FORMAT
|
|
else
|
|
if lTag is TGpsPositionTag then
|
|
TGpsPositionTag(lTag).FormatStr := GPS_MASK
|
|
else
|
|
if ltag is TExposureTimeTag then
|
|
TExposureTimeTag(ltag).FormatStr := '1/%.0f;%.0f' // to do: use rational values
|
|
else
|
|
if (lTag is TFloatTag) and
|
|
((ucTagName = 'FNUMBER') or (pos('APERTURE', ucTagName) > 0))
|
|
then
|
|
TFloatTag(lTag).FormatStr := '%2:.1f';
|
|
end;
|
|
|
|
currTagValue := trim(lTag.AsString);
|
|
expectedTagvalue := Copy(s, p+1, MaxInt);
|
|
p := pos(' -->', expectedTagValue);
|
|
if p > 0 then SetLength(expectedTagValue, p);
|
|
expectedTagValue := trim(expectedTagValue);
|
|
|
|
case lTag.TagID of
|
|
TAGPARENT_INTEROP + $0001: // InteropIndex
|
|
if pos('INTEROP', ucTagName) <> 0 then
|
|
expectedTagValue := FirstWord(expectedTagValue);
|
|
TAGPARENT_EXIF + $9101: // ComponentsConfiguration
|
|
expectedTagValue := LettersOnly(expectedTagValue);
|
|
TAGPARENT_EXIF + $9102, // CompressedBitsPerPixel
|
|
TAGPARENT_EXIF + $A20E, // FocalPlaneXResolution
|
|
TAGPARENT_EXIF + $A20F: // FocalPlaneYResolution
|
|
expectedTagValue := Format('%.3f', [StrToFloat(expectedTagValue, fpExifFmtSettings)], fpExifFmtSettings);
|
|
else
|
|
if (lTag is TIntegerTag) and (pos(';', currTagValue) > 0) then
|
|
// currTagValue := ReplaceText(currTagValue, ';', ',')
|
|
currTagValue := StringReplace(currTagValue, ';', ',', [rfReplaceAll])
|
|
else
|
|
if (lTag is TOffsetTag) then begin
|
|
offs := StrToInt(currTagValue);
|
|
currTagValue := IntToStr(offs + TOffsetTag(lTag).TiffHeaderOffset);
|
|
end;
|
|
end;
|
|
|
|
if SameText(expectedTagValue, currTagValue) then
|
|
node.ImageIndex := IMG_INDEX_SUCCESS
|
|
else begin
|
|
Log(' Tag mismatch "' + Format('[$%.4x] %s', [TTagIDRec(tagID).Tag, tagName]) + '"');
|
|
Log(' expected: ' + expectedTagValue);
|
|
Log(' found: ' + currTagValue);
|
|
node.ImageIndex := IMG_INDEX_FAIL;
|
|
node.Text := tagname + ': ' + expectedTagValue + ' --> found: ' + currTagValue;
|
|
inc(FMismatchCount);
|
|
inc(localMismatchCount);
|
|
end;
|
|
node.SelectedIndex := node.ImageIndex;
|
|
|
|
node := node.GetNextSibling;
|
|
inc(FTotalCount);
|
|
end;
|
|
if localMismatchCount = 0 then
|
|
Log(' All tags matching');
|
|
finally
|
|
Log('');
|
|
imgInfo.Free;
|
|
end;
|
|
|
|
FileTreeView.Invalidate;
|
|
|
|
end;
|
|
|
|
end.
|
|
|