Identify image Types

[DreamVB]

Hi,

this is a little console app with a function that can be used to check the first few bytes of a file to test if it is an image type, When I was doing work experience in a school I remember the IT person what have to check the students folders for images and delete them, something like this might of been handy as some students like to try and make it harder to find the and rename them as MP3 or DOC files or other file types anyway hope you find the code useful if you can think of other formats you can easy add them.

Code: Pascal  [Select][+][-]

1. //Little function that can be used to check the type of image.
2.  
3. program identimage;
4.  
5. {$mode objfpc}{$H+}
6.  
7. uses
8.   Classes,
9.   StrUtils,
10.   SysUtils;
11.  
12. type
13.   TImageType = (IUnknown, iPNG, iBMP, iJPEG, iGIF, iTIFF, iPSD, iPCX);
14.  
15.   function GetImageType(Filename: string): TImageType;
16.   var
17.     f: file of byte;
18.     header: array[0..6] of byte;
19.     iType: TImageType;
20.     X : Integer;
21.   begin
22.  
23.     //File to read
24.     AssignFile(f, Filename);
25.     Reset(f);
26.  
27.     //Read in the first 5 bytes of the file into header array
28.     for X := 0 to 5 do
29.     begin
30.       Read(f, header[X]);
31.     end;
32.  
33.     //Close file
34.     CloseFile(f);
35.  
36.     //Check for PNG
37.     if (header[0] = $89) and (header[1] = $50) and (header[2] = $4E) and
38.       (header[3] = $47) then
39.     begin
40.       iType := TImageType.iPNG;
41.     end
42.     //Check for JPEG
43.     else if (header[0] = $FF) and (header[1] = $D8) and (header[2] = $FF) and
44.       (header[3] = $E0) then
45.     begin
46.       iType := TImageType.iJPEG;
47.     end
48.     //Check for Bitmap
49.     else if (header[0] = $42) and (header[1] = $4D) and (header[2] = $5E) and
50.       (header[3] = $23) then
51.     begin
52.       iType := TImageType.iBMP;
53.     end
54.     //Check for Bitmap
55.     else if (header[0] = $42) and (header[1] = $4D) and (header[2] = $52) then
56.     begin
57.       iType := TImageType.iBMP;
58.     end
59.     //Check for Bitmap
60.     else if (header[0] = $42) and (header[1] = $4D) and (header[2] = $EE) and
61.       (header[3] = $0F) then
62.     begin
63.       iType := TImageType.iBMP;
64.     end
65.     //Check for GIF
66.     else if (header[0] = $47) and (header[1] = $49) and (header[2] = $46) and
67.       (header[3] = $38) and (header[4] = $39) then
68.     begin
69.       iType := TImageType.iGIF;
70.     end
71.     //Check for TIFF
72.     else if (header[0] = $49) and (header[1] = $49) and (header[2] = $2A) and
73.       (header[3] = $00) then
74.     begin
75.       iType := TImageType.iTIFF;
76.     end
77.     //Check for Adobe PSD
78.     else if (header[0] = $38) and (header[1] = $42) and (header[2] = $50) and
79.       (header[3] = $53) and (header[4] = $00) and (header[5] = $01) then
80.     begin
81.       iType := TImageType.iPSD;
82.     end
83.     //Check for PCX
84.     else if (header[0] = $0A) and (header[1] = $05) and (header[2] = $01) and
85.       (header[3] = $08) and (header[4] = $00) then
86.     begin
87.       iType := TImageType.iPCX;
88.     end
89.     else
90.     begin
91.       //Unknown Image type
92.       iType := TImageType.IUnknown;
93.     end;
94.  
95.     Result := iType;
96.     //Check header to find out what image type we have.
97.   end;
98.  
99. begin
100.   if ParamCount = 1 then
101.   begin
102.     if not FileExists(ParamStr(1)) then
103.     begin
104.       WriteLn('File Not Found: ' + sLineBreak + ParamStr(1));
105.     end
106.     else
107.     begin
108.       Writeln(GetImageType(ParamStr(1)));
109.     end;
110.   end;
111. end.
112.  

[Bart]

I have a similar unit, that does some more extensive checking (and also returns width and height) of the image. 
It supports less formats though.

Feel free to use (parts of) this code.

Bart

[DreamVB]

Thanks Bart I look at your code latter.

[wp]

Seems to be a popular topic because I have a similar unit for fpspreadsheet (https://sourceforge.net/p/lazarus-ccr/svn/HEAD/tree/components/fpspreadsheet/source/common/fpsimages.pas). Only later I noticed that the format checks are already available in each fpc installation: The folder packages/fcl-image/src contains the units needed by the fcl graphics routines, including the reader and writer units for all graphics format. Each file format has dedicated reader and writer units with corresponding classes. It is an elemental requirement for each reader that it must be able to detect the graphics format from the file (or stream) header, without relying on a file extension. The reader method for this purpose is called "CheckContents", works on the image stream and returns true if the typical signature of the file format is found. When the reader unit of a file format is added to the uses clause of your application the unit is registered in an internal image handler list along with related data, among them the name of the graphic format. TFPCustomImage, the elemental image class of fcl-image, has a method FindHandlerFromStream which scans over all registered image handlers and calls the CheckContents method of each reader class. This way TFPCustomImage can determine the graphics format from the stream header.

Luckily all this is accessible to us, and knowing this (after some study in the fcl-image source) your program shrinks to a few lines. All you have to do is to add the reader units of all formats that you want to check to the uses clause:

Code: Pascal  [Select][+][-]

1. uses
2.   ...
3.   fpImage,
4.   // what follows are the reader units available in fcl-image
5.   fpReadBMP, fpReadGIF, fpReadPNG, fpReadPSD, fpReadJPEG, fpReadTIFF, fpReadPCX,
6.   fpReadPNM, fpReadTGA, fpReadXPM, fpReadXWD;    
7.  
8. function GetImageType(AStream: TStream): String;
9. var
10.   handlerData: TIHData;
11. begin
12.   handlerData := TFPCustomImage.FindHandlerFromStream(AStream);
13.   if handlerData = nil then
14.     Result := 'Format not detected'
15.   else
16.     Result := handlerData.TypeName;
17. end;
18.  
19. procedure TForm1.Button1Click(Sender: TObject);
20. var
21.   stream: TFileStream;
22. begin
23.   stream := TFileStream.Create(FILE_NAME, fmOpenRead);
24.   try
25.     ShowMessage(GetImageType(stream));
26.   finally
27.     stream.Free;
28.   end;
29. end;

Of course, this cannot replace the detection of audo or video files - for these, your code is still required.