unit ExifReader;
(*********************************************************************
    Copyright (C) 2000 Lars B. Dybdahl, lars@dybdahl.dk

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*********************************************************************)

interface

uses
  Classes;

// This class will read the Exif information from a jpeg file.
// When an object has been created, the variables are already set by the contents
// of the file specified in the create constructor.
//
// This involves two standards:
//   Exif 2.1
//   ISO/DIS 12234-2
//
// The class is optimized to work best, not to comply best with the standards.

type
  TExifReaderRational=
    record
      ValueHasBeenSet:Boolean;  // A value is only present if this is TRUE
      Numerator:Cardinal;
      Denominator:Cardinal;
    end;
  TExifReaderSRational=
    record
      ValueHasBeenSet:Boolean;  // A value is only present if this is TRUE
      Numerator:integer;
      Denominator:integer;
    end;
  TExifReaderWord=
    record
      Value:Word;
      ValueHasBeenSet:Boolean;
    end;
  TExifReader=
    class
    private
      procedure ReadIFD (fs:TMemoryStream;TIFFStart:Cardinal);
      procedure ReadExifIFD (fs:TMemoryStream;TIFFStart:Cardinal);
      procedure ReadGPSIFD (fs:TMemoryStream;TIFFStart:Cardinal);
      procedure ReadApp1 (fs:TMemoryStream);
      procedure ReadApp2 (fs:TMemoryStream);
    public
      // General information
      ExifVersion:string;
      RelatedAudioFile:string;
      DateTimeOriginal:string;
      DateTimeDigitized:string;
      SubSecTimeOriginal:string;
      SubSecTimeDigitized:string;
      ImageInputEquipmentManufacturer:string;
      ImageInputEquipmentModel:string;
      ImageWidth,
      ImageHeight:Cardinal;
      Software:string;

      // Tags relating to picture-taking conditions
      ExposureTime:TExifReaderRational;
      FNumber:TExifReaderRational;
      ExposureProgram:TExifReaderWord;
      SpectralSensitivity:string;
      ISOSpeedRatings:TExifReaderWord;
      ShutterSpeedValue:TExifReaderSRational;
      ApertureValue:TExifReaderRational;
      BrightnessValue:TExifReaderSRational;
      ExposureBiasValue:TExifReaderSRational;
      MaxApertureValue:TExifReaderRational;
      SubjectDistance:TExifReaderRational;
      MeteringMode:TExifReaderWord;
      LightSource:TExifReaderWord;
      Flash:TExifReaderWord;
      FocalLength:TExifReaderRational;
      FlashEnergy:TExifReaderRational;
      FocalPlaneXResolution:TExifReaderRational;
      FocalPlaneYResolution:TExifReaderRational;
      FocalPlaneResolutionUnit:TExifReaderWord;
      ExposureIndex:TExifReaderRational;
      SensingMethod:TExifReaderWord;

      // GPS information
      GPSLatitudeRef:string;
      GPSLongitudeRef:string;
      
      constructor Create (filename:string);
    end;


function RationalToFloat (r:TExifReaderRational):Double; overload;
function RationalToFloat (r:TExifReaderSRational):Double; overload;
function RationalToFloatStr (r:TExifReaderRational):string; overload;
function RationalToFloatStr (r:TExifReaderSRational):string; overload;
function RationalToStr (r:TExifReaderRational):string; overload;
function RationalToStr (r:TExifReaderSRational):string; overload;

function ExplainExposureProgram (w:Word):string;
function ExplainMeteringMode (w:Word):string;
function ExplainLightSource (w:Word):string;
function ExplainFlash(w:Word):string;
function ExplainResolutionUnit(w:word):string;  // Also applies to FocalPlaneResolutionUnit
function ExplainSensingMethod (w:word):string;



implementation

uses
  SysUtils;


function Float2StrUS (d:double):string;
var
  i:integer;
begin
  Result:=FloatToStr(d);
  i:=pos(',',Result);
  if i<>0 then
    Result[i]:='.';
end;

function RationalToFloatStr (r:TExifReaderRational):string;
begin
  Result:=Float2StrUS(RationalToFloat(r));
end;

function RationalToFloatStr (r:TExifReaderSRational):string;
begin
  Result:=Float2StrUS(RationalToFloat(r));
end;

function RationalToStr (r:TExifReaderRational):string;
begin
  if not r.ValueHasBeenSet then
    raise Exception.Create ('Error: Rational value has not been set.');
  Result:=IntToStr(r.Numerator)+'/'+IntToStr(r.Denominator);
end;

function RationalToStr (r:TExifReaderSRational):string;
begin
  if not r.ValueHasBeenSet then
    raise Exception.Create ('Error: Rational value has not been set.');
  if r.Denominator<0 then begin
    r.Denominator:=-r.Denominator;
    r.Numerator:=-r.Numerator;
  end;
  Result:=IntToStr(r.Numerator)+'/'+IntToStr(abs(r.Denominator));
end;

function RationalToFloat (r:TExifReaderRational):Double;
begin
  if not r.ValueHasBeenSet then
    raise Exception.Create ('Error: Rational value has not been set.');
  Result:=r.Numerator/r.Denominator;
end;

function RationalToFloat (r:TExifReaderSRational):Double;
begin
  if not r.ValueHasBeenSet then
    raise Exception.Create ('Error: Rational value has not been set.');
  Result:=r.Numerator/r.Denominator;
end;

function ExplainExposureProgram (w:Word):string;
begin
  case w of
    0:Result:='Not defined';
    1:Result:='Manual';
    2:Result:='Normal program';
    3:Result:='Aperture priority';
    4:Result:='Shutter priority';
    5:Result:='Creative program (biased toward depth of field)';
    6:Result:='Action program (biased toward fast shutter speed)';
    7:Result:='Portrait mode (for closeup photos with the background out of focus)';
    8:Result:='Landscape mode (for landscape photos with the background in focus)';
  else
    Result:='Reserved ExposureProgram value: '+IntToStr(w);
  end;
end;

function ExplainMeteringMode (w:Word):string;
begin
  case w of
    0:Result:='Unknown';
    1:Result:='Average';
    2:Result:='Center weighted average';
    3:Result:='Spot';
    4:Result:='Multispot';
    5:Result:='Pattern';
    6:Result:='Partial';
  else
    Result:='Reserved metering mode value: '+IntToStr(w);
  end;
end;

function ExplainLightSource (w:Word):string;
begin
  case w of
    0:Result:='Unknown';
    1:Result:='Daylight';
    2:Result:='Fluorescent';
    3:Result:='Tungsten';
    17:Result:='Standard light A';
    18:Result:='Standard light B';
    19:Result:='Standard light C';
    20:Result:='D55';
    21:Result:='D65';
    22:Result:='D75';
    255:Result:='Other';
  else
    Result:='Reserved light source value: '+IntToStr(w);
  end;
end;

function ExplainFlash(w:Word):string;
begin
  case w of
    0,2,4,6:Result:='No flash';
    1:Result:='Flash fired';
    5:Result:='Flash fired, strobe return light not detected';
    7:Result:='Flash fired, strobe return light detected';
  else
    Result:='Unknown flash value: '+IntToStr(w);
  end;
end;

function ExplainResolutionUnit(w:word):string;
begin
  case w of
    2:Result:='"';
    3:Result:='cm';
  else
    Result:='Unit: '+IntToStr(w);
  end;
end;

function ExplainSensingMethod (w:word):string;
begin
  case w of
    0:Result:='';
    1:Result:='Not defined';
    2:Result:='One-chip color area sensor';
    3:Result:='Two-chip color area sensor';
    4:Result:='Three-chip color area sensor';
    5:Result:='Color sequential area sensor';
    7:Result:='Trilinear sensor';
    8:Result:='Color sequential linear sensor';
  else
    Result:='Unknown sensing method value: '+IntToStr(w);
  end;
end;








resourcestring
  ErrorReadBeyondEndOfFile='Read beyond end of file.';

function ReadWord (fs:TStream):Word;
var
  b1,b2:byte;
begin
  if fs.Read (b1,1)<>1 then
    raise Exception.Create (ErrorReadBeyondEndOfFile);
  if fs.Read (b2,1)<>1 then
    raise Exception.Create (ErrorReadBeyondEndOfFile);
  Result:=b1*256+b2;
end;

function Read3Bytes (fs:TStream):integer;
var
  b1,b2,b3:byte;
begin
  if fs.Read (b1,1)<>1 then
    raise Exception.Create (ErrorReadBeyondEndOfFile);
  if fs.Read (b2,1)<>1 then
    raise Exception.Create (ErrorReadBeyondEndOfFile);
  if fs.Read (b3,1)<>1 then
    raise Exception.Create (ErrorReadBeyondEndOfFile);
  Result:=(b1*256+b2)*256+b3;
end;

function ReadCardinal (fs:TStream):Cardinal;
var
  w1,w2:byte;
begin
  w1:=ReadWord(fs);
  w2:=ReadWord(fs);
  Result:=w2+(w1 shl 16);
end;

function ReadIntelWord (fs:TStream):Word;
var
  b1,b2:byte;
begin
  if fs.Read (b1,1)<>1 then
    raise Exception.Create (ErrorReadBeyondEndOfFile);
  if fs.Read (b2,1)<>1 then
    raise Exception.Create (ErrorReadBeyondEndOfFile);
  Result:=b1+b2*256;
end;

function ReadIntelCardinal (fs:TStream):Cardinal;
var
  w1,w2:Word;
begin
  w1:=ReadIntelWord (fs);
  w2:=ReadIntelWord (fs);
  Result:=w1+(w2 shl 16);
end;

procedure Skipbytes (mem:TMemoryStream;numbytes:integer);
begin
  mem.Seek (mem.Position+numbytes,soFromBeginning);
end;

procedure Skipblock2 (mem:TMemoryStream);
begin
  Skipbytes (mem,ReadWord (mem)-2);
end;

procedure Skipblock3 (mem:TMemoryStream);
begin
  Skipbytes (mem,Read3Bytes (mem)-3);
end;

procedure ReadRational (mem:TMemoryStream;OffsetOrg,Offset:Cardinal;var Rational:TExifReaderRational);
begin
  mem.Seek (OffsetOrg+Offset,soFromBeginning);
  mem.Read (Rational.Numerator,4);
  mem.Read (Rational.Denominator,4);
  Rational.ValueHasBeenSet:=true;
end;

procedure ReadSRational (mem:TMemoryStream;OffsetOrg,Offset:Cardinal;var Rational:TExifReaderSRational);
begin
  mem.Seek (OffsetOrg+Offset,soFromBeginning);
  mem.Read (Rational.Numerator,4);
  mem.Read (Rational.Denominator,4);
  Rational.ValueHasBeenSet:=true;
end;

function ReadUInteger (mem:TMemoryStream;FieldType:Word;Count:Cardinal;OffsetOrg,Offset:Cardinal):Cardinal;
begin
  case FieldType of
    1:Result:=Offset and $ff;  // One byte
    3:Result:=Offset and $ffff;
    4:Result:=Offset;
  else
    raise Exception.Create ('Invalid field type for ReadUInteger');
  end;
end;

function ReadString (mem:TMemoryStream;Count:Cardinal;OffsetOrg,Offset:Cardinal):string;
begin
  if Count<=4 then begin
    // read from Offset value
    Result:='';
    if Count>=2 then Result:=Result+char(Offset and $ff);
    if Count>=3 then Result:=Result+char((Offset and $ff00) shr 8);
    if Count>=4 then Result:=Result+char((Offset and $ff0000) shr 16);
  end else begin
    // Read from other place in memory
    SetLength (Result,Count-1);
    mem.Seek (OffsetOrg+Offset,soFromBeginning);
    mem.Read (Result[1],Count-1);
  end;
end;

function ReadDateTime (mem:TMemoryStream;Count:Cardinal;OffsetOrg,Offset:Cardinal):string;
var
  s:string;
begin
  Result:='';
  if Count<>20 then
    exit;
  s:=ReadString (mem,Count,OffsetOrg,Offset);
  if not((s[9] in ['0'..'3']) and (s[18] in ['0'..'5'])) then
    exit;
  s[5]:='-';
  s[8]:='-';
  s[14]:=':';
  s[17]:=':';
  Result:=s;
end;



{ TExifReader }

procedure TExifReader.ReadIFD (fs:TMemoryStream;TIFFStart:Cardinal);
var
  i:Word;
  IFDNumFields:Word;
  IFDPosition:cardinal;
  FieldTag:Word;
  FieldType:Word;
  FieldCount:Cardinal;
  FieldOffset:Cardinal;
begin
  // Store start position of IFD
  IFDPosition:=fs.Position;

  // Get number of fields in this IFD
  IFDNumFields:=ReadIntelWord (fs);

  // Loop through all fields
  if IFDNumFields>=1 then
  for i:=0 to IFDNumFields-1 do begin
    fs.Seek (IFDPosition+2+i*12,soFromBeginning);
    FieldTag:=ReadIntelWord (fs);
    FieldType:=ReadIntelWord (fs);
    FieldCount:=ReadIntelCardinal (fs);
    FieldOffset:=ReadIntelCardinal (fs);
    case FieldTag of
      $0100:
        if FieldType in [1,3,4] then
          ImageWidth:=
            ReadUInteger (fs,FieldType,FieldCount,TIFFStart,FieldOffset);
      $0101:
        if FieldType in [1,3,4] then
          ImageWidth:=
            ReadUInteger (fs,FieldType,FieldCount,TIFFStart,FieldOffset);
      $010F:
        if (FieldType=2) then
          ImageInputEquipmentManufacturer:=
            ReadString (fs,FieldCount,TIFFStart,FieldOffset);
      $0110:
        if (FieldType=2) then
          ImageInputEquipmentModel:=
            ReadString (fs,FieldCount,TIFFStart,FieldOffset);
      $0131:
        if (FieldType=2) then
          Software:=
            ReadString (fs,FieldCount,TIFFStart,FieldOffset);
      $8769:
        if (FieldType=4) and (FieldCount=1) then begin
          fs.Seek (TIFFStart+FieldOffset,soFromBeginning);
          ReadExifIFD (fs,TIFFStart);
        end;
      $8825: // GPS IFD, see page 19 in Exis 2.1 spec.
        if (FieldType=4) and (FieldCount=1) then
          ReadGPSIFD (fs,TIFFStart);
      $a005:; // Interoperability IFD, see page 19 in Exis spec
    end;
  end;

  // Find next IFD
  (*
  fs.Seek (IFDPosition+2+IFDNumFields*12,soFromBeginning);
  Result:=ReadIntelCardinal (fs);
  fs.Seek (IFDPosition+Result,soFromBeginning);
  *)
end;

procedure TExifReader.ReadApp1 (fs:TMemoryStream);
var
  size:Cardinal;
  buf:array[0..5] of byte;
  App1Start:Cardinal;
  TIFFStart:Cardinal;
begin
  // Get size of App1 section
  App1Start:=fs.Position;
  size:=ReadWord(fs);

  // Get Exif marker. Exit if it is not there.
  fs.Read (buf,6);
  if (buf[0]<>$45) or (buf[1]<>$78) or (buf[2]<>$69) or (buf[3]<>$66) or (buf[4]<>0) or (buf[5]<>0) then begin
    fs.Read (buf,size-10);
    exit;
  end;

  // Skip TIFF header
  // It seems always to be: 49 49 2A 00 08 00 00 00
  TIFFStart:=fs.Position;
  Skipbytes (fs,8);

  ReadIFD (fs,TIFFStart);

  // Skip to end of App1 section
  fs.Seek (App1Start+size,soFromBeginning);
end;

procedure TExifReader.ReadApp2(fs: TMemoryStream);
var
  size:Word;
begin
  // Get size of App2 section
  size:=ReadWord(fs);

  // Skip this App2 section, because reading it is not implemented.
  Skipbytes (fs,size-2);
end;


constructor TExifReader.Create(filename: string);
var
  mem:TMemoryStream;
  buf:word;
begin
  inherited Create;
  mem:=TMemoryStream.Create;
  try
    // Read entire file
    mem.LoadFromFile (filename);
    mem.Seek (0,soFromBeginning);

    // Check for the SOI marker code, that indicates the start of compressed data
    if ReadWord (mem)<>$ffd8 then
      exit;

    // Check for next marker code
    while mem.Read (buf,2)=2 do begin 
      case swap(buf) of
        $ffc0:Skipblock2 (mem);   // Start of frame
        $ffc4:Skipblock2 (mem);
        $ffd9:exit;               // End of image
        $ffda:Skipblock2 (mem);   // start of scan
        $ffdb:Skipblock3 (mem);
        $ffdd:Skipblock2 (mem);   // Define restart interoperability
        $ffe0:Skipblock2 (mem);   // JFIF stuff
        $ffe1:ReadApp1 (mem);     // APP1 structure, TIFF formatted
        $ffe2:ReadApp2 (mem);     // APP2 structure
      else
        Skipblock3 (mem);
      end;
    end;
  finally
    FreeAndNil (mem);
  end;
end;

procedure TExifReader.ReadExifIFD(fs: TMemoryStream;TIFFStart:Cardinal);
var
  i:Word;
  IFDNumFields:Word;
  IFDPosition:cardinal;
  FieldTag:Word;
  FieldType:Word;
  FieldCount:Cardinal;
  FieldOffset:Cardinal;
  s:string;
begin
  // Store start position of IFD
  IFDPosition:=fs.Position;

  // Get number of fields in this IFD
  IFDNumFields:=ReadIntelWord (fs);

  // Loop through all fields
  if IFDNumFields>=1 then
  for i:=0 to IFDNumFields-1 do begin
    fs.Seek (IFDPosition+2+i*12,soFromBeginning);
    FieldTag:=ReadIntelWord (fs);
    FieldType:=ReadIntelWord (fs);
    FieldCount:=ReadIntelCardinal (fs);
    FieldOffset:=ReadIntelCardinal (fs);
    case FieldTag of
      $829A:if FieldType=5 then ReadRational (fs,TIFFStart,FieldOffset,ExposureTime);
      $829D:if FieldType=5 then ReadRational (fs,TIFFStart,FieldOffset,FNumber);
      $8822:begin
              ExposureProgram.Value:=ReadUInteger (fs,FieldType,FieldCount,TIFFStart,FieldOffset);
              ExposureProgram.ValueHasBeenSet:=true;
            end;
      $8824:if FieldType=2 then SpectralSensitivity:=ReadString (fs,FieldCount,TIFFStart,FieldOffset);
      $8827:begin
              ISOSpeedRatings.Value:=ReadUInteger (fs,FieldType,FieldCount,TIFFStart,FieldOffset);
              ISOSpeedRatings.ValueHasBeenSet:=true;
            end;
      $9000:if FieldType=2 then ExifVersion:=ReadString (fs,FieldCount,TIFFStart,FieldOffset);
      $9003:if FieldType=2 then DateTimeOriginal:=ReadDateTime (fs,FieldCount,TIFFStart,FieldOffset);
      $9004:if FieldType=2 then DateTimeDigitized:=ReadDateTime (fs,FieldCount,TIFFStart,FieldOffset);
      $9201:if FieldType=10 then ReadSRational (fs,TIFFStart,FieldOffset,ShutterSpeedValue);
      $9202:if FieldType=5 then ReadRational (fs,TIFFStart,FieldOffset,ApertureValue);
      $9203:if FieldType=10 then ReadSRational (fs,TIFFStart,FieldOffset,BrightnessValue);
      $9204:if FieldType=10 then ReadSRational (fs,TIFFStart,FieldOffset,ExposureBiasValue);
      $9205:if FieldType=5 then ReadRational (fs,TIFFStart,FieldOffset,MaxApertureValue);
      $9206:if FieldType=5 then ReadRational (fs,TIFFStart,FieldOffset,SubjectDistance);
      $9207:begin
              MeteringMode.Value:=ReadUInteger (fs,FieldType,FieldCount,TIFFStart,FieldOffset);
              MeteringMode.ValueHasBeenSet:=true;
            end;
      $9208:begin
              LightSource.Value:=ReadUInteger (fs,FieldType,FieldCount,TIFFStart,FieldOffset);
              LightSource.ValueHasBeenSet:=true;
            end;
      $9209:begin
              Flash.Value:=ReadUInteger (fs,FieldType,FieldCount,TIFFStart,FieldOffset);
              Flash.ValueHasBeenSet:=true;
            end;
      $920A:if FieldType=5 then ReadRational (fs,TIFFStart,FieldOffset,FocalLength);
      $920B:if FieldType=5 then ReadRational (fs,TIFFStart,FieldOffset,FlashEnergy);
      $920E:if FieldType=5 then ReadRational (fs,TIFFStart,FieldOffset,FocalPlaneXResolution);
      $920F:if FieldType=5 then ReadRational (fs,TIFFStart,FieldOffset,FocalPlaneYResolution);
      $9210:begin
              FocalPlaneResolutionUnit.Value:=ReadUInteger (fs,FieldType,FieldCount,TIFFStart,FieldOffset);
              FocalPlaneResolutionUnit.ValueHasBeenSet:=true;
            end;
      $9291:if FieldType=2 then SubSecTimeOriginal:=ReadString (fs,FieldCount,TIFFStart,FieldOffset);
      $9292:if FieldType=2 then SubSecTimeDigitized:=ReadString (fs,FieldCount,TIFFStart,FieldOffset);
      $A004:if FieldType=2 then begin
              s:=ReadString (fs,FieldCount,TIFFStart,FieldOffset);
              if RelatedAudioFile<>'' then RelatedAudioFile:=RelatedAudioFile+', ';
              RelatedAudioFile:=RelatedAudioFile+s;
            end;
      $A005:; // Interoperability IFD
      $A215:if FieldType=5 then ReadRational (fs,TIFFStart,FieldOffset,ExposureIndex);
      $A217:begin
              SensingMethod.Value:=ReadUInteger (fs,FieldType,FieldCount,TIFFStart,FieldOffset);
              SensingMethod.ValueHasBeenSet:=true;
            end;
    end;
  end;
end;

procedure TExifReader.ReadGPSIFD(fs: TMemoryStream;TIFFStart:Cardinal);
var
  i:Word;
  IFDNumFields:Word;
  IFDPosition:cardinal;
  FieldTag:Word;
  FieldType:Word;
  FieldCount:Cardinal;
  FieldOffset:Cardinal;
begin
  // Store start position of IFD
  IFDPosition:=fs.Position;

  // Get number of fields in this IFD
  IFDNumFields:=ReadIntelWord (fs);

  // Loop through all fields
  if IFDNumFields>=1 then
  for i:=0 to IFDNumFields-1 do begin
    fs.Seek (IFDPosition+2+i*12,soFromBeginning);
    FieldTag:=ReadIntelWord (fs);
    FieldType:=ReadIntelWord (fs);
    FieldCount:=ReadIntelCardinal (fs);
    FieldOffset:=ReadIntelCardinal (fs);
    case FieldTag of
      // Only two tags defined - as an example.
      1:if FieldType=2 then GPSLatitudeRef:=ReadString (fs,FieldCount,TIFFStart,FieldOffset);
      3:if FieldType=2 then GPSLongitudeRef:=ReadString (fs,FieldCount,TIFFStart,FieldOffset);
    end;
  end;
end;

end.