JPG (oder JPEG) und Kommentar oder Exif-Daten

[Ralf Stehle]

Es hat etwas gedauert, aber jetzt habe ich ein kleines Programm fertig,
mit dem man IPTC-Kommentare lesen und überschreiben kann.

ReadIPTCStream liest vorhandene Kommentare in ein Record

ReplaceIPTCStream schreibt Kommentare zurück in die Jpg-Datei.

ReplaceIPTCStream ersetzt dabei alle alten IPTC-Kommentare. Sollen vorhandene Kommentare erhalten bleiben, müssen diese unbedingt vorher mit ReadIPTCStream in das Record eingelesen werden!
Außerdem beachten: ich habe nur eine Teilauswahl der möglichen IPTC-Felder berücksichtigt. Sollten fremde Jpg´s weiterverarbeitet werden, in denen noch andere Daten-Felder vorhanden sind, werden diese unwiderruflich gelöscht. Daher wird bei ReplaceIPTCStream in eine neue Datei geschrieben. Soll die alte Datei ersetzt werden, einfach OldFilename und NewFilename identisch wählen

Record und Proceduren deklarieren:

Delphi-Quellcode:

unit uFileComment;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, StrUtils;


type IPTCrec = record
  Category        :string[3];                       // $21 =15
  Keywords        :AnsiString; //max. 2000 Zeichen  // $19 =25
  Instructions    :string[255];                     // $28 =40
  Date            :string[8];                       // $37 =55
  Version         :string[10];                      // $46 =70
  Author          :string[32];                      // $50 =80
  Title           :string[32];                      // $55 =85
  City            :string[32];                      // $5A =90
  Country         :string[64];                      // $65 =101
  Transmission    :string[32];                      // $67 =103
  Headline        :string[255];                     // $69 =105
  Credit          :string[32];                      // $6E =110
  Source          :string[32];                      // $73 =115
  Copyright       :string[128];                     // $74 =116
  Caption         :AnsiString; //max. 2000 Zeichen  // $78 =120
  Editor          :string[32];                      // $7A =122
end;
//Tipp: Array-Inhalt initialisieren: fillchar(patrecord, sizeof(patrecord), #0);


type
  TForm1 = class(TForm)
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
 
  private
    procedure ReplaceIPTCStream(OldFilename, NewFilename: string; IPTC: IPTCrec);
    procedure ReadIPTCStream(Filename: string; var IPTC: IPTCrec);

    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  IPTC1 : iptcrec;

implementation

{$R *.dfm}

Daten lesen:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
  ReadIPTCStream(FileName , IPTC1);
  ShowMessage(IPTC1.Caption + #13 + IPTC1.Copyright
                            + #13 + IPTC1.Headline
                            + #13 + IPTC1.Category
                            + #13 + IPTC1.Keywords
                            + #13 + IPTC1.Date
                            + #13 + IPTC1.Version
                            + #13 + IPTC1.Author
                            + #13 + IPTC1.Title
                            + #13 + IPTC1.City
                            + #13 + IPTC1.Country
                            + #13 + IPTC1.Transmission
                            + #13 + IPTC1.Credit
                            + #13 + IPTC1.Source
                            + #13 + IPTC1.Editor
                            + #13 + IPTC1.Instructions);
end;

Kommentare schreiben:

Delphi-Quellcode:

procedure TForm1.Button2Click(Sender: TObject);
begin
  IPTC1.Caption     := 'Dies ist die Beschriftung';
  IPTC1.Copyright   := '(c) 2007';
  IPTC1.Author      := 'Ralf Stehle';
  IPTC1.Date        := FormatDateTime('yyyymmdd', now);  //Datumsformat beachten !
  IPTC1.Headline    := 'Dies ist die Überschrift';
  ReplaceIPTCStream(OldFilename, NewFilename, IPTC1);
end;

Delphi-Quellcode:

procedure TForm1.ReadIPTCStream(Filename: string; var IPTC: IPTCrec);
var
  fs: TFileStream;
  ba: array of byte;
  i, j: integer;
  istart, ilen, slen : integer;  //Beginn des Abschnittes, Ende des Abschnittes
begin
  fillchar(IPTC, sizeof(IPTC), #0);

  fs := TFilestream.Create(Filename, fmopenread or fmShareDenyNone);
  SetLength(ba, fs.Size);
  fs.Read(ba[0], Length(ba));
  fs.Free;

  {****************************************************************************}
  {*              alten FF ED-Abschnitt herauschneiden                        *}
  {****************************************************************************}
  i := 0; istart:=0; ilen:=0;
  While (istart = 0) and (i<Length(ba)) do begin      //Position des IPTC-Comment-Abschnittes bestimmen
    if (ba[i]=$FF) and (ba[i+1]=$ED) then istart :=i;
    inc(i);
  end;
  if istart>0 then
  begin
    ilen := (ba[istart+2]*256) + (ba[istart+3]);
  end;
  for i := iStart to iLen + iStart do
  begin
    if (ba[i]=$1C) and (ba[i+1]=$02) then
    begin
      { $74 Copyright }
      if (ba[i+2]=$74) then begin
        slen := (ba[i+3]*256) + (ba[i+4]);
        for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Copyright := IPTC.Copyright + Char(ba[j]);
      end;
      { $78 Caption }
      if (ba[i+2]=$78) then begin
        slen := (ba[i+3]*256) + (ba[i+4]);
        for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Caption := IPTC.Caption + Char(ba[j]);
      end;
      { $69 Headline }
      if (ba[i+2]=$69) then begin
        slen := (ba[i+3]*256) + (ba[i+4]);
        for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Headline := IPTC.Headline + Char(ba[j]);
      end;
      { $21 Category }
      if (ba[i+2]=$21) then begin
        slen := (ba[i+3]*256) + (ba[i+4]);
        for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Category := IPTC.Category + Char(ba[j]);
      end;
      { $19 Keywords }
      if (ba[i+2]=$19) then begin
        slen := (ba[i+3]*256) + (ba[i+4]);
        for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Keywords := IPTC.Keywords + Char(ba[j]);
      end;
      { $28 Instructions }
      if (ba[i+2]=$28) then begin
        slen := (ba[i+3]*256) + (ba[i+4]);
        for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Instructions := IPTC.Instructions + Char(ba[j]);
      end;
      { $37 Date }
      if (ba[i+2]=$37) then begin
        slen := (ba[i+3]*256) + (ba[i+4]);
        for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Date := IPTC.Date + Char(ba[j]);
      end;
      { $46 Version }
      if (ba[i+2]=$46) then begin
        slen := (ba[i+3]*256) + (ba[i+4]);
        for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Version := IPTC.Version + Char(ba[j]);
      end;
      { $50 Author }
      if (ba[i+2]=$50) then begin
        slen := (ba[i+3]*256) + (ba[i+4]);
        for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Author := IPTC.Author + Char(ba[j]);
      end;
      { $55 Title }
      if (ba[i+2]=$55) then begin
        slen := (ba[i+3]*256) + (ba[i+4]);
        for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Title := IPTC.Title + Char(ba[j]);
      end;
      { $5A City }
      if (ba[i+2]=$5A) then begin
        slen := (ba[i+3]*256) + (ba[i+4]);
        for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.City := IPTC.City + Char(ba[j]);
      end;
      { $65 Country }
      if (ba[i+2]=$65) then begin
        slen := (ba[i+3]*256) + (ba[i+4]);
        for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Country := IPTC.Country + Char(ba[j]);
      end;
      { $67 Transmission }
      if (ba[i+2]=$67) then begin
        slen := (ba[i+3]*256) + (ba[i+4]);
        for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Transmission := IPTC.Transmission + Char(ba[j]);
      end;
      { $6E Credit }
      if (ba[i+2]=$6E) then begin
        slen := (ba[i+3]*256) + (ba[i+4]);
        for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Credit := IPTC.Credit + Char(ba[j]);
      end;
      { $73 Source }
      if (ba[i+2]=$73) then begin
        slen := (ba[i+3]*256) + (ba[i+4]);
        for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Source := IPTC.Source + Char(ba[j]);
      end;
      { $7A Editor }
      if (ba[i+2]=$7A) then begin
        slen := (ba[i+3]*256) + (ba[i+4]);
        for j:=1 +i+4 to slen +i+4 do if ba[j] > 0 then IPTC.Editor := IPTC.Editor + Char(ba[j]);
      end;

    end;
  end;

end;

Delphi-Quellcode:

procedure TForm1.ReplaceIPTCStream(OldFilename, NewFilename: string; IPTC: IPTCrec);
var
  fs: TFileStream;
  ba1, ba2, ba3: array of byte;
  i, j, lenSum, istart, ilen: integer;  //istart: Beginn des Abschnittes, ilen: Länge (Ende) des Abschnittes
  lenCaption,
  lenCopyright,
  lenHeadline,
  lenAuthor,
  lenCategory,
  lenCity,
  lenCountry,
  lenCredit,
  lenDate,
  lenEditor,
  lenInstructions,
  lenSource,
  lenTitle,
  lenTransmission,
  lenVersion,
  lenKeywords: integer;
begin

  //ba1 ist Originaldatei
  //ba2 sind die neuen IPTC-Daten
  //ba3 ist neu zusammengesetzte Daten

  fs := TFilestream.Create(OldFilename, fmopenread or fmShareDenyNone);
  SetLength(ba1, fs.Size);
  fs.Read(ba1[0], Length(ba1));
  fs.Free;

  {****************************************************************************}
  {*              alten FF ED-Abschnitt herauschneiden                        *}
  {****************************************************************************}
  i := 0; istart:=0; ilen:=0;
  While (istart = 0) and (i<Length(ba1)-1) do begin      //Position des IPTC-Comment-Abschnittes bestimmen
    if (ba1[i]=$FF) and (ba1[i+1]=$ED) then istart :=i;
    inc(i);
  end;
  if istart>0 then
  begin
    ilen := (ba1[istart+2] div 255) + (ba1[istart+3] mod 255) + 2;
    //alle Bytes vom Ende des Abscbnittes auf den Anfang umschichten
    for i := (istart+ilen) to High(ba1) do ba1[i-ilen] := ba1[i];//for i := Low(ba1) to High(ba1) do
    SetLength(ba1, length(ba1)-ilen);
  end;

  {****************************************************************************}
  {*             IPTC-Einträge und Header in ba2 schreiben                    *}
  {****************************************************************************}
  lenAuthor       := Length(IPTC.Author);
  lenCaption      := Length(IPTC.Caption);
  lenCategory     := Length(IPTC.Category);
  lenCity         := Length(IPTC.City);
  lenCopyright    := Length(IPTC.Copyright);
  lenCountry      := Length(IPTC.Country);
  lenCredit       := Length(IPTC.Credit);
  lenDate         := Length(IPTC.Date);
  lenEditor       := Length(IPTC.Editor);
  lenHeadline     := Length(IPTC.Headline);
  lenInstructions := Length(IPTC.Instructions);
  lenKeywords     := Length(IPTC.Keywords);
  lenSource       := Length(IPTC.Source);
  lenTitle        := Length(IPTC.Title);
  lenTransmission := Length(IPTC.Transmission);
  lenVersion      := Length(IPTC.Version);
  //if lenCaption + lenCopyright + lenHeadline = 0 then exit;  kein Exit, da so die Einträge gelöscht werden könne

  //Längenberechnung
  lenSum                             := 28;                         //Headerlänge
  if lenAuthor       > 0 then lenSum := lenSum + 5 + lenAuthor;       //5 = Art 3, Längenbytes 2
  if lenCaption      > 0 then lenSum := lenSum + 5 + lenCaption;      //5 = Art 3, Längenbytes 2
  if lenCategory     > 0 then lenSum := lenSum + 5 + lenCategory;     //5 = Art 3, Längenbytes 2
  if lenCity         > 0 then lenSum := lenSum + 5 + lenCity;         //5 = Art 3, Längenbytes 2
  if lenCopyright    > 0 then lenSum := lenSum + 5 + lenCopyright;    //5 = Art 3, Längenbytes 2
  if lenCountry      > 0 then lenSum := lenSum + 5 + lenCountry;      //5 = Art 3, Längenbytes 2
  if lenCredit       > 0 then lenSum := lenSum + 5 + lenCredit;       //5 = Art 3, Längenbytes 2
  if lenDate         > 0 then lenSum := lenSum + 5 + lenDate;         //5 = Art 3, Längenbytes 2
  if lenEditor       > 0 then lenSum := lenSum + 5 + lenEditor;       //5 = Art 3, Längenbytes 2
  if lenHeadline     > 0 then lenSum := lenSum + 5 + lenHeadline;     //5 = Art 3, Längenbytes 2
  if lenInstructions > 0 then lenSum := lenSum + 5 + lenInstructions; //5 = Art 3, Längenbytes 2
  if lenKeywords     > 0 then lenSum := lenSum + 5 + lenKeywords;     //5 = Art 3, Längenbytes 2
  if lenSource       > 0 then lenSum := lenSum + 5 + lenSource;       //5 = Art 3, Längenbytes 2
  if lenTitle        > 0 then lenSum := lenSum + 5 + lenTitle;        //5 = Art 3, Längenbytes 2
  if lenTransmission > 0 then lenSum := lenSum + 5 + lenTransmission; //5 = Art 3, Längenbytes 2
  if lenVersion      > 0 then lenSum := lenSum + 5 + lenVersion;      //5 = Art 3, Längenbytes 2


  lenSum := lenSum + 1;                                               //abschließendes 00-Byte

  SetLength(ba2, lenSum + 2);
  SetLength(ba3, Length(ba1) + Length(ba2) + 2);

  i := 0;
{FF ED -> IPTC Tag}
  ba2[i+ 0] :=$FF;
  ba2[i+ 1] :=$ED;

{Länge des Bereichs incl. Längenbytes bis zum Ende mit abschließendem 00-Byte}
  ba2[i+ 2] :=lenSum div 255;
  ba2[i+ 3] :=lenSum mod 255;

{IPTC-Header, keine Ahnung was das alles bedeutet}
  ba2[i+ 4] :=$50;
  ba2[i+ 5] :=$68;
  ba2[i+ 6] :=$6F;
  ba2[i+ 7] :=$74;
  ba2[i+ 8] :=$6F;
  ba2[i+ 9] :=$73;
  ba2[i+10] :=$68;
  ba2[i+11] :=$6F;
  ba2[i+12] :=$70;
  ba2[i+13] :=$20;
  ba2[i+14] :=$33;
  ba2[i+15] :=$2E;
  ba2[i+16] :=$30;
  ba2[i+17] :=$00;
  ba2[i+18] :=$38;
  ba2[i+19] :=$42;
  ba2[i+20] :=$49;
  ba2[i+21] :=$4D;
  ba2[i+22] :=$04;
  ba2[i+23] :=$04;
  ba2[i+24] :=$00;
  ba2[i+25] :=$00;
  ba2[i+26] :=$00;
  ba2[i+27] :=$00;

{Längen-Bytes bis zum Ende ohne abschließendes 00-Byte und ohne die 2 Längenbytes mitzuzählen}
  ba2[i+28]:= (lenSum-29) div 255;
  ba2[i+29]:= (lenSum-29) mod 255;

 if lenHeadline>0 then
  begin
    {Art des IPTC-Eintrages, 1C 02 xx     $69 = Headline}
      ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$69;
    {Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
      ba2[i+33]:= lenHeadline div 255;
      ba2[i+34]:= lenHeadline mod 255;
      for j := 1 to lenHeadline do ba2[i+34+j] := Ord(IPTC.Headline[j]);
      i := i + 5 + lenHeadline;
  end;

  if lenCopyright>0 then
  begin
    {Art des IPTC-Eintrages, 1C 02 xx     $74 = Copyright  }
      ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$74;
    {Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
      ba2[i+33]:= lenCopyright div 255;
      ba2[i+34]:= lenCopyright mod 255;
      for j := 1 to lenCopyright do ba2[i+34+j] := Ord(IPTC.Copyright[j]);
      i := i + 5 + lenCopyright;
  end;

  if lenCaption>0 then
  begin
    {Art des IPTC-Eintrages, 1C 02 xx }
      ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$78;                           
    {Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
      ba2[i+33]:= lenCaption div 255;
      ba2[i+34]:= lenCaption mod 255;
      for j := 1 to lenCaption do ba2[i+34+j] := Ord(IPTC.Caption[j]);
      i := i + 5 + lenCaption;
  end;

  if lenAuthor>0 then
  begin
    {Art des IPTC-Eintrages, 1C 02 xx }
      ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$50;
    {Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
      ba2[i+33]:= lenAuthor div 255;
      ba2[i+34]:= lenAuthor mod 255;
      for j := 1 to lenAuthor do ba2[i+34+j] := Ord(IPTC.Author[j]);
      i := i + 5 + lenAuthor;
  end;

  if lenCategory>0 then
  begin
    {Art des IPTC-Eintrages, 1C 02 xx }
      ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$21;                           
    {Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
      ba2[i+33]:= lenCategory div 255;
      ba2[i+34]:= lenCategory mod 255;
      for j := 1 to lenCategory do ba2[i+34+j] := Ord(IPTC.Category[j]);
      i := i + 5 + lenCategory;
  end;

  if lenCity>0 then
  begin
    {Art des IPTC-Eintrages, 1C 02 xx }
      ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$5A;                           
    {Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
      ba2[i+33]:= lenCity div 255;
      ba2[i+34]:= lenCity mod 255;
      for j := 1 to lenCity do ba2[i+34+j] := Ord(IPTC.City[j]);
      i := i + 5 + lenCity;
  end;

  if lenCountry>0 then
  begin
    {Art des IPTC-Eintrages, 1C 02 xx }
      ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$65;                           
    {Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
      ba2[i+33]:= lenCountry div 255;
      ba2[i+34]:= lenCountry mod 255;
      for j := 1 to lenCountry do ba2[i+34+j] := Ord(IPTC.Country[j]);
      i := i + 5 + lenCountry;
  end;

  if lenCredit>0 then
  begin
    {Art des IPTC-Eintrages, 1C 02 xx }
      ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$6E;                           
    {Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
      ba2[i+33]:= lenCredit div 255;
      ba2[i+34]:= lenCredit mod 255;
      for j := 1 to lenCredit do ba2[i+34+j] := Ord(IPTC.Credit[j]);
      i := i + 5 + lenCredit;
  end;

  if lenDate>0 then
  begin
    {Art des IPTC-Eintrages, 1C 02 xx }
      ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$37;                           
    {Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
      ba2[i+33]:= lenDate div 255;
      ba2[i+34]:= lenDate mod 255;
      for j := 1 to lenDate do ba2[i+34+j] := Ord(IPTC.Date[j]);
      i := i + 5 + lenDate;
  end;

  if lenEditor>0 then
  begin
    {Art des IPTC-Eintrages, 1C 02 xx }
      ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$7A;                           
    {Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
      ba2[i+33]:= lenEditor div 255;
      ba2[i+34]:= lenEditor mod 255;
      for j := 1 to lenEditor do ba2[i+34+j] := Ord(IPTC.Editor[j]);
      i := i + 5 + lenEditor;
  end;

  if lenInstructions>0 then
  begin
    {Art des IPTC-Eintrages, 1C 02 xx }
      ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$28;                           
    {Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
      ba2[i+33]:= lenInstructions div 255;
      ba2[i+34]:= lenInstructions mod 255;
      for j := 1 to lenInstructions do ba2[i+34+j] := Ord(IPTC.Instructions[j]);
      i := i + 5 + lenInstructions;
  end;

  if lenSource>0 then
  begin
    {Art des IPTC-Eintrages, 1C 02 xx }
      ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$73;                           
    {Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
      ba2[i+33]:= lenSource div 255;
      ba2[i+34]:= lenSource mod 255;
      for j := 1 to lenSource do ba2[i+34+j] := Ord(IPTC.Source[j]);
      i := i + 5 + lenSource;
  end;

  if lenTitle>0 then
  begin
    {Art des IPTC-Eintrages, 1C 02 xx }
      ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$55;                           
    {Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
      ba2[i+33]:= lenTitle div 255;
      ba2[i+34]:= lenTitle mod 255;
      for j := 1 to lenTitle do ba2[i+34+j] := Ord(IPTC.Title[j]);
      i := i + 5 + lenTitle;
  end;

  if lenTransmission>0 then
  begin
    {Art des IPTC-Eintrages, 1C 02 xx }
      ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$67;                           
    {Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
      ba2[i+33]:= lenTransmission div 255;
      ba2[i+34]:= lenTransmission mod 255;
      for j := 1 to lenTransmission do ba2[i+34+j] := Ord(IPTC.Transmission[j]);
      i := i + 5 + lenTransmission;
  end;

  if lenVersion>0 then
  begin
    {Art des IPTC-Eintrages, 1C 02 xx }
      ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$46;                           
    {Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
      ba2[i+33]:= lenVersion div 255;
      ba2[i+34]:= lenVersion mod 255;
      for j := 1 to lenVersion do ba2[i+34+j] := Ord(IPTC.Version[j]);
      i := i + 5 + lenVersion;
  end;

  if lenKeywords>0 then
  begin
    {Art des IPTC-Eintrages, 1C 02 xx }
      ba2[i+30]:=$1C; ba2[i+31]:=$02; ba2[i+32]:=$19;
    {Längen-Bytes ohne die 2 Längenbytes mitzuzählen und ohne abschließendes 00-Byte}
      ba2[i+33]:= lenKeywords div 255;
      ba2[i+34]:= lenKeywords mod 255;
      for j := 1 to lenKeywords do ba2[i+34+j] := Ord(IPTC.Keywords[j]);
      i := i + 5 + lenKeywords;
  end;

{abschließendes 00-Byte }
  ba2[i+30]:=$00;

  {****************************************************************************}
  {*             neue Datei ba3 aus ba1 und ba2 erzeugen                      *}
  {****************************************************************************}
  for i := 0 to 1 do             //SOF bleibt gleich
    ba3[i] := ba1[i];

  for i := 0 to High(ba2) do     //IPCT-Daten aus ba2 anfügen
    ba3[i+2]:= ba2[i];

  for i := 2 to High(ba1) do     //restliche Bilddaten anschließen
    ba3[i+High(ba2)+1]:= ba1[i];

  //Buffer ba3 in neues File  schreiben
  fs := TFileStream.Create(NewFilename, fmCreate);
  try
    fs.Writebuffer(ba3[0], Length(ba3));
  finally
    fs.Free;
  end;
end;