removed: IPTCsegment (from TImgData; TIptcObj uses its own buffer).

added: Unit diptcwrite for writing iptc data.
added: unit dmetadata forgotten in previous commit

dIPTC.pas

@@ -66,7 +66,7 @@   TIPTCdata = class
     function GetTimeZoneStr: string;
     procedure SetDateTimePrim(TimeIn: TDateTime; prefix: string);
   protected
-//    FBuffer: ansistring;
+    FBuffer: ansistring;
     MaxTag: integer;
     FParent: TObject;
     fITagCount : integer;
@@ -79,6 +79,7 @@   TIPTCdata = class
     function Clone(ASource: TIPTCData): TIPTCData;
 
     function IPTCArrayToBuffer:ansistring;
+    procedure IPTCArrayToList(AList: TStrings);
     procedure IPTCArrayToXML(AList: TStrings); overload;
     function IPTCArrayToXML: TStringList; overload;
       deprecated {$IFDEF FPC}'Use procedure instead.'{$ENDIF};
@@ -100,26 +101,14 @@   TIPTCdata = class
     procedure SetTagByIdx(idx:integer; AValue:ansistring);
     function GetTag(ATagName: String; ADefaultVal: string=''): string; virtual;
 
-    function ReadFile(const AFileName: String): boolean; virtual;
-    procedure ReadFileStrings(const AFilename: String; AList: TStrings); overload;
-    function ReadFileStrings(const AFileName: String): TStringList; overload;
-      deprecated {$IFDEF FPC}'Use procedure instead.'{$ENDIF};
+    class procedure ReadFileStrings(const AFilename: String; AList: TStrings);
 
     function AddTagToArray(ANewTag: iTag): integer;
     function GetDateTime: TDateTime;
     procedure SetDateTime(TimeIn: TDateTime);
     procedure SetDateTimeExt(TimeIn: TDateTime; APrefix:ansistring);
     function GetMultiPartTag(ATagName: String): TStringList;
 
-   {$IFNDEF FPC}
-    {$IFNDEF dExifNoJpeg}
-    (*
-    procedure WriteFile(fname:ansistring;origname:ansistring = ''); overload;
-    procedure WriteFile(fname:ansistring;memImage:tjpegimage); overload;
-    *)
-    {$ENDIF}
-   {$ENDIF}
-
     property ITagArray[TagID:integer]: ITag
         read GetTagElement write SetTagElement; default;
     property Count: integer read GetCount write SetCount;
@@ -131,7 +120,7 @@   TIPTCdata = class
 var
   rawDefered : boolean = false;
   defaultTimeZone:ansistring = '_0000';
-  IPTCMultiTags: set of byte = [20,25];
+  IPTCMultiTags: set of byte = [20, 25];
   IPTCTable : array [0..IPTCTAGCNT-1] of ITag =
     (( TID:0; TType:0; ICode:2; Tag:  0; Name:'SKIP';             Desc:'Record Version';Code:'';Data:'';Raw:'';FormatS:'';Size:64),
      ( TID:0; TType:0; ICode:2; Tag:  3; Name:'ObjectType';       Desc:'Object Type Ref';Code:'';Data:'';Raw:'';FormatS:'';Size:67),
@@ -386,6 +375,14 @@ function MakeEntry(code,tag:integer;data:ansistring):ansistring;
   result := buff+ansichar($1C)+ansichar(code)+ansichar(tag)+sLen+Data;
 end;
 
+procedure TIptcData.IptcArrayToList(AList: TStrings);
+var
+  buf: ansistring;
+begin
+  buf := IptcArrayToBuffer;
+  ParseIptcStrings(buf, AList);
+end;
+
 function TIPTCdata.IPTCArrayToXML: TStringList;
 begin
   Result := TStringList.Create;
@@ -446,7 +443,9 @@ function TIPTCdata.IPTCArrayToBuffer: Ansistring;
       buff := buff+SplitMultiTag(icode,tag,data)
     else
       buff := buff+MakeEntry(icode,tag,data);
-
+  Result := buff;
+
+                         (*
 // Photoshop requires the following headers:
   if not odd(length(buff)) then
     buff := buff+#0;
@@ -457,6 +456,7 @@ function TIPTCdata.IPTCArrayToBuffer: Ansistring;
  
 // Photoshop requires the following End-of-data marker:
   result := buff+'8BIM'#$04#$0B#0#0#0#0#0#0;
+  *)
 end;
 
 function TIPTCdata.Clone(ASource: TIPTCdata): TIPTCdata;
@@ -466,6 +466,22 @@ function TIPTCdata.Clone(ASource: TIPTCdata): TIPTCdata;
   Result.fITagCount := ASource.fITagCount;
 end;
 
+(*
+procedure TOPTCdata.MakeIPTCSegment(buff: ansisstring);
+var
+  blen: integer;
+begin
+  bl := length(buff) + 2;
+  if IPTCSegment = nil then
+  begin
+    inc(SectionCnt);
+    IPTCSegment := @(sections[SectionCnt]);
+  end;
+  IPTCSegment^.Data := ansichar(bl div 256) + ansichar(bl mod 256) + buff;
+  IPTCSegment^.Size := bl;
+  IPTCSegment^.DType := M_IPTC;
+end;
+  *)
 function TIPTCdata.AddOrAppend(ATagName: String; ADataVal: ansistring): integer;
 var
   i:integer;
@@ -602,70 +618,20 @@ function TIPTCdata.GetTag(ATagName: string; ADefaultVal: String=''): String;
 begin
   result := Count > 0;
 end;
-
-function TIPTCdata.ReadFile(const AFileName: String): boolean;
-var
-  p: TImgData;
-begin
-  p := TImgData(FParent);
-  Reset;
-  p.ProcessFile(AFileName);                  // Get data from file.
-  if p.IPTCSegment <> nil then               // If IPTC segment detected
-    ParseIPTCArray(p.IPTCSegment^.Data);
-//    filename := FName;
-  Result := HasData();
-end;
-
-function TIPTCdata.ReadFileStrings(const AFileName: String): TStringList;
-begin
-  Result := TStringList.Create;
-  ReadFileStrings(AFilename, Result);
-end;
 
-procedure TIPTCData.ReadFileStrings(const AFileName: String; AList: TStrings);
+class procedure TIPTCData.ReadFileStrings(const AFileName: String;
+  AList: TStrings);
+var
+  imgdata: TImgData;
 begin
   Assert(AList <> nil, 'TIPTCData.ReadFileStrings called with AList=nil.');
-  ParseIPTCStrings(TImgData(FParent).IPTCSegment^.Data, AList);
-end;
-
-
-{$IFNDEF FPC}
-{$IFNDEF dExifNoJpeg}
-(*
-procedure TIPTCdata.WriteFile(fname:ansistring;memImage:tjpegimage);
-var tmp:ansistring;
-begin
-  tmp := IPTCArrayToBuffer;                       // Create temp buffer
-  timgdata(parent).MakeIPTCSegment(tmp);          // Create IPTC segment
-  timgdata(parent).WriteEXIFjpeg(memImage,FName); // Write to disk
-end;
- 
-procedure TIPTCdata.WriteFile(FName:ansistring; OrigName :ansistring = '');
-var tmp:ansistring;
-    Orig:tjpegimage;
-begin
-  Orig := TJPEGImage.Create;
-  if OrigName = '' then
-    OrigName := FName;
-  Orig.LoadFromFile(OrigName);                // Get the image
-  tmp := IPTCArrayToBuffer;                   // Create temp buffer
-  timgdata(parent).MakeIPTCSegment(tmp);      // Create IPTC segment
-  timgdata(parent).WriteEXIFjpeg(Orig,FName); // Write to disk
-  Orig.free;
-end;
-          *)
-(*
-{$ELSE}
-procedure TIPTCdata.WriteFile(fname:ansistring; origname :ansistring = '');
-begin
-  // if you're not using Borland's jpeg unit
-  // then you should override/avoid this method
-  raise exception.create('WriteIPTCfile does nothing!');
-  // I suppose I should make this method abstract...
+  imgData := TImgData.Create;
+  try
+    imgData.ReadIptcStrings(AFileName, AList);
+  finally
+    imgData.Free;
+  end;
 end;
-*)
-{$ENDIF}
-{$ENDIF}
 
 procedure TIPTCdata.SetTagByIdx(idx: integer; AValue: ansistring);
 begin
@@ -674,7 +640,7 @@ procedure TIPTCdata.SetTagByIdx(idx: integer; AValue: ansistring);
 end;
 
 {$IFDEF MSWINDOWS}
-function GetTimeZoneBias:longint;
+function GetTimeZoneBias: Longint;
 var
   TZoneInfo: TTimeZoneInformation;
 begin
@@ -684,7 +650,7 @@ function GetTimeZoneBias:longint;
 {$ENDIF}
 
 {$IFDEF UNIX}
-function GetTimeZoneBias:longint;
+function GetTimeZoneBias: Longint;
 begin
   Result := -TZSeconds div 60;
 end;

dexif_package.lpk

@@ -8,7 +8,7 @@
         <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-$(LCLWidgetType)"/>
       </SearchPaths>
     </CompilerOptions>
-    <Files Count="9">
+    <Files Count="10">
       <Item1>
         <Filename Value="dEXIF.pas"/>
         <UnitName Value="dEXIF"/>
@@ -43,8 +43,12 @@
       </Item8>
       <Item9>
         <Filename Value="dmetadata.pas"/>
-        <UnitName Value="dmetadata"/>
+        <UnitName Value="dMetadata"/>
       </Item9>
+      <Item10>
+        <Filename Value="diptcwrite.pas"/>
+        <UnitName Value="diptcwrite"/>
+      </Item10>
     </Files>
     <RequiredPkgs Count="2">
       <Item1>

dexif_package.pas

@@ -8,7 +8,8 @@
 interface
 
 uses
-  dEXIF, dIPTC, msData, dexifwrite, dGlobal, dTags, dUtils, dMetadata;
+  dEXIF, dIPTC, msData, dexifwrite, dGlobal, dTags, dUtils, dMetadata, 
+  dIPTCWrite;
 
 implementation
 

dexifwrite.pas

@@ -23,7 +23,6 @@   TExifWriter = class(TBasicMetadataWriter)
     FTiffHeaderPosition: Int64;
     FExifSegmentStartPos: Int64;
     FHasThumbnail: Boolean;
-    procedure UpdateSegmentSize(AStream: TStream);
 
   protected
     function CalcOffsetFromTiffHeader(APosition: Int64): DWord;
@@ -99,36 +98,6 @@ function TExifWriter.FixEndian32(AValue: DWord): DWord;
     Result := NtoLE(AValue);
 end;
 
-//------------------------------------------------------------------------------
-// Updates the size of the APP1 segment
-//------------------------------------------------------------------------------
-procedure TExifWriter.UpdateSegmentSize(AStream: TStream);
-var
-  startPos: Int64;
-  segmentSize: Word;
-  w: Word;
-begin
-  // If the exif structure is part of a jpeg file then WriteExifHeader has
-  // been called which determines the position where the Exif header starts.
-  if FExifSegmentStartPos < 0 then
-    exit;
-
-  // From the current stream position (at the end) and the position where
-  // the segment size must be written, we calculate the size of the segment
-  startPos := FExifSegmentStartPos + SizeOf(word);
-  segmentSize := AStream.Position - startPos;
-
-  // Move the stream to where the segment size must be written...
-  AStream.Position := startPos;
-
-  // ... and write the segment size.
-  w := BEToN(segmentSize);
-  AStream.WriteBuffer(w, SizeOf(w));
-
-  // Rewind stream to the end
-  AStream.Seek(0, soFromEnd);
-end;
-
 //------------------------------------------------------------------------------
 //  Writes the Exif header needed by JPEG files.
 //  Call WriteToStream immediately afterwards
@@ -476,7 +445,7 @@ procedure TExifWriter.WriteToStream(AStream: TStream);
 
     // If WriteToStream is called within a JPEG structure we must update the
     // size of the EXIF segment.
-    UpdateSegmentSize(AStream);
+    UpdateSegmentSize(AStream, FExifSegmentStartPos);
 
   finally
     subIFDList.Free;