JPEG Picture Properties Read Exif_delphi

JPEG Picture Properties Read

Test environment Delphi XE

Main function code obtained from other authors

Unit file

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;
    Read JPEG information procedure readjpeginfo (const jpegfilename:string);
    Reads the byte value function getbyte:byte;
    Read Word value function Getword:word;
    Read DWord value function Getdword:dword;
    Gets the string function GetString (Intbuffersize:integer) of the specified length: string;
    Label name function Gettagname (wrdtag:word): string;

  Read the JPEG label information 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 does: = 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 ';
   $A 000:result: = ' flashpixversion ';
   $A 001:result: = ' colorspace ';
   $A 002:result: = ' exifimagewidth ';
   $A 003:result: = ' exifimagelength ';
   $A 005:result: = ' interoperabilityoffset ';
   $A 20b:result: = ' flashenergy ';
   $A 20c:result: = ' spatialfrequencyresponse '; $A 20e:result: = ' FocalplanexrEsolution ';
   $A 20f:result: = ' focalplaneyresolution ';
   $A 210:result: = ' focalplaneresolutionunit ';
   $A 214:result: = ' subjectlocation ';
   $A 215:result: = ' exposureindex ';
   $A 217:result: = ' Sensingmethod ';
   $A 300:result: = ' filesource ';
  $A 301: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 WRD
    Tag: = 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 {I check the total data length (bytes/component * # of Components G Ives the total data length-if > 4 bytes Then dwddata are the offset to the data, if < 4 bytes then dwddata are 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 offs

        ET 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 two bytes} if GetByte = $FF THEN BEGIN if GetByte = $D 8 Then MmoJpegInfo.lines.Add (' start-of-image Marker found:valid image ') ELSE begin//exit If invalid image mmojpeg
      Info.lines.Add (' Start-of-image Marker not found:invalid Image ');
    Exit End

  Check for Soi marker end;  {Look for EXIF marker} while bytimage <> $D 9 do//$D 9=eof byte begin Fsimage.read (bytimage,1);
      Read one byte//if exif marker found (starts by $FFE 1} if Bytimage = $FF Then If getbyte = $E 1 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-i-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 ' the TIFF header-4 bytes contain offset to ' the ' the ' of ' the '. Dwdimage: = Getdword; MMOJPEGINFO.LINES.ADD (' Offset to 1st IFD: ' + inttostr (dwdimage));

        {Seek to-subtract 8 bytes for TIFF header} fsimage.seek (dwdimage-8,sofromcurrent);

      {Read the ' the ' the ' preadifd; End If EXIF marker found end;

  {Look for EXIF marker-while Bytsoi <> $D 9 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.

Form file

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 = Btnopenjpeg:tbutton left = + Top
    =
    Width =
    Height =
    Capt Ion = #25171 #24320 ' Jpeg '
    taborder = 0
    OnClick = Btnopenjpegclick
  End
  Object Mmojpeginfo:tmemo Left
    = 0
    top =
    Width = 366
    Height = 517
    Align = albottom
    ScrollBars = ssvertical TabOrder
    = 1
  end< C32/>end