EXIF und Vorschaubild - aktuelle, FreePascal-kompatible Unit?

[FAlter]

Hallo zusammen,

ich hoffe mal auf eure Erfahrungen. Worum geht es?

Ich habe mir mal so um 2007 rum ein Programm geschrieben, welches die EXIF-Daten aus Fotos einliest, die Fotos automatisch dreht, verkleinert und nach Datum sortiert in ein Fotoverzeichnis ablegt (und die Originaldateien in ein Unterverzeichnis).

Das ist noch mit das einzige Programm von meinen damals selbst geschriebenen, welches ich regelmäßig benutze, und ich "brauche" auch immer wieder neue Features.

Um dieses Programm also weiterzuentwickeln brauche ich irgendeine Turbo Delphi Installation. Ich möchte nach Lazarus umsteigen und das Programm nochmals neu entwickeln, wohl auch gleich auf Grundlage von RGBABitmap. Außerdem möchte ich es zukünftig wenn möglich auf meinem Debian Rechner nativ ausführen und in den Genuss der 32GB RAM kommen, die ich extra für Bildbearbeitung gekauft habe (also Linux/amd64 statt Win32).

Ich weiß, dass das ein Brocken ist, das Programm neu zu schreiben. Andererseits wollte ich schon immer die ganzen Quick&Dirty-Teile aus dem Programm entfernen und es "richtig" machen und auch mehrere Threads verwenden, denn seit dem Pentium 4 damals hat sich so einiges bei den Prozessoren geändert.

Die "alte" Exif-Unit scheint aber nicht ganz FreePascal-kompatibel zu sein, und bevor ich mich da ran mache frage ich lieber mal, ob ihr vielleicht eine neue kennt bei der ich nichts anpassen muss.

Anforderungen:
- Ich brauche dringend das Aufnahmedatum (mit Uhrzeit zwecks zukünftiger Erweiterung). Nur wenn es nicht im EXIF steht verwende ich das Dateidatum.
- Ich brauche dringend die Orientierung der Kamera (also wie ich das Bild drehen muss).
- Ich würde gerne ein paar "übliche" Infos mit ausgeben, Kameramarke/-modell, Brennweite/Blende/Belichtungszeit/ISO u.ä.
- Toll wäre es auch, wenn ich die Möglichkeit hätte, das Vorschaubild einzulesen, damit ich nciht das gesamte Bild einlesen muss um eine Vorschau anzuzeigen.

Kennt jemand hier etwas fertiges (in Pascal geschriebenes) für meinen Zweck oder muss ich da selbst ran? Gefunden habe ich nur einen Beitrag im Lazarusforum aber mit einer in C++ geschriebenen Bibliothek, hätte gerne eine ganz normale Pascal-Unit... und kaputte Links. Vielleicht bin ich auch zu blöd zu suchen.

Ergänzung 13.06.2015:
Ich habe mal hier gesucht: http://www.torry.net/quicksearchd.ph...exif&Title=Yes
Für das 1. Ergebnis findet man zig Seiten die sagen, dass es unter FPC nicht läuft.
Das 2. habe ich nciht probiert, hier ist es mir für das Programm nicht wert, 40$ für einen Versuch auszugeben.
3. habe ich ausprobiert und die Demoanwendung nach Lazarus konvertiert. Nach einer weiteren Anpassung funktioniert es. Allerdings kann das keine Vorschaubilder einlesen...
Hier wäre mal meine erste Anpassung der Unit aus Ergebnis 3:

Delphi-Quellcode:

{==============================================================================
Component simple read Exif section in Jpeg/Jfif Files.
More information about Exif at www.exif.org


Component written by SimBa aka Dimoniusis
You may use this component absolutely free.

You may talk with me via
e-mail: [e-mail]
ICQ: 11152101
Web: http://dimonius.da.ru


Changes:
Version 1.3 
 - some more ifd tags implemented
 - some bugs fixes

Version 1.2 (Some code by Jim Wood,  e-mail: [e-mail])
 - some more ifd tags implemented
 - corrected work with ReadOnly files

Version 1.1 (By Ive, e-mail: [e-mail])
 - works now with Motorola and Intel byte order tags
 - better offset calculation
 - some more ifd tags implemented
 - some format functions for rational values
 - naming convention changed a little


NOTE: far away from being complete but it seems to
      work with all example files from www.exif.org

 - Ive (c) 2003




==============================================================================}
//fa150613 Automatische Konvertierung Delphi->Lazarus mittels Assistent (n.zw.)
//         und Anpassung der Funktion SwapLong (plattformunabhängig)

unit Exif;

{$MODE Delphi}

interface

uses
  Classes, SysUtils, FileUtil;

type
  TIfdTag = packed record
    ID      : Word;       //Tag number
    Typ     : Word;       //Type tag
    Count   : Cardinal;   //tag length
    Offset  : Cardinal;   //Offset / Value
  end;

  TExif = class(TObject)
    private
      FImageDesc          : String;     //Picture description
      FMake               : String;     //Camera manufacturer
      FModel              : String;     //Camere model
      FOrientation        : Byte;       //Image orientation - 1 normal
      FOrientationDesc    : String;     //Image orientation description
      FCopyright          : String;     //Copyright
      FValid              : Boolean;    //Has valid Exif header
      FDateTime           : String;     //Date and Time of Change
      FDateTimeOriginal   : String;     //Original Date and Time
      FDateTimeDigitized  : String;     //Camshot Date and Time
      FUserComments       : String;     //User Comments

      FExposure           : String;     //Exposure
      FFstops             : String;
      FShutterSpeed       : string;
      FAperture           : string;
      FMaxAperture        : string;

      FExposureProgram    : Byte;
      FExposureProgramDesc: string;
      FPixelXDimension    : Cardinal;
      FPixelYDimension    : Cardinal;
      FXResolution        : Cardinal;
      FYResolution        : Cardinal;
      FMeteringMode       : byte;
      FMeteringMethod     : string;
      FLightSource        : Byte;
      FLightSourceDesc    : string;
      FFlash              : Byte;
      FFlashDesc          : string;
      FISO                : Word;
      FSoftware           : string;
      FArtist             : string;
      FCompressedBPP      : string;


      f                   : File;
      ifdp                : Cardinal;
      FSwap               : boolean;
      function  ReadAsci(const Offset, Count: Cardinal): String;
      function  ReadRatio(const Offset: Cardinal; frac: boolean): String; overload;
      function  ReadRatio(const Offset: Cardinal): single; overload;
      procedure ReadTag(var tag: TIfdTag);
      procedure Init;
    function ReadLongIntValue(const Offset: Cardinal): LongInt;
    public
      constructor Create;
      procedure ReadFromFile(const FileName: AnsiString);

      property Valid: Boolean read FValid;
      property ImageDesc: String read FImageDesc;
      property Make: String read FMake;
      property Model: String read FModel;
      property Orientation: Byte read FOrientation;
      property OrientationDesc: String read FOrientationDesc;
      property Copyright: String read FCopyright;
      property DateTime: String read FDateTime;
      property DateTimeOriginal: String read FDateTimeOriginal;
      property DateTimeDigitized: String read FDateTimeDigitized;
      property UserComments: String read FUserComments;
      property Software: String read FSoftware;
      property Artist: String read FArtist;

      property Exposure: String read FExposure;
      property ExposureProgram: byte read FExposureProgram;
      property ExposureProgramDesc: string read FExposureProgramDesc;
      property FStops: String read FFStops;
      property ShutterSpeed: String read FShutterSpeed;
      property Aperture: String read FAperture;
      property MaxAperture: String read FMaxAperture;
      property CompressedBPP: String read FCompressedBPP;

      property PixelXDimension: Cardinal read FPixelXDimension;
      property PixelYDimension: Cardinal read FPixelYDimension;
      property XResolution: Cardinal read FXResolution;
      property YResolution: Cardinal read FYResolution;
      property MeteringMode: byte read FMeteringMode;
      property MeteringMethod: string read FMeteringMethod;
      property LightSource: byte read FLightSource;
      property LightSourceDesc: string read FLightSourceDesc;
      property Flash: byte read FFlash;
      property FlashDesc: string read FFlashDesc;
      property ISO: Word read FISO;
  end;

implementation

uses
  Math;

type
  TMarker = packed record
    Marker  : Word;      //Section marker
    Len     : Word;      //Length Section
    Indefin : Array [0..4] of Char; //Indefiner - "Exif" 00, "JFIF" 00 and ets
    Pad     : Char;      //0x00
  end;

  TIFDHeader = packed record
    pad       : Byte; //00h
    ByteOrder : Word; //II (4D4D) or MM
    i42       : Word; //2A00 (magic number from the 'Hitchhikers Guide'
    Offset    : Cardinal; //0th offset IFD
    Count     : Word;     // number of IFD entries
  end;


//fa150613 raus ab hier
//function SwapLong(Value: Cardinal): Cardinal;
//asm bswap eax end;
//fa150613 raus bis hier, rein ab hier
function SwapLong(Value: dword): dword;
var bytes:
  packed record
    case integer of
      1: (b1, b2, b3, b4: byte);
      2: (dw: dword);
  end;
  byteSwap: byte;
begin
  bytes.dw := value;
  byteSwap := bytes.b1;
  bytes.b1 := bytes.b4;
  bytes.b4 := bytes.b1;
  byteSwap := bytes.b2;
  bytes.b2 := bytes.b3;
  bytes.b3 := bytes.b2;
  result := bytes.dw;
end;
//fa150613 rein bis hier

procedure TExif.ReadTag(var tag: TIfdTag);
begin
  BlockRead(f,tag,12);
  if FSwap then with tag do begin // motorola or intel byte order ?
    ID  := Swap(ID);
    Typ := Swap(Typ);
    Count := SwapLong(Count);
    if (Typ=1) or (Typ=3) then
      Offset := (Offset shr 8) and $FF
    else
      Offset  := SwapLong(Offset);
    end
  else with tag do begin
    if ID<>$8827 then  //ISO Metering Mode not need conversion
      if (Typ=1) or (Typ=3) then
        Offset := Offset and $FF; // other bytes are undefined but maybe not zero
  end;
end;


function TExif.ReadAsci(const Offset, Count: Cardinal): String;
var
  fp: LongInt;
  i: Word;
begin
  SetLength(Result,Count);
  fp:=FilePos(f); //Save file offset
  Seek(f, Offset);
  try
    i:=1;
    repeat
      BlockRead(f,Result[i],1);
      inc(i);
    until (i>=Count) or (Result[i-1]=#0);
    if i<=Count then Result:=Copy(Result,1,i-1);
  except
    Result:='';
  end;
  Result:=TrimRight(Result);
  Seek(f,fp);     //Restore file offset
end;

function TExif.ReadLongIntValue(const Offset: Cardinal): LongInt;
var
  fp: LongInt;
begin
  fp:=FilePos(f); //Save file offset
  Seek(f, Offset);
  try
    BlockRead(f, Result, sizeof(Result));
    if FSwap then Result:=SwapLong(Result);
  except
    Result:=0;
  end;
  Seek(f, fp); //Restore file offset
end;

function TExif.ReadRatio(const Offset: Cardinal; frac: boolean): String;
var
  fp: LongInt;
  nom,denom: cardinal;
begin
  fp:=FilePos(f); //Save file offset
  Seek(f, Offset);
  try
    BlockRead(f,nom,4);
    BlockRead(f,denom,4);
    if FSwap then begin     // !!!
      nom := SwapLong(nom);
      denom := SwapLong(denom);
    end;
    if frac then begin
      str((nom/denom):1:2, result);
      if (length(result)>0) and (result[length(result)]='0') then Result:=copy(Result,1,length(Result)-1);
    end else
      if denom<>1000000 then
        Result:=inttostr(nom)+'/'+inttostr(denom)
      else Result:='0';
  except
    Result:='';
  end;
  Seek(f,fp);     //Restore file offset
end;


function TExif.ReadRatio(const Offset: Cardinal): single;
var
  fp: LongInt;
  nom,denom: cardinal;
begin
  fp:=FilePos(f); //Save file offset
  Seek(f, Offset);
  try
    BlockRead(f,nom,4);
    BlockRead(f,denom,4);
    if FSwap then begin     // !!!
      nom := SwapLong(nom);
      denom := SwapLong(denom);
    end;
    Result:=nom/denom;
  except
    Result:=0.0;
  end;
  Seek(f,fp);     //Restore file offset
end;


procedure TExif.Init;
begin
  ifdp:=0;

  FImageDesc:='';
  FMake:='';
  FModel:='';
  FOrientation:=0;
  FOrientationDesc:='';
  FDateTime:='';
  FCopyright:='';
  FValid:=False;
  FDateTimeOriginal:='';
  FDateTimeDigitized:='';
  FUserComments:='';
  FExposure:='';
  FFstops:='';
  FShutterSpeed := '';
  FAperture := '';
  FExposureProgram:=0;
  FExposureProgramDesc:='';
  FPixelXDimension:=0;
  FPixelYDimension:=0;
  FMeteringMode:=0;
  FMeteringMethod:='';
  FLightSource:=0;
  FLightSourceDesc:='';
  FFlash:=0;
  FFlashDesc:='';
  FISO:=0;
  FCompressedBPP:='';
  FArtist:='';
  FSoftware:='';
  FMaxAperture:='';
  FXResolution:=0;
  FYResolution:=0;
end;


constructor TExif.Create;
begin
  Init;
end;


procedure TExif.ReadFromFile(const FileName: AnsiString);
const
  orient   : Array[1..9] of String=('Normal','Mirrored','Rotated 180','Rotated 180, mirrored','Rotated 90 left, mirrored','Rotated 90 right','Rotated 90 right, mirrored','Rotated 90 left','Unknown');
  ExplType : Array[1..9] of String=('Unknown','Manual Control','Normal Program','Aperture Priority', 'Shutter Priority', 'Creative Program','Action Program','Portrait Mode','Landscape Mode');
  Meter    : Array[0..7] of String=('Unknown','Average','Center Weighted Average','Spot','Multi Spot','Pattern','Partial','Other');
var
  j:      TMarker;
  ifd:    TIFDHeader;
  off0:   Cardinal; //Null Exif Offset
  tag:    TIfdTag;
  i:      Integer;
  n:      Single;
  SOI:    Word; //2 bytes SOI marker. FF D8 (Start Of Image)
  IfdCnt: Word;
  Tmp   : string;

begin
  if not FileExistsUTF8(FileName) { *Converted from FileExists* } then exit;
  Init;

  System.FileMode:=0; //Read Only open
  AssignFile(f,FileName);
  reset(f,1);

  BlockRead(f,SOI,2);
  if SOI=$D8FF then begin //Is this Jpeg
    BlockRead(f,j,9);

    if j.Marker=$E0FF then begin //JFIF Marker Found
      Seek(f,20); //Skip JFIF Header
      BlockRead(f,j,9);
    end;

    //Search Exif start marker;
    if j.Marker<>$E1FF then begin
      i:=0;
      repeat
        BlockRead(f,SOI,2); //Read bytes.
        inc(i);
      until (EOF(f) or (i>1000) or (SOI=$E1FF));
      //If we find maker
      if SOI=$E1FF then begin
        Seek(f,FilePos(f)-2); //return Back on 2 bytes
        BlockRead(f,j,9);     //read Exif header
      end;
    end;

    if j.Marker=$E1FF then begin //If we found Exif Section. j.Indefin='Exif'.
      FValid:=True;
      off0:=FilePos(f)+1;   //0'th offset Exif header
      BlockRead(f,ifd,11);  //Read IDF Header
      FSwap := ifd.ByteOrder=$4D4D; // II or MM  - if MM we have to swap
      if FSwap then begin
        ifd.Offset := SwapLong(ifd.Offset);
        ifd.Count  := Swap(ifd.Count);
      end;
      if ifd.Offset <> 8 then begin
        Seek(f, FilePos(f)+abs(ifd.Offset)-8);
      end;

      if (ifd.Count=0) then ifd.Count:=100;

      for i := 1 to ifd.Count do begin
        ReadTag(tag);
        case tag.ID of
              0: break;
  // ImageDescription
          $010E: FImageDesc:=ReadAsci(tag.Offset+off0, tag.Count);
  // Make
          $010F: FMake:=ReadAsci(tag.Offset+off0, tag.Count);
  // Model
          $0110: FModel:=ReadAsci(tag.Offset+off0, tag.Count);
  // Orientation
          $0112: begin
                   FOrientation:= tag.Offset;
                   if FOrientation in [1..8] then
                     FOrientationDesc:=orient[FOrientation]
                   else
                     FOrientationDesc:=orient[9];//Unknown
                 end;
  // DateTime
          $0132: FDateTime:=ReadAsci(tag.Offset+off0, tag.Count);
  // CopyRight
          $8298: FCopyright:=ReadAsci(tag.Offset+off0, tag.Count);
  // Software
          $0131: FSoftware:=ReadAsci(tag.Offset+off0, tag.Count);
  // Artist
          $013B: FArtist:=ReadAsci(tag.Offset+off0, tag.Count);
  // Exif IFD Pointer
          $8769: ifdp:=Tag.Offset; //Read Exif IFD offset
  //XResolution
          $011A: FXResolution := ReadLongIntValue(Tag.Offset+off0);
  //YResolution
          $011B: FYResolution := ReadLongIntValue(Tag.Offset+off0);
        end;
      end;

      if ifdp>0 then begin
        Seek(f,ifdp+off0);
        BlockRead(f,IfdCnt,2);
        if FSwap then IfdCnt := swap(IfdCnt);
        for i := 1 to IfdCnt do begin
          ReadTag(tag);
  {
          You may simple realize read this info:

          Tag |Name of Tag

          9000 ExifVersion
          0191 ComponentsConfiguration
          0392 BrightnessValue
          0492 ExposureBiasValue
          0692 SubjectDistance
          0A92 FocalLength
          9092 SubSecTime
          9192 SubSecTimeOriginal
          9292 SubSecTimeDigitized
          A000 FlashPixVersion
          A001 Colorspace
  }
          case tag.ID of
                0: break;
  // ExposureTime
            $829A: FExposure:=ReadRatio(tag.Offset+off0, false)+' seconds';
  // Compressed Bits Per Pixel
            $9102: FCompressedBPP:=ReadRatio(tag.Offset+off0, true);
  // F-Stop
            $829D: FFStops:=ReadRatio(tag.Offset+off0, true);
  // FDateTimeOriginal
            $9003: FDateTimeOriginal:=ReadAsci(tag.OffSet+off0,tag.Count);
  // DateTimeDigitized
            $9004: FDateTimeDigitized:=ReadAsci(tag.OffSet+off0,tag.Count);
  // ShutterSpeed
            $9201: try
                     n:=ReadRatio(tag.Offset+off0);
                     if n<65535 then begin
                       str(power(2,n):1:0,tmp);
                       FShutterSpeed:='1/'+tmp+' seconds';
                     end else FShutterSpeed:='1 seconds';
                   except
                     FShutterSpeed:='';
                   end;
  //ISO Speed
            $8827: FISO:=Tag.Offset;
  // Aperture
            $9202: FAperture:=ReadRatio(tag.Offset+off0, true);
  // Max Aperture
            $9205: FMaxAperture:=ReadRatio(tag.Offset+off0, true);
  // UserComments
            $9286: FUserComments:=ReadAsci(tag.OffSet+off0,tag.Count);
  // Metering Mode
            $9207: begin
                     FMeteringMode := Tag.OffSet;
                     if Tag.OffSet in [0..6] then
                       FMeteringMethod := Meter[Tag.OffSet]
                     else
                       if Tag.OffSet=7 then
                         FMeteringMethod := Meter[7]  //Other
                       else
                         FMeteringMethod := Meter[0]; //Unknown
                   end;
  // Light Source
             $9208: begin
                     FLightSource:=Tag.OffSet;
                     case Tag.OffSet of
                        0: FLightSourceDesc := 'Unknown';
                        1: FLightSourceDesc := 'Daylight';
                        2: FLightSourceDesc := 'Flourescent';
                        3: FLightSourceDesc := 'Tungsten';
                       10: FLightSourceDesc := 'Flash';
                       17: FLightSourceDesc := 'Standard Light A';
                       18: FLightSourceDesc := 'Standard Light B';
                       19: FLightSourceDesc := 'Standard Light C';
                       20: FLightSourceDesc := 'D55';
                       21: FLightSourceDesc := 'D65';
                       22: FLightSourceDesc := 'D75';
                      255: FLightSourceDesc := 'Other';
                     else
                       FLightSourceDesc := 'Unknown';
                     end;
                   end;  
  //Flash
            $9209: begin
                     FFlash:=Tag.OffSet;
                     case Tag.OffSet of
                       0: FFlashDesc := 'No Flash';
                       1: FFlashDesc := 'Flash';
                       5: FFlashDesc := 'Flash No Strobe';
                       7: FFlashDesc := 'Flash Strobe';
                      25: FFlashDesc := 'Flash (Auto)';
                     else
                       FFlashDesc := 'No Flash';
                     end;
                   end;
  //Exposure
            $8822: begin
                     FExposureProgram:=Tag.OffSet;
                     if Tag.OffSet in [1..8] then
                       FExposureProgramDesc := ExplType[Tag.OffSet]
                     else
                       FExposureProgramDesc := ExplType[9];
                   end;
  //PixelXDimension
             $A002: FPixelXDimension := Tag.Offset;
  //PixelYDimension
             $A003: FPixelYDimension := Tag.Offset;
          end;
        end;
      end;
    end;
  end;
  CloseFile(f);
end;

end.

Notfalls passe ich das weiter an, sodass es mit Streams arbeitet. Wäre aber schön, wenn ich noch an das Vorschaubild ran käme.

Viele Grüße

Felix

[wohaps]

Kleiner Fehler noch in der Fkt SwapLong.
Bei Intel hats vermutlich immer geklappt

[KodeZwerg]

Hier ist ein Lazarus 1.0/fpc 2.6.0 up to Lazarus 1.9/fpc 3.0.4, Delphi 7.0, Delphi XE2 und Delphi 10.2 Tokyo kompatibles EXIF Projekt.
Achtung, der Author sagt selbst das ein schreiben von EXIF Daten die Datei zerstören kann, aber Du wolltest ja nur lesen.
Ein Bildbetrachter ist glaube ich nicht enthalten.
Ich hoffe das ist was Du brauchst oder bringt Dich Deinem Ziel näher.

[jus]

Hallo Felix,

einer von unserem Lazarustreffen hat gemeinsam mit einem anderen das alte DExif vom Originalautor Gerry McGuire aus dem Jahre 2006 mit dessen Genehmigung auf Lazarus portiert. Der Anspruch ist aktuell sogar, dass es unter Delphi und Lazarus lauffähig sein soll.

Du findest die aktuelle Version hier.



Lg,
jus