JPEG Picture Properties Read Exif_delphi

Source: Internet
Author: User

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


Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.