Martin Djernæs Web |
 |








|
 |
|
// ..................................................................
//
// JpegInfo
//
// Copyright © 2001-2002 by Martin Djernæs
//
// ..................................................................
// $Id: mdJpegInfo.pas,v 1.3 2002/10/25 02:26:49 martin Exp $
// ..................................................................
// Description:
// Extract information, like date/time and camera type, from a
// Jpeg picture. Not all have this, but at least some do...
// ..................................................................
// Know issues:
// I don't think that we read the copyright string correctly!
// ..................................................................
// Initial Date: November 11th, 2001
// + We can read and parse Exif files, and return the information
// as a TStrings list.
// March 13th, 2002
// % Changed some comments
// % The 16 bit magic after the Exif APP Marker is the Exif section
// length
// + Added decoding of BYTE, SLONG, RATIONAL and SRATIONAL
// + Added better validation of the Jpeg/Tiff/Exif headers.
// + Added support for walking the tags. The IFD's and the ones
// pointed to.
// October 24th, 2002
// + Added initialization to TagToStr (bug) and TypeToStr
// + Added a mdExifStream class to catch runaway parsers getting
// outside the Exif section and to store the offset
// + Added Exception handler to GetIFDData (since mdFileStream have
// got an exception and mdExifStream now also uses an exception
// we must bail out cleanly
// + If we get an undentified field type, we return FALSE. The
// previously added tags will be in the list. What happens after
// false is returned depend on the position
// + Sub IFD sections returning false will not stop the parser,
// but a message "Tag = [ ERROR ]" will be added.
// ..................................................................
unit mdJpegInfo;
interface
Uses
Windows, SysUtils, Classes,
mdFileStream;
Type
TIFD = (Primary_IFD, Exif_IFD, GPS_IFD, Interop_IFD);
//
// This is a special ExifStream wrapper to catch if/when
// a runaway parsing of the file run outside the exif
// Section.
//
TmdExifStream = class(TmdFileStream)
Private
FExifOffset : DWord;
Public
Procedure Seek(Pos : LongInt); Override;
Property ExifOffset : DWord Read FExifOffset Write FExifOffset;
end;
//
// Return the Name associated with a TAG value
//
Function TagToStr(IFD : TIFD; Tag : Word) : String;
//
// Return the Name assosiated with a Type value
//
Function TypeToStr(AType : Word) : String;
//
// Get the Exif information from the file.
// Return false if no information was found
//
Function GetJpegInfo(FileName : String; SL : TStrings) : Boolean;
//
// This is the actual Exif tag decoding function
//
Function GetIFDData(Img : TmdExifStream; Offset : DWord;
IFD : TIFD; SL : TStrings) : Boolean;
implementation
Procedure TmdExifStream.Seek(Pos : LongInt);
Begin
If (FExifOffset > 0) AND (Pos > FExifOffset+65535) Then
Raise Exception.Create('Exif section out of bounds');
Inherited Seek(Pos);
end;
Function TagToStr(IFD : TIFD; Tag : Word) : String;
Begin
Result := '';
If (IFD = Primary_IFD) OR (IFD = Exif_IFD) Then
Begin
Case Tag of
$100: Result := 'ImageWidth';
$101: Result := 'ImageLength';
$102: Result := 'BitsPerSample';
$103: Result := 'Compression';
$106: Result := 'PhotometricInterpretation';
$112: Result := 'Orientation';
$115: Result := 'SamplesPerPixel';
$11C: Result := 'PlanarConfiguration';
$212: Result := 'YCbCrSubSampling';
$213: Result := 'YCbCrPositioning';
$11A: Result := 'XResolution';
$11B: Result := 'YResolution';
$128: Result := 'ResolutionUnit';
$111: Result := 'StripOffsets';
$116: Result := 'RowsPerStrip';
$117: Result := 'StripByteCounts';
$201: Result := 'JPEGInterchangeFormat';
$202: Result := 'JPEGInterchangeFormatLength';
$12D: Result := 'TransferFunction';
$13E: Result := 'WhitePoint';
$13F: Result := 'PrimaryChromaticities';
$211: Result := 'YCbCrCoefficients';
$214: Result := 'ReferenceBlackWhite';
$132: Result := 'DateTime';
$10E: Result := 'ImageDescription';
$10F: Result := 'Make';
$110: Result := 'Model';
$131: Result := 'Software';
$13B: Result := 'Artist';
$8298: Result := 'Copyright';
$8769: Result := 'Exif IFD';
// Version
$9000: Result := 'ExifVersion';
$A000: Result := 'FlashPixVersion';
// Color
$A001: Result := 'ColorSpace';
// Image Configuration
$9101: Result := 'ComponentsConfiguration';
$9102: Result := 'CompressedBitsPerPixel';
$A002: Result := 'PixelXDimension';
$A003: Result := 'PixelYDimension';
// User Information
$927C: Result := 'MakerNote';
$9286: Result := 'UserComment';
// Date and Time
$9003: Result := 'DateTimeOriginal';
$9004: Result := 'DateTimeDigitized';
$9290: Result := 'SubSecTime';
$9291: Result := 'SubSecTimeOriginal';
$9292: Result := 'SubSecTimeDigitized';
// Picture taking condition
$829A: Result := 'ExposureTime';
$829D: Result := 'FNumber';
$8822: Result := 'ExposureProgram';
$8824: Result := 'SpectralSensitivity';
$8827: Result := 'ISOSpeedRatings';
$8828: Result := 'OECF';
$9201: Result := 'ShutterSpeedValue';
$9202: Result := 'ApertureValue';
$9203: Result := 'BrightnessValue';
$9204: Result := 'ExposureBiasValue';
$9205: Result := 'MaxApertureValue';
$9206: Result := 'SubjectDistance';
$9207: Result := 'MeteringMode';
$9208: Result := 'LightSource';
$9209: Result := 'Flash';
$920A: Result := 'FocalLength';
$A20B: Result := 'FlashEnergy';
$A20C: Result := 'SpatialFrequencyResponse';
$A20E: Result := 'FocalPlaneXResolution';
$A20F: Result := 'FocalPlaneYResolution';
$A210: Result := 'FicalPlaneResolutionUnit';
$A214: Result := 'SubjectLocation';
$A215: Result := 'ExposureIndex';
$A217: Result := 'SensingMethod';
$A300: Result := 'FileSource';
$A301: Result := 'SceneType';
$A302: Result := 'CFAPattern';
// Misc
$A005: Result := 'Interoperability IFD Pointer';
// GPS
$8825: Result := 'GPS Info Pointer';
end;
end
else If IFD = Interop_IFD Then
Begin
Case Tag of
$0001: Result := 'InteroperabilityIndex';
$0002: Result := 'InteroperabilityVersion';
$1000: Result := 'RelatedImageFileFormat';
$1001: Result := 'RelatedImageWidth';
$1002: Result := 'RelatedImageLength';
end;
end
else If IFD = GPS_IFD Then
Begin
Case Tag of
$0000: Result := 'GPSVersionID';
$0001: Result := 'GPSLatitudeRef';
$0002: Result := 'GPSLatitude';
$0003: Result := 'GPSLongitudeRef';
$0004: Result := 'GPSLongitude';
$0005: Result := 'GPSAltitudeRef';
$0006: Result := 'GPSAltitude';
$0007: Result := 'GPSTimeStamp';
$0008: Result := 'GPSSatellites';
$0009: Result := 'GPSStatus';
$000A: Result := 'GPSMeasureMode';
$000B: Result := 'GPSDOP';
$000C: Result := 'GPSSpeedRef';
$000D: Result := 'GPSSpeed';
$000E: Result := 'GPSTrackRef';
$000F: Result := 'GPSTrack';
$0010: Result := 'GPSImgDirectionRef';
$0011: Result := 'GPSImgDirection';
$0012: Result := 'GPSMapDatum';
$0013: Result := 'GPSDestLatitudeRef';
$0014: Result := 'GPSDestLatitude';
$0015: Result := 'GPSDestLongitudeRef';
$0016: Result := 'GPSDestLongitude';
$0017: Result := 'GPSDestBearingRef';
$0018: Result := 'GPSDestBearing';
$0019: Result := 'GPSDestDistanceRef';
$001A: Result := 'GPSDestDistance';
end;
end;
If Result = '' Then
Result := 'Tag '+IntToHex(Tag,4);
end;
Function TypeToStr(AType : Word) : String;
Begin
Result := '';
case AType of
1: Result := 'BYTE';
2: Result := 'ASCII';
3: Result := 'SHORT';
4: Result := 'LONG';
5: Result := 'RATIONAL';
7: Result := 'UNDEFINED';
9: Result := 'SLONG';
10: Result := 'SRATIONAL';
else
Result := 'Type '+IntToStr(AType);
end;
end;
Function CleanStr(Str : String) : String;
Var
Cnt : Integer;
Begin
Result := '';
For Cnt := 1 to Length(Str) do
If Str[Cnt] >= #$20 Then
Result := Result + Str[Cnt];
end;
Function GetJpegInfo(FileName : String; SL : TStrings) : Boolean;
Var
Img : TmdExifStream;
Str : String;
TempB : Byte;
TempW : Word;
TempI : DWord;
Begin
Result := False;
Img := TmdExifStream.Create(FileName,
fmOpenRead OR fmShareDenyWrite);
Try
If Img.EOF Then
Exit;
// Check the Jpeg format.
// Read Start Of Image (SOI) Marker
If NOT (Img.GetWord = $FFD8) Then
Exit;
// Search for the Exif section
Repeat
If Img.GetByte = $FF Then
Begin
TempB := Img.GetByte;
case TempB of
$E1 : // Exif Marker found ...
Begin
// Continue load below...
Break;
end;
$D9 : // End Of Image (EOI)
Begin
Exit;
end;
else
Begin
// Unknown section...
// The two bytes following the application marker is
// the length of the section (including the two length bytes).
// We need to skip the section
TempW := Img.GetWord - 2;
Img.Seek(Img.Position+TempW);
end;
end;
end
else
Begin
// Something is very wrong...
Exit;
end;
Until Img.EOF;
// Reading the Exif Section length
Img.GetWord;
// Here we find the Exif "magic" prefix inside the
// the Jpeg Application Section.
// The Exif section start with the four letters "Exif" followed
// by two null bytes.
SetLength(Str,4);
Img.Read(Str, 4);
If Str <> 'Exif' Then
Exit;
If NOT (Img.GetWord = $0000) Then
Exit;
// This is our reference marker!
Img.ExifOffset := Img.Position;
// From here we are talking TIFF format....
// Get char format
TempW := Img.GetWord;
Case TempW of
$4949 :
Begin
Img.Endian := Little;
end;
$4D4D :
Begin
Img.Endian := Big;
end;
else
Begin
// Illigal header value
Exit;
end;
end;
// Get "fixed value"
// (or as the TIFF standard says "An arbitrary but
// carefully chosen number")
TempW := Img.GetWord;
If TempW <> $002A Then
Exit;
// Read the offset value, and find the "start
// position"
TempI := Img.GetInt;
If NOT GetIFDData(Img, TempI, Primary_IFD, SL) Then
Exit;
Finally
Img.Free;
end;
Result := True;
end;
//
// Decode the IFD Data (or tags)
//
Function GetIFDData(Img : TmdExifStream; Offset : DWord;
IFD : TIFD; SL : TStrings) : Boolean;
Var
Cnt : Integer;
Cnt2 : Integer;
Str : String;
IFDRecords : Word;
MyPos : DWord;
MyTag, MyType : Word;
MyCount, MyValue : DWord;
TmpW : Word;
NextIFD : DWord;
Begin
// Try to catch exceptions. The file will return an exception if
// we access outside the file (runaway tags)
Try
Result := True;
Img.Seek(Img.ExifOffset+Offset);
If Img.EOF Then // Sanity check
Exit;
// Get the information count
IFDRecords := Img.GetWord;
For Cnt := 1 to IFDRecords do
Begin
MyPos := Img.Position;
MyTag := Img.GetWord;
MyType := Img.GetWord;
MyCount := Img.GetInt;
MyValue := Img.GetInt;
Str := '';
case MyType of
1: // BYTE
Begin
If MyCount <= 4 Then
Img.Seek(MyPos+8)
else
Img.Seek(MyValue+Img.ExifOffset);
For Cnt2 := 1 To MyCount do
Begin
If Str <> '' Then
Str := Str + ',';
TmpW := Img.GetByte;
Str := Str + IntToStr(TmpW);
end;
end;
2: // ASCII
Begin
If MyCount <= 4 Then
Img.Seek(MyPos+8)
else
Img.Seek(MyValue+Img.ExifOffset);
SetLength(Str, MyCount);
Img.Read(Str, MyCount);
Str := CleanStr(Str);
end;
3: // Short
begin
// We can store two words in a 4 byte area.
// So if there is less (or equal) than two items
// in this section they are stored in the
// Value/Offset area
If MyCount <= 2 Then
Img.Seek(MyPos+8)
else
Img.Seek(MyValue+Img.ExifOffset);
For Cnt2 := 1 To MyCount do
Begin
If Str <> '' Then
Str := Str + ',';
Str := Str + IntToStr(Img.GetWord);
end;
end;
4: // Long
Begin
// We can store one long in a 4 byte area.
// So if there is less (or equal) than one item
// in this section they are stored in the
// Value/Offset area
If MyCount <= 1 Then
Str := IntToStr(MyValue)
else
Begin
Img.Seek(MyValue+Img.ExifOffset);
For Cnt2 := 1 To MyCount do
Begin
If Str <> '' Then
Str := Str + ',';
Str := Str + IntToStr(Img.GetInt);
end;
end;
end;
5: // Rational (LONG / LONG)
Begin
Img.Seek(MyValue+Img.ExifOffset);
For Cnt2 := 1 To MyCount do
Begin
If Str <> '' Then
Str := Str + ',';
Str := Str + IntToStr(Img.GetInt) + '/'+
IntToStr(Img.GetInt);
end;
end;
7: // Undefined
Begin
If MyCount <= 4 Then
Img.Seek(MyPos+8) // The 8 is the "tag record size"
// Minus the value
else
Img.Seek(MyValue+Img.ExifOffset);
Str := '';
For Cnt2 := 1 To MyCount do
Begin
If Str <> '' Then
Str := Str + ' ';
Str := Str + IntToHex(Img.GetByte,2);
end;
end;
9: // Signed Long
Begin
// We can store one long in a 4 byte area.
// So if there is less (or equal) than one item
// in this section they are stored in the
// Value/Offset area
If MyCount <= 1 Then
Begin
Str := IntToStr(Integer(MyValue));
end
else
Begin
Img.Seek(MyValue+Img.ExifOffset);
For Cnt2 := 1 To MyCount do
Begin
If Str <> '' Then
Str := Str + ',';
Str := Str + IntToStr(Integer(Img.GetInt));
end;
end;
end;
10: // Signed Rational (SLONG / SLONG)
Begin
Img.Seek(MyValue+Img.ExifOffset);
For Cnt2 := 1 To MyCount do
Begin
If Str <> '' Then
Str := Str + ',';
Str := Str + IntToStr(Integer(Img.GetInt)) + '/'+
IntToStr(Integer(Img.GetInt));
end;
end;
else
// An undentified code is returned. We bail out of this
// section with an error. Result will depend on location
Result := False;
Exit;
end;
Case MyTag of
$8769:
If NOT GetIFDData(Img, MyValue, Exif_IFD, SL) Then
SL.Add(TagToStr(IFD, MyTag)+'=[ ERROR ]');
$A005:
If NOT GetIFDData(Img, MyValue, Interop_IFD, SL) Then
SL.Add(TagToStr(IFD, MyTag)+'=[ ERROR ]');
$8825:
If NOT GetIFDData(Img, MyValue, GPS_IFD, SL) Then
SL.Add(TagToStr(IFD, MyTag)+'=[ ERROR ]');
else
SL.Add(TagToStr(IFD, MyTag)+'='+Str);
end;
If NOT Result Then
Exit; // We had an error
Img.Seek(MyPos+12); // The 12 is the "tag record size"
end;
NextIFD := Img.GetInt;
If NextIFD > 65535 Then
Begin
Result := False;
Exit; // Error!!
end;
If NextIFD <> 0 Then
Result := GetIFDData(Img, NextIFD, IFD, SL)
else
Result := True;
// If we catch an exception, we'll just return "error"
Except
On Exception do
Result := False;
end;
end;
end.
|
 |
Copyright © 1998-2003 by
Martin Djernæs,
all rights reserved.
|
|