How to get all of the supported file formats from Graphics unit?

Question

When any TGraphic descendant registering its own graphic file format with a class procedure TPicture.RegisterFileFormat(), they\'re all stored in Graphics.FileFormats global

Answer 1

Here's an alternative hack that might be safer then the GLScene solution. It's still a hack, because the desired structure is global but in the implementation section of the Graphics.pas unit, but my method uses a lot less "maigc constants" (hard-coded offsets into the code) and uses two distinct methods to detect the GetFileFormats function in Graphics.pas.

My code exploits the fact that both TPicture.RegisterFileFormat and TPicture.RegisterFileFormatRes need to call the Graphics.GetFileFormats function immediately. The code detects the relative-offset CALL opcode and registers the destination address for both. Only moves forward if both results are the same, and this adds a safety-factor. The other safety-factor is the detection method itself: even if the prologue generated by the compiler would change, as long as the first function called is GetFileFormats, this code finds it.

I'm not going to put the "Warning: This will crash when Graphics.pas is compiled with the 'Use Debug DCUs' option." at the top of the unit (as found in the GLScene code), because I've tested with both debug dcu's and no debug dcu's and it worked. Also tested with packages and it still worked.

This code only works for 32bit targets, hence the extensive use of Integer for pointer operations. I will attempt making this work for 64bit targets as soon as I'll get my Delphi XE2 compiler installed.

Update: A version supporting 64 bit can be found here: https://stackoverflow.com/a/35817804/505088

unit FindReigsteredPictureFileFormats;

interface

uses Classes, Contnrs;

// Extracts the file extension + the description; Returns True if the hack was successful,
// False if unsuccesful.
function GetListOfRegisteredPictureFileFormats(const List: TStrings): Boolean;

// This returns the list of TGraphicClass registered; True for successful hack, false
// for unsuccesful hach
function GetListOfRegisteredPictureTypes(const List:TClassList): Boolean;

implementation

uses Graphics;

type
  TRelativeCallOpcode = packed record
    OpCode: Byte;
    Offset: Integer;
  end;
  PRelativeCallOpcode = ^TRelativeCallOpcode;

  TLongAbsoluteJumpOpcode = packed record
    OpCode: array[0..1] of Byte;
    Destination: PInteger;
  end;
  PLongAbsoluteJumpOpcode = ^TLongAbsoluteJumpOpcode;

  TMaxByteArray = array[0..System.MaxInt-1] of Byte;
  PMaxByteArray = ^TMaxByteArray;

  TReturnTList = function: TList;

  // Structure copied from Graphics unit.
  PFileFormat = ^TFileFormat;
  TFileFormat = record
    GraphicClass: TGraphicClass;
    Extension: string;
    Description: string;
    DescResID: Integer;
  end;

function FindFirstRelativeCallOpcode(const StartOffset:Integer): Integer;
var Ram: PMaxByteArray;
    i: Integer;
    PLongJump: PLongAbsoluteJumpOpcode;
begin
  Ram := nil;

  PLongJump := PLongAbsoluteJumpOpcode(@Ram[StartOffset]);
  if (PLongJump^.OpCode[0] = $FF) and (PLongJump^.OpCode[1] = $25) then
    Result := FindFirstRelativeCallOpcode(PLongJump^.Destination^)
  else
    begin
      for i:=0 to 64 do
        if PRelativeCallOpcode(@Ram[StartOffset+i])^.OpCode = $E8 then
          Exit(StartOffset + i + PRelativeCallOpcode(@Ram[StartOffset+i])^.Offset + 5);
      Result := 0;
    end;
end;

procedure FindGetFileFormatsFunc(out ProcAddr: TReturnTList);
var Offset_from_RegisterFileFormat: Integer;
    Offset_from_RegisterFileFormatRes: Integer;
begin
  Offset_from_RegisterFileFormat := FindFirstRelativeCallOpcode(Integer(@TPicture.RegisterFileFormat));
  Offset_from_RegisterFileFormatRes := FindFirstRelativeCallOpcode(Integer(@TPicture.RegisterFileFormatRes));

  if (Offset_from_RegisterFileFormat = Offset_from_RegisterFileFormatRes) then
    ProcAddr := TReturnTList(Pointer(Offset_from_RegisterFileFormat))
  else
    ProcAddr := nil;
end;

function GetListOfRegisteredPictureFileFormats(const List: TStrings): Boolean;
var GetListProc:TReturnTList;
    L: TList;
    i: Integer;
begin
  FindGetFileFormatsFunc(GetListProc);
  if Assigned(GetListProc) then
    begin
      Result := True;
      L := GetListProc;
      for i:=0 to L.Count-1 do
        List.Add(PFileFormat(L[i])^.Extension + '=' + PFileFormat(L[i])^.Description);
    end
  else
    Result := False;
end;

function GetListOfRegisteredPictureTypes(const List:TClassList): Boolean;
var GetListProc:TReturnTList;
    L: TList;
    i: Integer;
begin
  FindGetFileFormatsFunc(GetListProc);
  if Assigned(GetListProc) then
    begin
      Result := True;
      L := GetListProc;
      for i:=0 to L.Count-1 do
        List.Add(PFileFormat(L[i])^.GraphicClass);
    end
  else
    Result := False;
end;

end.