Identify image Types

Forum > Other

(1/1)

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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---//Little function that can be used to check the type of image. program identimage; {$mode objfpc}{$H+} uses Classes, StrUtils, SysUtils; type TImageType = (IUnknown, iPNG, iBMP, iJPEG, iGIF, iTIFF, iPSD, iPCX); function GetImageType(Filename: string): TImageType; var f: file of byte; header: array[0..6] of byte; iType: TImageType; X : Integer; begin //File to read AssignFile(f, Filename); Reset(f); //Read in the first 5 bytes of the file into header array for X := 0 to 5 do begin Read(f, header[X]); end; //Close file CloseFile(f); //Check for PNG if (header[0] = $89) and (header[1] = $50) and (header[2] = $4E) and (header[3] = $47) then begin iType := TImageType.iPNG; end //Check for JPEG else if (header[0] = $FF) and (header[1] = $D8) and (header[2] = $FF) and (header[3] = $E0) then begin iType := TImageType.iJPEG; end //Check for Bitmap else if (header[0] = $42) and (header[1] = $4D) and (header[2] = $5E) and (header[3] = $23) then begin iType := TImageType.iBMP; end //Check for Bitmap else if (header[0] = $42) and (header[1] = $4D) and (header[2] = $52) then begin iType := TImageType.iBMP; end //Check for Bitmap else if (header[0] = $42) and (header[1] = $4D) and (header[2] = $EE) and (header[3] = $0F) then begin iType := TImageType.iBMP; end //Check for GIF else if (header[0] = $47) and (header[1] = $49) and (header[2] = $46) and (header[3] = $38) and (header[4] = $39) then begin iType := TImageType.iGIF; end //Check for TIFF else if (header[0] = $49) and (header[1] = $49) and (header[2] = $2A) and (header[3] = $00) then begin iType := TImageType.iTIFF; end //Check for Adobe PSD else if (header[0] = $38) and (header[1] = $42) and (header[2] = $50) and (header[3] = $53) and (header[4] = $00) and (header[5] = $01) then begin iType := TImageType.iPSD; end //Check for PCX else if (header[0] = $0A) and (header[1] = $05) and (header[2] = $01) and (header[3] = $08) and (header[4] = $00) then begin iType := TImageType.iPCX; end else begin //Unknown Image type iType := TImageType.IUnknown; end; Result := iType; //Check header to find out what image type we have. end; begin if ParamCount = 1 then begin if not FileExists(ParamStr(1)) then begin WriteLn('File Not Found: ' + sLineBreak + ParamStr(1)); end else begin Writeln(GetImageType(ParamStr(1))); end; end;end.

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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---uses ... fpImage, // what follows are the reader units available in fcl-image fpReadBMP, fpReadGIF, fpReadPNG, fpReadPSD, fpReadJPEG, fpReadTIFF, fpReadPCX, fpReadPNM, fpReadTGA, fpReadXPM, fpReadXWD; function GetImageType(AStream: TStream): String;var handlerData: TIHData;begin handlerData := TFPCustomImage.FindHandlerFromStream(AStream); if handlerData = nil then Result := 'Format not detected' else Result := handlerData.TypeName;end; procedure TForm1.Button1Click(Sender: TObject);var stream: TFileStream;begin stream := TFileStream.Create(FILE_NAME, fmOpenRead); try ShowMessage(GetImageType(stream)); finally stream.Free; end;end;
Of course, this cannot replace the detection of audo or video files - for these, your code is still required.

Navigation

[0] Message Index