Jpegピクチャ属性読み出しEXIF

unit utJpegInfo;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TfrmJpegInfo = class(TForm)
    btnOpenJpeg: TButton;
    mmoJpegInfo: TMemo;
    procedure btnOpenJpegClick(Sender: TObject);
  private
    { Private declarations }

    fsImage : TFileStream;
    i64RefPos : int64;
    // Jpeg 
    procedure ReadJpegInfo(const JpegFileName : string);
    // byte 
    function GetByte: byte;
    // Word 
    function GetWord: word;
    // DWord 
    function GetDWord: DWord;
    // 
    function GetString(intBufferSize: integer): string;
    // 
    function GetTagName(wrdTag: Word): string;
    // Jpeg 
    procedure pReadIFD;

  public
    { Public declarations }
  end;

var
  frmJpegInfo: TfrmJpegInfo;

implementation

{$R *.dfm}

function TfrmJpegInfo.GetByte : byte;
begin
  fsImage.Read(result, 1);
end;

function TfrmJpegInfo.GetWord : word;
begin
  result := GetByte OR (GetByte SHL 8);
end;

function TfrmJpegInfo.GetDWord : DWord;
begin
  result := GetWord OR (GetWord SHL 16);
end;

function TfrmJpegInfo.GetString(intBufferSize : integer) : string;
var
  strResult : string;
  i : integer;
begin
  result := '';
  for i := 1 to intBufferSize do
    result := result + chr(GetByte);
end;

function TfrmJpegInfo.GetTagName(wrdTag : Word) : string;
begin
  Case wrdTag of
   $001: result :='InteroperabilityIndex';
   $002: result :='InteroperabilityVersion';
   $0FE: result :='NewSubfileType';
   $0FF: result :='SubfileType';
   $100: result :='ImageWidth';
   $101: result :='ImageLength';
   $102: result :='BitsPerSample';
   $103: result :='Compression';
   $106: result :='PhotometricInterpretation';
   $10A: result :='FillOrder';
   $10D: result :='DocumentName';
   $10E: result :='ImageDescription';
   $10F: result :='Make';
   $110: result :='Model';
   $111: result :='StripOffsets';
   $112: result :='Orientation';
   $115: result :='SamplesPerPixel';
   $116: result :='RowsPerStrip';
   $117: result :='StripByteCounts';
   $11A: result :='XResolution';
   $11B: result :='YResolution';
   $11C: result :='PlanarConfiguration';
   $128: result :='ResolutionUnit';
   $12D: result :='TransferFunction';
   $131: result :='Software';
   $132: result :='DateTime';
   $13B: result :='Artist';
   $13D: result :='Predictor';
   $13E: result :='WhitePoint';
   $13F: result :='PrimaryChromaticities';
   $142: result :='TileWidth';
   $143: result :='TileLength';
   $144: result :='TileOffsets';
   $145: result :='TileByteCounts';
   $14A: result :='SubIFDs';
   $15B: result :='JPEGTables';
   $156: result :='TransferRange';
   $200: result :='JPEGProc';
   $201: result :='JPEGInterchangeFormat';
   $202: result :='JPEGInterchangeFormatLength';
   $211: result :='YCbCrCoefficients';
   $212: result :='YCbCrSubSampling';
   $213: result :='YCbCrPositioning';
   $214: result :='ReferenceBlackWhite';
   $1001: result :='Related Image Width';
   $1002: result :='Related Image Height';
   $828D: result :='CFARepeatPatternDim';
   $828E: result :='CFAPattern';
   $828F: result :='BatteryLevel';
   $8298: result :='Copyright';
   $829A: result :='ExposureTime';
   $829D: result :='FNumber';
   $83BB: result :='IPTC/NAA';
   $8769: result :='ExifOffset';
   $8773: result :='InterColorProfile';
   $8822: result :='ExposureProgram';
   $8824: result :='SpectralSensitivity';
   $8825: result :='GPSInfo';
   $8827: result :='ISOSpeedRatings';
   $8828: result :='OECF';
   $8829: result :='Interlace';
   $882A: result :='TimeZoneOffset';
   $882B: result :='SelfTimerMode';
   $9000: result :='ExifVersion';
   $9003: result :='DateTimeOriginal';
   $9004: result :='DateTimeDigitized';
   $9101: result :='ComponentsConfiguration';
   $9102: result :='CompressedBitsPerPixel';
   $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';
   $920B: result :='FlashEnergy';
   $920C: result :='SpatialFrequencyResponse';
   $920D: result :='Noise';
   $9211: result :='ImageNumber';
   $9212: result :='SecurityClassification';
   $9213: result :='ImageHistory';
   $9214: result :='SubjectLocation';
   $9215: result :='ExposureIndex';
   $9216: result :='TIFF/EPStandardID';
   $927C: result :='MakerNote';
   $9286: result :='UserComment';
   $9290: result :='SubSecTime';
   $9291: result :='SubSecTimeOriginal';
   $9292: result :='SubSecTimeDigitized';
   $A000: result :='FlashPixVersion';
   $A001: result :='ColorSpace';
   $A002: result :='ExifImageWidth';
   $A003: result :='ExifImageLength';
   $A005: result :='InteroperabilityOffset';
   $A20B: result :='FlashEnergy';
   $A20C: result :='SpatialFrequencyResponse';
   $A20E: result :='FocalPlaneXResolution';
   $A20F: result :='FocalPlaneYResolution';
   $A210: result :='FocalPlaneResolutionUnit';
   $A214: result :='SubjectLocation';
   $A215: result :='ExposureIndex';
   $A217: result :='SensingMethod';
   $A300: result :='FileSource';
   $A301: result :='SceneType';
  else
    Result := 'Unknown Tag Type';
  end;

end;

procedure TfrmJpegInfo.pReadIFD;
var
  wrdNumberOfEntries : Word; //number of directory entries
  wrdTag             : Word; //tag number
  wrdDataType        : Word; //type or kind of data in entry
  dwdComponents      : DWord; //number of components in entry
  dwdData            : DWord; //data or offset to data
  wrdNextIFD         : Word; //offset to next IFD
  intLoop            : integer; //loop control
  intDataLoop        : integer; //loop control
  intTotalDataLength : integer; //total length of directory entry value
  strData            : string; //string directory entry
  bytData            : byte; //byte directory entry
  lngData            : longint; //long directory entry
  i64HoldPos         : int64; //hold position within file

begin

  //read number of entries
  wrdNumberOfEntries := GetWord;
  mmoJpegInfo.lines.Add('Number of Entries:' + IntToStr(wrdNumberOfEntries));

  //read individual entries
  for intLoop := 1 to wrdNumberOfEntries do
  begin

    //read tag number and interpret
    wrdTag := GetWord;
    strData := 'Tag: ' + GetTagName(wrdTag);

    //read tag type (kind of data) and interpret
    wrdDataType := GetWord;
    case wrdDataType of
      1 : strData := strData + ':(unsigned byte)'; //1 byte
      2 : strData := strData + ':(ascii strings)'; //1 byte
      3 : strData := strData + ':(unsigned short)'; //2 bytes
      4 : strData := strData + ':(unsigned long)'; //4 bytes
      5 : strData := strData + ':(unsigned rational)'; //8 bytes
      6 : strData := strData + ':(signed byte)'; //1 byte
      7 : strData := strData + ':(undefined)'; //1 byte
      8 : strData := strData + ':(signed short)'; //2 bytes
      9 : strData := strData + ':(signed long)'; //4 bytes
      10 : strData := strData + ':(signed rational)'; //8 bytes
      11 : strData := strData + ':(single float)'; //4 bytes
      12 : strData := strData + ':(double float)'; //8 bytes
    else
      mmoJpegInfo.lines.Add('Unknown Data Type');
    end; {case wrdDataType of}

    mmoJpegInfo.lines.Add(strData);

    //read number of components
    dwdComponents := GetDWord;
    //lstINFO.Items.Add('Number of Components:' + IntToStr(dwdComponents));

    //read data value or offset to data value
    {first check the total data length (bytes/component * # of components
     gives the total data length - if > 4 bytes then dwdData is the offset
     to the data, if < 4 bytes then dwdData is the value itself}
    Case wrdDataType of
      1 : intTotalDataLength := dwdComponents; //1 byte
      2 : intTotalDataLength := dwdComponents; //1 byte
      3 : intTotalDataLength := dwdComponents * 2; //2 bytes
      4 : intTotalDataLength := dwdComponents * 4; //4 bytes
      5 : intTotalDataLength := dwdComponents * 8; //8 bytes
      6 : intTotalDataLength := dwdComponents; //1 byte
      7 : intTotalDataLength := dwdComponents; //1 byte
      8 : intTotalDataLength := dwdComponents * 2; //2 bytes
      9 : intTotalDataLength := dwdComponents * 4; //4 bytes
      10 : intTotalDataLength := dwdComponents * 8; //8 bytes
      11 : intTotalDataLength := dwdComponents * 4; //4 bytes
      12 : intTotalDataLength := dwdComponents * 8; //8 bytes
    else
      IntTotalDataLength := 0;
    end;

    //read the data value
    dwdData := GetDWord;

    //set the hold position
    i64HoldPos := fsImage.Position;

    //now set data or read offset
    if intTotalDataLength > 4 then
      begin //read offset value
        //seek to offset value
        fsImage.Seek(dwdData+i64RefPos,soFromBeginning);

        //read specific data type (unsigned byte)
        if wrdDataType = 1 then //unsigned byte
          begin
            bytData := GetByte;
            mmoJpegInfo.lines.Add('Value=' + IntToStr(bytData));
          end; {wrdDataType=1}

        //read specific data type (string)
        if wrdDataType = 2 then //ascii string
          begin
            strData := '';
            for intDataLoop := 1 to dwdComponents do
              strData := strData + chr(GetByte);
            mmoJpegInfo.lines.Add('Value=' + strData);
          end; {wrdDataType=2}

        //read specific data type (unsigned short)
        if wrdDataType = 3 then
          begin
            for intDataLoop := 1 to dwdComponents do
              strData := strData + chr(GetByte);
            mmoJpegInfo.lines.Add('Value=' + strData);
          end; {wrdDataType=3}

        //read specific data type (unsigned long)
        if wrdDataType = 4 then
          begin
            lngData := GetDWord;
            mmoJpegInfo.lines.Add('Value:=' + IntToStr(lngData));
          end; {wrdDataType=4}

        //read specific data type (unsigned rational)
        if wrdDataType = 5 then
          begin
            strData := IntToStr(GetDWord) + '/' + IntToStr(GetDWord);
            mmoJpegInfo.lines.Add('Value:=' + strData);
          end; {wrdDataType=5}

      end {intTotalDataLength > 4}
    else
      begin //read value intTotalDataLength < 4
        mmoJpegInfo.lines.Add('Value=' + IntToStr(dwdData));
      end; //read value intTotalDataLength < 4

    //return to former data position
    fsImage.Seek(i64HoldPos,soFromBeginning);

  end; {for intLoop}

  //finally, read the offset to the next IFD
  wrdNextIFD := GetWord;

end;


procedure TfrmJpegInfo.ReadJpegInfo(const JpegFileName : string);
var
  wrdImage  : word; //word read from image file
  dwdImage  : dword; //double word read from image file
  bytImage  : byte; //byte read from image file
  strImage  : string; //string read from image file
begin

  {open the file}
  fsImage := TFileStream.Create(JpegFileName,fmOpenRead);
  {show file path on caption}
  Caption := JpegFileName;

  {look for start-of-image marker FF D8 as first two bytes}
  if GetByte = $FF then
  begin
    if GetByte = $D8 then
      mmoJpegInfo.lines.Add('Start-Of-Image Marker Found: Valid Image')
    else
    begin //exit if invalid image
      mmoJpegInfo.lines.Add('Start-Of-Image Marker NOT Found: Invalid Image');
      exit;
    end; //check for soi marker
  end;

  {look for exif marker}
  while bytImage <> $D9 do  //$D9=eof byte
  begin
    fsImage.Read(bytImage,1);  //read one byte

    //if exif marker found (starts by $FFE1}
    if bytImage = $FF then
      if GetByte = $E1 then
      begin
        mmoJpegInfo.lines.Add('EXIF Marker Found');

        //now read image information

        {read exif data size}
        wrdImage := GetWord;
        mmoJpegInfo.lines.Add('Exif Data Size=' + Inttostr(wrdImage));

        {read actual exif header}
        strImage := GetString(4);
        if strImage <> 'Exif' then
          exit
        else
          mmoJpegInfo.lines.Add('Header: ' + strImage);

        //read two null bytes after exif header
        GetWord;

        //set reference position for future offsets
        i64RefPos := fsImage.Position;

        //the next 8 bytes are the TIFF header
        //2 bytes to determine byte order
        //2 bytes (002A or 2A00)
        //4 bytes offset to first image file directory

        {now read byte order, II is intel (little endian),
         MM is motorola (big endian)}
        wrdImage := GetWord;
        Case wrdImage of
          $4949 : mmoJpegInfo.lines.Add('Encoding: Little Endian');
          $4D4D : mmoJpegInfo.lines.Add('Encoding: Big Endian');
        else
          mmoJpegInfo.lines.Add('Unknown Encoding');
        end;

        {read the next two bytes - always $02AA or $2A00}
        wrdImage := GetWord;

        {read the end of the tiff header - 4 bytes
         contain offset to first IFD}
        dwdImage := GetDWord;
        mmoJpegInfo.lines.Add('Offset to 1st IFD:' + IntToStr(dwdImage));

        {seek to first IFD, subtract 8 bytes for
         TIFF header}
        fsImage.Seek(dwdImage-8,soFromCurrent);

        {read the first image file directory}
        pReadIFD;

      end; //if exif marker found

  end; {look for exif marker - while bytSOI <> $D9 do}

  {close the file}
  fsImage.Free;

end; {read information from the jpeg file}

procedure TfrmJpegInfo.btnOpenJpegClick(Sender: TObject);
begin
  mmoJpegInfo.Clear;
  with TOpenDialog.Create(self) do
  begin
    Options := [ofHideReadOnly, ofFileMustExist];
    Filter := '*.jpeg|*.jpg';

    if Execute then
    begin
      ReadJpegInfo(FileName);
    end;
    free;
  end;
end;

end.

object frmJpegInfo: TfrmJpegInfo
  Left = 0
  Top = 0
  Caption = 'frmJpegInfo'
  ClientHeight = 564
  ClientWidth = 366
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -12
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 106
  TextHeight = 14
  object btnOpenJpeg: TButton
    Left = 16
    Top = 16
    Width = 75
    Height = 25
    Caption = #25171#24320'Jpeg'
    TabOrder = 0
    OnClick = btnOpenJpegClick
  end
  object mmoJpegInfo: TMemo
    Left = 0
    Top = 47
    Width = 366
    Height = 517
    Align = alBottom
    ScrollBars = ssVertical
    TabOrder = 1
  end
end