Delphi-PRAXiS - Delphi JPG (oder JPEG) und Kommentar oder Exif-Daten

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;