pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpexif: Fix crash when writing big-endian file with thumbnail (see https://forum.lazarus.freepascal.org/index.php/topic,43714). Add button for changing EXIF date/time to MetadataViewer.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6776 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-12-29 13:15:37 +00:00
parent 3662758e92
commit 4cc8928508
11 changed files with 135 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
components/fpexif/examples/metadata_viewer/MetadataViewer.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="10"/>
<Version Value="11"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
@ -18,9 +18,10 @@
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default"/>
</Modes>
</RunParams>
<RequiredPackages Count="2">
<Item1>

67
components/fpexif/examples/metadata_viewer/mdvmain.lfm
View File

@ -8,7 +8,7 @@ object MainForm: TMainForm
ClientWidth = 926
OnCreate = FormCreate
OnDestroy = FormDestroy
LCLVersion = '1.9.0.0'
LCLVersion = '2.1.0.0'
object ShellPanel: TPanel
Left = 0
Height = 691
@ -112,7 +112,7 @@ object MainForm: TMainForm
end
object PageControl1: TPageControl
Left = 0
Height = 573
Height = 539
Top = 23
Width = 647
ActivePage = PgMetadata
@ -122,11 +122,11 @@ object MainForm: TMainForm
OnChange = PageControl1Change
object PgMetadata: TTabSheet
Caption = 'Meta data'
ClientHeight = 545
ClientHeight = 511
ClientWidth = 639
object TagListView: TListView
Left = 0
Height = 525
Height = 491
Top = 0
Width = 639
Align = alClient
@ -158,7 +158,7 @@ object MainForm: TMainForm
object Panel1: TPanel
Left = 0
Height = 20
Top = 525
Top = 491
Width = 639
Align = alBottom
AutoSize = True
@ -201,7 +201,7 @@ object MainForm: TMainForm
object Messages: TMemo
Left = 4
Height = 90
Top = 596
Top = 567
Width = 639
Align = alBottom
BorderSpacing.Left = 4
@ -212,11 +212,64 @@ object MainForm: TMainForm
Cursor = crVSplit
Left = 0
Height = 5
Top = 686
Top = 562
Width = 647
Align = alBottom
ResizeAnchor = akBottom
end
object DateTimePanel: TPanel
Left = 0
Height = 34
Top = 657
Width = 647
Align = alBottom
AutoSize = True
BevelOuter = bvNone
ClientHeight = 34
ClientWidth = 647
TabOrder = 4
object LblChangeDate: TLabel
AnchorSideLeft.Control = DateTimePanel
AnchorSideTop.Control = EdChangeDate
AnchorSideTop.Side = asrCenter
Left = 4
Height = 15
Top = 10
Width = 135
BorderSpacing.Left = 4
Caption = 'Change EXIF date/time to'
ParentColor = False
end
object EdChangeDate: TEdit
AnchorSideLeft.Control = LblChangeDate
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = DateTimePanel
AnchorSideTop.Side = asrCenter
Left = 144
Height = 23
Top = 6
Width = 152
BorderSpacing.Left = 5
BorderSpacing.Bottom = 4
TabOrder = 0
end
object BtnChangeDate: TButton
AnchorSideLeft.Control = EdChangeDate
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = EdChangeDate
AnchorSideTop.Side = asrCenter
Left = 304
Height = 25
Top = 5
Width = 66
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Bottom = 4
Caption = 'Execute'
OnClick = BtnChangeDateClick
TabOrder = 1
end
end
end
object StatusBar1: TStatusBar
Left = 0

49
components/fpexif/examples/metadata_viewer/mdvmain.pas
View File

@ -14,14 +14,18 @@ type
{ TMainForm }
TMainForm = class(TForm)
BtnChangeDate: TButton;
CbDecodeMakerNotes: TCheckBox;
EdChangeDate: TEdit;
FilenameInfo: TLabel;
Image: TImage;
LblChangeDate: TLabel;
Messages: TMemo;
PageControl1: TPageControl;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
DateTimePanel: TPanel;
PreviewImage: TImage;
ImageList: TImageList;
Splitter3: TSplitter;
@ -34,6 +38,7 @@ type
ShellTreeView: TShellTreeView;
Splitter1: TSplitter;
Splitter2: TSplitter;
procedure BtnChangeDateClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PageControl1Change(Sender: TObject);
@ -66,7 +71,7 @@ implementation
{$R *.lfm}
uses
IniFiles, Math, StrUtils,
IniFiles, Math, StrUtils, DateUtils,
fpeGlobal, fpeTags, fpeExifData, fpeIptcData;
@ -88,6 +93,37 @@ begin
//ShellListView.Parent.DoubleBuffered := true;
end;
procedure TMainForm.BtnChangeDateClick(Sender: TObject);
var
lTag: TTag;
dt: TDateTime;
fn: String;
begin
if (FImgInfo = nil) or (FImgInfo.ExifData = nil) then
exit;
if not TryStrToDateTime(EdChangeDate.Text, dt) then begin
MessageDlg('No valid date/time. Use your locale settings.', mtError, [mbOK], 0);
exit;
end;
lTag := FImgInfo.ExifData.TagByName['DateTimeOriginal'];
if lTag <> nil then
TDateTimeTag(lTag).AsDateTime := dt;
lTag := FImgInfo.ExifData.TagByName['DateTimeDigitized'];
if lTag <> nil then
TDateTimeTag(lTag).AsDateTime := dt;
lTag := FImgInfo.ExifData.TagByName['DateTime'];
if lTag <> nil then
TDateTimeTag(lTag).AsDateTime := dt;
fn := FImgInfo.FileName;
fn := ChangeFileExt(fn, '') + '_modified' + ExtractFileExt(fn);
FImgInfo.SaveToFile(fn);
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
try
@ -136,7 +172,16 @@ begin
item.SubItems.Add(lTag.Description);
item.SubItems.Add(lTag.AsString);
end;
end;
lTag := FImgInfo.ExifData.TagByName['DateTimeOriginal'];
if lTag <> nil then
EdChangeDate.Text := DateTimeToStr(TDateTimeTag(lTag).AsDateTime)
else
EdChangeDate.Text := '';
DateTimePanel.Show;
end else
DateTimePanel.Hide;
if FImgInfo.HasIptc then begin
for i := 0 to FImgInfo.IptcData.TagCount-1 do begin
lTag := FImgInfo.IptcData.TagByIndex[i];

7
components/fpexif/fpeexifreadwrite.pas
View File

@ -853,10 +853,9 @@ begin
Continue;
// Offset to the thumbnail image
if tag.TagID = FULLTAG_THUMBSTARTOFFSET then begin
dw := FixEndian32(thumbStartOffset);
tag.AsInteger := dw;
end else
if tag.TagID = FULLTAG_THUMBSTARTOFFSET then
tag.AsInteger := DWord(thumbStartOffset)
else
// Some tags will link to subdirectories. The offset to the start of
// a subdirectory must be specified in the DataValue field of the
// written ifd record. Since it is not clear at this moment where the

6
components/fpexif/fpetags.pas
View File

@ -1059,7 +1059,8 @@ begin
else
raise EFpExif.CreateFmt('Value %d out of range for tag "%s"', [AValue, FName]);
ttUInt16:
if not WithRangeCheck or ((AValue >= 0) and (AValue <= 65535)) then begin
if not WithRangeCheck or ((AValue >= 0) and (AValue <= 65535)) then
begin
if BigEndian then
w := NtoBE(PWord(@AValue)^)
else
@ -1069,7 +1070,8 @@ begin
raise EFpExif.CreateFmt('Value %d out of range for tag "%s"', [AValue, FName]);
ttUInt32,
ttIFD:
if not WithRangeCheck or (AValue >= 0) then begin
if not WithRangeCheck or (AValue >= 0) then
begin
if BigEndian then
dw := NtoBE(PDWord(@AValue)^)
else

9
components/fpexif/tests/multiread/MultiRead_Laz.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="10"/>
<Version Value="11"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
@ -18,9 +18,10 @@
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default"/>
</Modes>
</RunParams>
<RequiredPackages Count="1">
<Item1>

BIN
components/fpexif/tests/multiread/MultiRead_Laz.res
View File

Binary file not shown.

2
components/fpexif/tests/multiread/common/mrtmain.lfm
View File

@ -8,7 +8,7 @@ object MainForm: TMainForm
ClientHeight = 560
ClientWidth = 1024
OnCreate = FormCreate
LCLVersion = '1.9.0.0'
LCLVersion = '2.1.0.0'
object Panel1: TPanel
Left = 0
Height = 33

1
components/fpexif/tests/multiread/common/mrtmain.pas
View File

@ -217,6 +217,7 @@ begin
end else
node.ImageIndex := IMG_INDEX_EXIF;
node.SelectedIndex := node.ImageIndex;
node.StateIndex := IMG_CHECKED;
node := node.GetNextSibling;
end;
end;

9
components/fpexif/tests/pictures/originals/images_origin.txt Normal file
View File

@ -0,0 +1,9 @@
This file lists the origin of the used images:
no_metadata.jpg .... created by fpc code
with_exif.jpg ...... created by fpc code, with EXIF (little endian)
with_exif.tif ...... dto.
with_iptc.jpg ...... created by fpc code, with IPTC
with iptc.tif ...... dto.
ExThBE_Nokia.jpg ... author's own picture taken by a Nokia smartphone
with EXIF (big-endian), with thumbnail image

BIN
components/fpexif/tests/readwrite/ReadWriteTest_Laz.res
View File

Binary file not shown.