AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia Delphi JPG (oder JPEG) und Kommentar oder Exif-Daten

JPG (oder JPEG) und Kommentar oder Exif-Daten

Ein Thema von Ralf Stehle · begonnen am 5. Sep 2007 · letzter Beitrag vom 30. Sep 2007
Antwort Antwort
Seite 2 von 2     12
Ralf Stehle

Registriert seit: 8. Aug 2003
124 Beiträge
 
Delphi 7 Professional
 
#11

Re: JPG (oder JPEG) und Kommentar oder Exif-Daten

  Alt 9. Sep 2007, 22:09
Ich habe mal etwas herumprobiert, wie ich das Wort "Kommentar" entsprechend den oben erläuterter Tipps eingeben kann.
Das funktioniert anscheinend korrekt

Hier mein Test-Programm um einen Kommentar einzufügen:
(1A 00 00 00 bestimmt wahrscheinlich den Ort des Eintrages von Byte-Order 49 49 aus gezählt ?)

Delphi-Quellcode:
procedure TForm1.WriteExifStream(SelectedRoot, SelectedFile: string);
var
  fs: TFileStream;
  ba, bb, bc: array of byte;
  i, j, FFE0_pos, FFE0_len: integer;
begin
  if AnsiLastChar(SelectedRoot)^ <> '\then SelectedRoot := SelectedRoot + '\';

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

  SetLength(bb, 57);
  SetLength(bc, Length(ba) + Length(bb));


{FF E1 -> EXIF Tag}
  bb[0] :=StrToInt('$FF');;
  bb[1] :=StrToInt('$E1');;

{00 36 -> Länge des Bereichs , also 57 Bytes}
  bb[2] :=StrToInt('$00'); //HL
  bb[3] :=StrToInt('$39'); //LL

{45 78 69 66 00 00 -> EXIF Name}
  bb[4] :=StrToInt('$45');
  bb[5] :=StrToInt('$78');
  bb[6] :=StrToInt('$69');
  bb[7] :=StrToInt('$66');
  bb[8] :=StrToInt('$00');
  bb[9] :=StrToInt('$00');

{49 49 -> Byte Order, hier Intel [Little Endian] !!! wichtig !!!}
  bb[10]:=StrToInt('$49');
  bb[11]:=StrToInt('$49');

{2A 00 -> TIFF Kennung (Tagged Image File Format)}
  bb[12]:=StrToInt('$2A'); //2A 42
  bb[13]:=StrToInt('$00');

{08 00 00 00 -> IFD, File Descriptor - gibt an ob daten gleich folgen oder ob ein offset hinterlegt ist}
  bb[14]:=StrToInt('$08');
  bb[15]:=StrToInt('$00');
  bb[16]:=StrToInt('$00');
  bb[17]:=StrToInt('$00');

{01 00 -> Anzahl der EXIF Elemente - hier also 1 }
  bb[18]:=StrToInt('$01');
  bb[19]:=StrToInt('$00');

{9C 9C -> EXIF Element - hier also Kommentar (s.o.) }
  bb[20]:=StrToInt('$9C');
  bb[21]:=StrToInt('$9C');

{01 00 -> Datentyp - hier Bytes}
  bb[22]:=StrToInt('$01');
  bb[23]:=StrToInt('$00');

{16 00 00 00 -> Länge des Eintrages - hier als 22 Bytes / Zeichen}
  bb[24]:=StrToInt('$16');
  bb[25]:=StrToInt('$00');
  bb[26]:=StrToInt('$00');
  bb[27]:=StrToInt('$00');

{1A 00 00 00 -> Entweder Wert selbst oder offset wo daten zu finden sind - hier offset}
  bb[28]:=StrToInt('$1A'); //26 Bytes von Byte-Order 49 49 weiterzählen
  bb[29]:=StrToInt('$00');
  bb[30]:=StrToInt('$00');
  bb[31]:=StrToInt('$00');

{}
  bb[32]:=StrToInt('$00');
  bb[33]:=StrToInt('$00');
  bb[34]:=StrToInt('$00');
  bb[35]:=StrToInt('$00');

{Eintrag selbst, Länge oben definiert}
  bb[36]:=StrToInt('$4B');
  bb[37]:=StrToInt('$00');
  bb[38]:=StrToInt('$6F');
  bb[39]:=StrToInt('$00');
  bb[40]:=StrToInt('$6D');
  bb[41]:=StrToInt('$00');
  bb[42]:=StrToInt('$6D');
  bb[43]:=StrToInt('$00');
  bb[44]:=StrToInt('$65');
  bb[45]:=StrToInt('$00');
  bb[46]:=StrToInt('$6E');
  bb[47]:=StrToInt('$00');
  bb[48]:=StrToInt('$74');
  bb[49]:=StrToInt('$00');
  bb[50]:=StrToInt('$61');
  bb[51]:=StrToInt('$00');
  bb[52]:=StrToInt('$72');
  bb[53]:=StrToInt('$00');
  bb[54]:=Ord('!');
  bb[55]:=StrToInt('$00');
  bb[56]:=Ord('?');
  bb[57]:=StrToInt('$00');

  for i := 0 to 1 do bc[i] := ba[i];
  for i := 0 to High(bb)+2 do bc[i+2]:= bb[i];
  for i := 2 to High(ba) do bc[i+High(bb)+2]:= ba[i];

  //Buffer ba in neues File im Verzeichnis SDSRECS schreiben
  fs := TFileStream.Create(SelectedRoot + 'Neu.jpg', fmCreate);
  try
    fs.Writebuffer(bc[0], Length(bc));
  finally
    fs.Free;
  end;
end;
Folgende Besonderheiten verstehe ich aber leider nicht, so dass ich keine für alle Fälle passende Funktion programmieren kann:


1. Problem
Wenn ich meine zunächst mit Delphi eingetragenen EXIF-Daten nachträglich über die Windows-XP-Dateifunktion bearbeite,
wird meine Zeichenfolge von Windows akzeptiert, aber eine Zeile voran neu eingefügt, die ich nicht verstehe:

FF D8 FF EE 00 0E 41 64 6F 62 65 00 64 00 00 00
00 01
FF E1 00 4E 45 78 69 66 00 00 49 49 2A 00

2. Problem
Noch merkwürdiger ist folgendes Verhalten (so dass ich solche mir unverständlichen
Exif-Daten leider nicht selbst weiterbearbeiten kann):

Sobald ich aber über die Windows-XP-Dateifunktion den Kommentar "Kommentar" eingebe,
kommt eine ganz andere Byte-Folge heraus:

erst kommt der Header FF D8, als zweites kommt erst der Header FF E0 ....
danach erst die Exif-Daten FF E1 ......, später wiederholt sich merkwürdigerweise der Header FF D8 FF E0
Ist das ein WindowsXP-Bug ?

FF D8 FF E0 00 10 4A 46 49 46 00 01 02 01 00 48
00 48 00 00 FF E1 0B 2C 45 78 69 66 00 00 49 49
2A 00 08 00 00 00 04 00 1A 01 05 00 01 00 00 00
3E 00 00 00 1B 01 05 00 01 00 00 00 46 00 00 00
28 01 03 00 01 00 00 00 02 00 00 00 9C 9C 01 00
14 00 00 00 4E 00 00 00 62 00 00 00 00 00 48 00
00 00 01 00 00 00 48 00 00 00 01 00 4B 00 6F 00
6D 00 6D 00 65 00 6E 00 74 00 61 00 72 00 00 00
03 00 03 01 03 00 01 00 00 00 06 00 00 00 01 02
04 00 01 00 00 00 8C 00 00 00 02 02 04 00 01 00
00 00 98 0A 00 00 00 00 00 00
FF D8 FF E0 00 10
4A 46 49 46 00 01 02 01 00 48 00 48 00 00 FF EE
Ralf Stehle
ralfstehle@yahoo.de
  Mit Zitat antworten Zitat
Muetze1
(Gast)

n/a Beiträge
 
#12

Re: JPG (oder JPEG) und Kommentar oder Exif-Daten

  Alt 9. Sep 2007, 22:47
Unabhängig vom Thema mal eine Anmerkung: Warum wandelst du haufenweise Strings um anstatt direkt den Wert zu zu weisen beim belegen des Arrays?

bb[15]:=StrToInt('$00'); wird zu bb[15] := $00;
  Mit Zitat antworten Zitat
Ralf Stehle

Registriert seit: 8. Aug 2003
124 Beiträge
 
Delphi 7 Professional
 
#13

Re: JPG (oder JPEG) und Kommentar oder Exif-Daten

  Alt 9. Sep 2007, 23:43
Danke für den Tipp
Ralf Stehle
ralfstehle@yahoo.de
  Mit Zitat antworten Zitat
Benutzerbild von DGL-luke
DGL-luke

Registriert seit: 1. Apr 2005
Ort: Bad Tölz
4.149 Beiträge
 
Delphi 2006 Professional
 
#14

Re: JPG (oder JPEG) und Kommentar oder Exif-Daten

  Alt 10. Sep 2007, 00:10
ja, was dem assemblerschreiber sein h, dem C-ler sein 0x0, ist dem Pascaler das $...
Lukas Erlacher
Suche Grafiktablett. Spenden/Gebrauchtangebote willkommen.
Gotteskrieger gesucht!
For it is the chief characteristic of the religion of science that it works. - Isaac Asimov, Foundation I, Buch 1
  Mit Zitat antworten Zitat
soulies

Registriert seit: 9. Dez 2005
234 Beiträge
 
#15

Re: JPG (oder JPEG) und Kommentar oder Exif-Daten

  Alt 10. Sep 2007, 08:35
hi ralf,

generell:
dadurch das die einzelnen tags[FF E1, FF E0, FF EE, usw] eindeutig sind, kann eine unterschiedliche
reihenfolge durchaus vorkommen ohne einen 'verlust' - man findet es ja wieder anhand der tags.
wenn also nach einem FF D8 erst FF EE kommt und dann erst FF E1 ist das kein problem. du selbst könntest diese bereiche tauschen ohne datenverlust.

Zitat:
1. Problem
Wenn ich meine zunächst mit Delphi eingetragenen EXIF-Daten nachträglich über die Windows-XP-Dateifunktion bearbeite,
wird meine Zeichenfolge von Windows akzeptiert, aber eine Zeile voran neu eingefügt, die ich nicht verstehe:

FF D8 FF EE 00 0E 41 64 6F 62 65 00 64 00 00 00
00 01
FF E1 00 4E 45 78 69 66 00 00 49 49 2A 00
--> FF EE wird oft für Copyright Einträge benutzt ['Adobe' lässt sich ja hier auch finden],
aber warum M$ das davor setzt weiß ich auch nicht ...


zu deinem 2. Problem:

dein FF E1 bereich hat eine länge von 0B 2C[hex] also 2680 [d] Zeichen/Bytes. in diesen bereich fällt auch der tag FF D8 ... - ich vermute das dein Bild ein thumbnail-bild hat. diese daten dafür findest du jetzt hier in dem bereich FF D8 bis FF D9 innerhalb des tags FF E1. also bitte einmal schauen ob das so ist...
wenn nicht dann melden ...

cya
soulies
  Mit Zitat antworten Zitat
soulies

Registriert seit: 9. Dez 2005
234 Beiträge
 
#16

Re: JPG (oder JPEG) und Kommentar oder Exif-Daten

  Alt 10. Sep 2007, 11:09
nochmal zwischendurch:

vllt. irre ich mich auch aber du setzt die länge von bb mit
Zitat:
SetLength(bb, 57);
und in deinem elementen gehst du von
bb[0] bis bb[57] --> das sind doch dann 58 oder nicht ?



den ganzen quelltext an sich hab ich noch getestet ....


cya
soulies
  Mit Zitat antworten Zitat
soulies

Registriert seit: 9. Dez 2005
234 Beiträge
 
#17

Re: JPG (oder JPEG) und Kommentar oder Exif-Daten

  Alt 10. Sep 2007, 11:43
hab deinen code eben getestet ....

also wie oben schon angedeutet muss in deinem bsp die länge 58 sein nicht 57.

das funktioniert erstmal richtig, aber mit der einschränkung das das bild vorher
noch kein EXIF bereich hatte ....

wenn doch dann schreibst du deinen bereich noch davor - damit wird es 2 x den EXIF Bereich
geben - wobei nur einer ausgewertet wird und das ist der erste gefundene Bereich

(wenn du also Bilder hast wo kameradaten hinterlegt sind, dann sind diese nicht weg,
sie werden nur nicht angezeigt)

du must dir also einen plan überlegen wie du deine daten in den vllt. schon vorhanden
EXIF bereich integrieren kannst um alle daten zu haben (kameradaten & kommentar usw.)


cya
soulies
  Mit Zitat antworten Zitat
Ralf Stehle

Registriert seit: 8. Aug 2003
124 Beiträge
 
Delphi 7 Professional
 
#18

Re: JPG (oder JPEG) und Kommentar oder Exif-Daten

  Alt 13. Sep 2007, 01:07
Ich bin mit dem Problem weitergekommen. Statt EXIF habe ich IPTC-Kommentare benutzt, da ich beim Experimentieren mit Irfan-View und Hexeditor den Aufbau schneller begriffen habe als den EXIF-Aufbau:

Zunächst mal den allegemeinen Aufbau von IPTC an Hand einese Beispieles:

Nachdem ich mit Irfan-View unter Bild - Information - IPTC-Daten Copyright, Caption, Caption writer, Headline und Spezial instruction eingeben habe, fand ich im Hex-Editor folgende Einträge:


Direkt nach dem ersten Header FF D8 meiner JPEG stehen folgende Bytes
FF ED 00 70 50 68 6F 74 6F 73 68 6F 70 20 33 2E 30 00 38 42 49 4D 04 04 00 00 00 00 00 53 00 53 1C 02 78 00 07 43 61 70 74 69 6F 6E 1C 02 7A 00 0E 43 61 70 74 69 6F 6E 20 77 72 69 74 65 72
1C 02 69 00 08 48 65 61 64 6C 69 6E 65 1C 02 28 00 14 53 70 65 63 69 61 6C 20 69 6E 73 74 72 75 63 74 69 6F 6E 73 1C 02 74 00 09 43 6F 70 79 72 69 67 68 74 00

FF ED Tag für die IPTC-Kommentare
00 70 = Länge (HL, LL): 112 Bytes inclusive der Längenbytes selbst bis zum abschließendem 00-Byte ganz am Ende

50 68 6F 74 6F 73 68 6F 70 = hexadezimale Darstellung für Photoshop
20 33 2E 30 00 38 42 49 4D 04 04 00 00 00 00 = verstehe ich zwar nicht, sind aber anscheinend immer so unverändert vorhanden

00 53 = Länge (HL, LL): 83 Bytes bis zum Ende ohne abschließendes 00-Byte und ohne die 2 Längenbytes mitzuzählen

1C 02 78 00 07 43 61 70 74 69 6F 6E
1C 02 7A 00 0E 43 61 70 74 69 6F 6E 20 77 72 69 74 65 72
1C 02 69 00 08 48 65 61 64 6C 69 6E 65
1C 02 28 00 14 53 70 65 63 69 61 6C 20 69 6E 73 74 72 75 63 74 69 6F 6E 73
1C 02 74 00 09 43 6F 70 79 72 69 67 68 74
00

(1C 02 leitet einen neuen Eintrag ein, 78 ist der Code für Caption, 00 07 = Länge des Eintrages
weitere Möglichkeiten: 78=Caption, 7A=Caption writer, 69=Headline, 28=Spezial instruction, 74=Copyright)

Um verschiedene Einträge zu machen, habe ich folgenden Code ausprobiert. Allerdings fehlt noch die Auswertung schon vorhandener Einträge. Es funktionert also nur wenn noch keine IPTC-Daten eingetragen ware


Vielleicht hat jemand Tipps wie der Code in der Anlage eleganter programmiert werden kann ?
Angehängte Dateien
Dateityp: pas unit1_256.pas (6,2 KB, 9x aufgerufen)
Ralf Stehle
ralfstehle@yahoo.de
  Mit Zitat antworten Zitat
soulies

Registriert seit: 9. Dez 2005
234 Beiträge
 
#19

Re: JPG (oder JPEG) und Kommentar oder Exif-Daten

  Alt 13. Sep 2007, 08:10
hi ralf,

ich hätte wohl auch IPTC genommen ...


Zitat:
(1C 02 leitet einen neuen Eintrag ein, 78 ist der ...
meines wissen leitet '1C02' nicht einen neuen Beitrag ein sondern ist das
Ende zeichen eines Eintrags. (aber ich lass mich gern belehren)

Zitat:
50 68 6F 74 6F 73 68 6F 70 = hexadezimale Darstellung für Photoshop
20 33 2E 30 00 38 42 49 4D 04 04 00 00 00 00 = verstehe ich zwar nicht, sind aber anscheinend immer so unverändert vorhanden
eigentlich muss es heißen: 50 68 6F 74 6F 73 68 6F 70 20 33 2E 30 = Photoshop 3.0
38 42 49 4D 04 04 00 00 00 00 = 8 B I M ... ist wie ein Startmarker
(also danach 'gehts los')


code kann ich im mom nicht testen ...


cya
soulies
  Mit Zitat antworten Zitat
Ralf Stehle

Registriert seit: 8. Aug 2003
124 Beiträge
 
Delphi 7 Professional
 
#20

Kommentare in Jpg-Dateien - Exif oder IPTC

  Alt 30. Sep 2007, 19:52
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;
Ralf Stehle
ralfstehle@yahoo.de
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 14:49 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz