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.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6776 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpexif/examples/metadata_viewer/MetadataViewer.lpi

@@ -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="2"/>
-        <FormatVersion Value="1"/>
+      <Modes Count="1">
-      </local>
+        <Mode0 Name="default"/>
+      </Modes>
     </RunParams>
     <RequiredPackages Count="2">
       <Item1>

components/fpexif/examples/metadata_viewer/mdvmain.lfm

@@ -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

components/fpexif/examples/metadata_viewer/mdvmain.pas

@@ -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];

components/fpexif/fpeexifreadwrite.pas

@@ -853,10 +853,9 @@ begin
           Continue;
 
         // Offset to the thumbnail image
-        if tag.TagID = FULLTAG_THUMBSTARTOFFSET then begin
+        if tag.TagID = FULLTAG_THUMBSTARTOFFSET then
-          dw := FixEndian32(thumbStartOffset);
+          tag.AsInteger := DWord(thumbStartOffset)
-          tag.AsInteger := dw;
+        else
-        end 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

components/fpexif/fpetags.pas

@@ -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

components/fpexif/tests/multiread/MultiRead_Laz.lpi

@@ -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="2"/>
-        <FormatVersion Value="1"/>
+      <Modes Count="1">
-      </local>
+        <Mode0 Name="default"/>
+      </Modes>
     </RunParams>
     <RequiredPackages Count="1">
       <Item1>

components/fpexif/tests/multiread/common/mrtmain.lfm

@@ -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

components/fpexif/tests/multiread/common/mrtmain.pas

@@ -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;

components/fpexif/tests/pictures/originals/images_origin.txt

@@ -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