Mit "Delphi Berlin" EXIFs lesen und schreiben?

[Bertram]

Ich vermisse in meinem alten Delphi XE3 eine Komponente zum Lesen und Schreiben der EXIFs in JPGs/TIFFs. Enthält das aktuelle Delphi Berlin so eine Komponente?

[himitsu]

Nein.


Aber die alten Fremdkomponenten sollten weiterhin funktionieren.
Delphi EXIF

[Bertram]

Danke!
Bisher benutze ich CCR-Exif, das allerdings seit längerem nicht mehr gepflegt wird und bei gewissen Kameras Fehler erzeugt. Gibt es eine empfehlenswerte Alternative?

[Benmik]

Und, hast du was gefunden?

Da EXIFTool quasi als Referenz gilt, könnte man - unter Verzicht auf rein natives Delphi - die EXIFTool.exe ansteuern, wie von Bogdan Hrastnik beschrieben:

Delphi-Quellcode:

unit ExifTool;

interface
uses Classes;

var
  ETout, ETerr: TStringList; //data from ExifTool will be here

function ExecuteET(const ETcmd,WorkDir: string): Boolean;

implementation
uses Windows;

function ExecuteET(const ETcmd,WorkDir: string): Boolean;
const
  szBuffer=255;
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  PWorkDir: PChar;
  SecurityAttr: TSecurityAttributes;
  PipeOutputRead: THandle;
  PipeOutputWrite: THandle;
  PipeErrorsRead: THandle;
  PipeErrorsWrite: THandle;
  Succeed: Boolean;
  Buffer: array [0..szBuffer] of Char;
  BytesRead: DWORD;
  Stream: TMemoryStream;
begin
  //=== Usual steps to initialize data for CreateProcess:
  FillChar(Buffer,SizeOf(Buffer),0);
  FillChar(ProcessInfo, SizeOf(TProcessInformation), 0);
  FillChar(SecurityAttr, SizeOf(TSecurityAttributes), 0);
  SecurityAttr.nLength := SizeOf(SecurityAttr);
  SecurityAttr.bInheritHandle := true;
  SecurityAttr.lpSecurityDescriptor := nil;
  CreatePipe(PipeOutputRead, PipeOutputWrite, @SecurityAttr, 0);
  CreatePipe(PipeErrorsRead, PipeErrorsWrite, @SecurityAttr, 0);
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  StartupInfo.cb:=SizeOf(StartupInfo);
  with StartupInfo do begin
    hStdInput:=0; hStdOutput:=PipeOutputWrite; hStdError:=PipeErrorsWrite;
    wShowWindow:=SW_HIDE;
    dwFlags:=STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  end;
  if WorkDir='' then PWorkDir:=nil else PWorkDir:=PChar(WorkDir);
  ETout.Clear; ETerr.Clear;

  //=== Here is where ExifTool is called:
  if  CreateProcess(nil, PChar(ETcmd), nil, nil, true,
    CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,
    nil, PWorkDir, StartupInfo, ProcessInfo)
  then begin      //=ExifTool started successfully:
    result:=true;
    CloseHandle(PipeOutputWrite);
    CloseHandle(PipeErrorsWrite);
  end else begin  //=ExifTool not started (because, i.e. not found):
    result:=false;
    CloseHandle(PipeOutputRead); CloseHandle(PipeOutputWrite);
    CloseHandle(PipeErrorsRead); CloseHandle(PipeErrorsWrite);
  end;

  if result then begin
    //= Get output written by ExifTool(tag names/values):
    Stream:=TMemoryStream.Create;
    try
      repeat
        succeed:=ReadFile(PipeOutputRead,Buffer,szBuffer,BytesRead,nil);
        if not succeed then break;
        Stream.Write(Buffer,BytesRead)
      until (BytesRead=0);
      Stream.Position:=0; ETout.LoadFromStream(Stream);
    finally Stream.Free; end;
    CloseHandle(PipeOutputRead);
    //= Get errors written by ExifTool (if any):
    Stream:=TMemoryStream.Create;
    try
      repeat
        succeed:=ReadFile(PipeErrorsRead,Buffer,szBuffer,BytesRead,nil);
        if not succeed then break;
        Stream.Write(Buffer,BytesRead);
      until (BytesRead=0);
      Stream.Position:=0; ETerr.LoadFromStream(Stream);
    finally Stream.Free; end;
    CloseHandle(PipeErrorsRead);

    WaitForSingleObject(ProcessInfo.hProcess,5000); //=5sec
    CloseHandle(ProcessInfo.hThread); CloseHandle(ProcessInfo.hProcess);
  end;
end;

initialization
begin
  ETout:=TStringList.Create;
  ETerr:=TStringList.Create;
end;

finalization
begin
  ETerr.Free;
  ETout.Free;
end;

end.

Der Aufruf könnte folgendermaßen erfolgen:

Delphi-Quellcode:

uses EXIFTool;

procedure LeseEXIF;
var i:integer; T,ETcmd:string;
begin
  ETcmd := '-Exif:all "C:\Temp\Test.jpg"';
  T     := '';
  if ExecuteET('exiftool ' + ETcmd,'') then begin
    T := '*** ExifTool output:';
    if ETout.Count > 0 then
      For i := 0 to ETout.Count - 1 do 
        T := T + Chr(13) + ETout[i];
    T := T + NZ + '*** ExifTool errors:';
    if ETerr.Count > 0 then
      For i := 0 to ETerr.Count - 1 do 
        T := T + Chr(13) + ETerr[i];
    T := T + Chr(13) + '^^^ END';
    ShowMessage(T);
  end else ShowMessage('EXIFTool.exe nicht gefunden.');
end;