fpexif: Fix crash when the image file contains xmp data with invalid xml structure (missing first '<')

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

components/fpexif/examples/metadata_viewer/mdvmain.lfm

@@ -6,10 +6,10 @@ object MainForm: TMainForm
   Caption = 'Metadata viewer'
   ClientHeight = 714
   ClientWidth = 926
+  ShowHint = True
+  LCLVersion = '3.99.0.0'
   OnCreate = FormCreate
   OnDestroy = FormDestroy
-  ShowHint = True
-  LCLVersion = '2.3.0.0'
   object ShellPanel: TPanel
     Left = 0
     Height = 691
@@ -31,11 +31,11 @@ object MainForm: TMainForm
       HideSelection = False
       ReadOnly = True
       TabOrder = 0
-      OnGetImageIndex = ShellTreeViewGetImageIndex
-      OnSelectionChanged = ShellTreeViewSelectionChanged
       Options = [tvoAutoItemHeight, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw]
       ObjectTypes = [otFolders]
       ShellListView = ShellListView
+      OnGetImageIndex = ShellTreeViewGetImageIndex
+      OnSelectionChanged = ShellTreeViewSelectionChanged
     end
     object Splitter1: TSplitter
       Cursor = crVSplit
@@ -59,9 +59,9 @@ object MainForm: TMainForm
       ReadOnly = True
       SortColumn = 0
       TabOrder = 2
-      OnSelectItem = ShellListViewSelectItem
       ObjectTypes = [otNonFolders]
       ShellTreeView = ShellTreeView
+      OnSelectItem = ShellListViewSelectItem
     end
     object PreviewImage: TImage
       Left = 0
@@ -136,16 +136,16 @@ object MainForm: TMainForm
         Caption = 'File: '
       end
     end
-    object PageControl1: TPageControl
+    object PageControl: TPageControl
       Left = 0
       Height = 539
       Top = 23
       Width = 647
-      ActivePage = PgXMP
+      ActivePage = PgMetadata
       Align = alClient
-      TabIndex = 1
+      TabIndex = 0
       TabOrder = 1
-      OnChange = PageControl1Change
+      OnChange = PageControlChange
       object PgMetadata: TTabSheet
         Caption = 'EXIF, IPTC'
         ClientHeight = 511
@@ -223,9 +223,9 @@ object MainForm: TMainForm
             BorderSpacing.Left = 8
             Caption = 'Show tag IDs'
             Checked = True
-            OnChange = CbShowTagIDsChange
             State = cbChecked
             TabOrder = 1
+            OnChange = CbShowTagIDsChange
           end
           object CbShowParentTagID: TCheckBox
             AnchorSideLeft.Control = CbShowTagIDs
@@ -798,8 +798,8 @@ object MainForm: TMainForm
             AutoSize = True
             BorderSpacing.Left = 16
             Caption = 'Apply changes'
-            OnClick = btnApplyChangesXMPClick
             TabOrder = 0
+            OnClick = btnApplyChangesXMPClick
           end
           object btnSaveXMP: TButton
             AnchorSideLeft.Control = btnApplyChangesXMP
@@ -812,8 +812,8 @@ object MainForm: TMainForm
             AutoSize = True
             BorderSpacing.Left = 4
             Caption = 'Save'
-            OnClick = btnSaveXMPClick
             TabOrder = 1
+            OnClick = btnSaveXMPClick
           end
           object cbProcessXMP: TCheckBox
             AnchorSideLeft.Control = Panel5
@@ -917,8 +917,8 @@ object MainForm: TMainForm
         BorderSpacing.Left = 8
         BorderSpacing.Bottom = 4
         Caption = 'Execute'
-        OnClick = BtnChangeDateClick
         TabOrder = 1
+        OnClick = BtnChangeDateClick
       end
     end
   end

components/fpexif/examples/metadata_viewer/mdvmain.pas

@@ -29,7 +29,7 @@ type
     Panel5: TPanel;
     XMPListView: TListView;
     Messages: TMemo;
-    PageControl1: TPageControl;
+    PageControl: TPageControl;
     Panel1: TPanel;
     Panel2: TPanel;
     Panel3: TPanel;
@@ -57,7 +57,7 @@ type
     procedure CbShowTagIDsChange(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
-    procedure PageControl1Change(Sender: TObject);
+    procedure PageControlChange(Sender: TObject);
     procedure ShellListViewSelectItem(Sender: TObject; Item: TListItem;
       Selected: Boolean);
     procedure ShellTreeViewGetImageIndex(Sender: TObject; Node: TTreeNode);
@@ -408,7 +408,7 @@ begin
         Messages.Show;
       end;
 
-      if PageControl1.ActivePage = PgImage then begin
+      if PageControl.ActivePage = PgImage then begin
         crs := Screen.Cursor;
         try
           Screen.Cursor := crHourglass;
@@ -466,6 +466,8 @@ begin
     h := ini.ReadInteger('MainForm', 'TreeHeight', 0);
     if h <> 0 then ShellTreeView.Height := h;
 
+    PageControl.ActivePageIndex := ini.ReadInteger('MainForm', 'PageControl', 0);
+
     for i:=0 to TagListView.Columns.Count-1 do begin
       w := ini.ReadInteger('TagList', 'ColWidth'+IntToStr(i), 0);
       if w <> 0 then
@@ -504,7 +506,7 @@ begin
   end;
 end;
 
-procedure TMainForm.PageControl1Change(Sender: TObject);
+procedure TMainForm.PageControlChange(Sender: TObject);
 var
   crs: TCursor;
 begin
@@ -541,6 +543,7 @@ begin
     ini.WriteString('MainForm', 'Path', ShellTreeView.Path);
     ini.WriteInteger('MainForm', 'LeftPanelWidth', ShellPanel.Width);
     ini.WriteInteger('MainForm', 'TreeHeight', ShellTreeView.Height);
+    ini.WriteInteger('MainForm', 'PageControl', PageControl.ActivePageIndex);
 
     ini.WriteBool('TagList', 'ShowTagIDs', CbShowTagIDs.Checked);
     ini.WriteBool('TagList', 'ShowParentTagID', CbShowParentTagID.Checked);

components/fpexif/fpemetadata.pas

@@ -577,8 +577,11 @@ begin
             try
               FXmpData.LoadFromStream(AStream, size - Length(XMP_KEY));
             except
-              FreeAndNil(FXmpData);
+              on E:Exception do
-              raise;
+              begin
+                FreeAndNil(FXmpData);
+                raise EFpExifReader.Create('Error reading XMP data: ' + E.Message);
+              end;
             end;
           end;
         end;

components/fpexif/fpexmpdata.pas

@@ -159,13 +159,25 @@ end;
 procedure TXMPData.LoadFromStream(AStream: TStream; ASize: Integer = -1);
 var
   p: Int64;
+  i: SizeInt;
 begin
   if ASize = -1 then 
     ASize := AStream.Size;
   SetLength(FData, ASize);
   p := AStream.Position;
   AStream.Read(FData[1], ASize);
-  
+
+  // Sometimes there are incomplete xml files, missing the initial '<'.
+  // https://superuser.com/questions/1389971/error-0x80070057-the-parameter-is-incorrect-when-editing-jpeg-metadata
+  // Fixing this is better than rejecting the file...
+  if pos('?xpacket', FData) = 1 then
+  begin
+    SetLength(FData, ASize+1);
+    for i := ASize downto 1 do
+      FData[i+1] := FData[i];
+    FData[1] := '<';
+  end;
+
   AStream.Position := p;
   {$IFDEF FPC}
   CreateTags;