3

In my 32bit application I'm using the FindRegisteredPictureFileFormats unit provided by Cosmin Prund => (How to get all of the supported file formats from Graphics unit?).

I need the same but for 64bit. David Heffernan replied it had already a 64bit version. Can this code be made public ?

Thanks a lot !!

Community
  • 1
  • 1
Frédéric SCHENCKEL
  • 33
  • 2
  • 3
    Remy's solution (the accepted answer to the linked question) will work fine in 64-bit code. Is there a reason you selected the more hacky answer Cosmin posted instead of Remy's? – Ken White Mar 04 '16 at 18:17
  • As I have the graphic in a stream, I need the graphic class to load it correctly. I cannot use the trick by loading the file and see which graphic class was used... I know the FindRegisteredPictureFileFormats is a hack but it works really fine in 32bit. But If I can get the result trough another way I can adapt my code of course ! – Frédéric SCHENCKEL Mar 04 '16 at 23:03
  • You can modify Remy's code to load from a stream instead of from a file and use the same method, without resorting to assembly code that isn't cross-platform (and that includes 32/64 bit Windows). – Ken White Mar 05 '16 at 00:05
  • From where did you get the stream? Database, Resource, ...? – Sir Rufo Mar 05 '16 at 08:11
  • Don't you know what formats are supported? Or are you writing code that is plugged in to a host app? – David Heffernan Mar 05 '16 at 08:13
  • Wow, there is a lot of noise comments here. Remy's answer appears to be addressing XY problem stated in deleted comment. – Free Consulting Mar 05 '16 at 09:56
  • Yes, the app is composed by plugins so the available picture formats can vary from the app that wrote the stream and the one that use it. I need to pick the available one from the read platform and not necessary the one from the write platform. Of course I could change this behavior but this means I will loss a little in flexibility and Win32 platform behaves differently from Win64. – Frédéric SCHENCKEL Mar 05 '16 at 09:58
  • @Ken, As far as I know it's the LoadFromFile which checks for the right class, the LoadFromStream needs directly the right class or am I wrong ? Of course cross platform compatibilty would be fine also !!! – Frédéric SCHENCKEL Mar 05 '16 at 10:04
  • Modifying the Graphics.pas unit is also not the most interesting solution because I use packages, it would be somewhat difficult to make all packages rely on my modified Graphics.pas. – Frédéric SCHENCKEL Mar 05 '16 at 10:06

1 Answers1

2

I believe that this unit does what you are looking for. I've testing it on 32 bit and 64 bit Windows, with runtime packages and without. I've not tested it with top-down memory allocation, but I don't believe that there are pointer truncation bugs. 

unit FindRegisteredPictureFileFormats;

{$POINTERMATH ON}

interface

uses Classes, Contnrs;

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

// This returns the list of TGraphicClass registered; True for successful hack, false
// for unsuccesful hach
function GetListOfRegisteredPictureTypes(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: Cardinal;
  end;

  PLongAbsoluteJumpOpcode = ^TLongAbsoluteJumpOpcode;

  TReturnTList = function: TList;

  // Structure copied from Graphics unit.
  PFileFormat = ^TFileFormat;

  TFileFormat = record
    GraphicClass: TGraphicClass;
    Extension: string;
    Description: string;
    DescResID: Integer;
  end;

function FindFirstRelativeCallOpcode(StartOffset: NativeUInt): NativeUInt;
var
  Ram: ^Byte;
  i: Integer;
  PLongJump: PLongAbsoluteJumpOpcode;
begin
  Ram := nil;

  PLongJump := PLongAbsoluteJumpOpcode(@Ram[StartOffset]);
  if (PLongJump^.OpCode[0] = $FF) and (PLongJump^.OpCode[1] = $25) then
{$IF Defined(WIN32)}
    Result := FindFirstRelativeCallOpcode(PNativeUInt(PLongJump^.Destination)^)
{$ELSEIF Defined(Win64)}
    Result := FindFirstRelativeCallOpcode(PNativeUInt(PLongJump^.Destination + StartOffset + SizeOf(PLongJump^))^)
{$ELSE}
    {$MESSAGE Fatal 'Architecture not supported'}
{$ENDIF}
  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: NativeUInt;
  Offset_from_RegisterFileFormatRes: NativeUInt;
begin
  Offset_from_RegisterFileFormat := FindFirstRelativeCallOpcode(NativeUInt(@TPicture.RegisterFileFormat));
  Offset_from_RegisterFileFormatRes := FindFirstRelativeCallOpcode(NativeUInt(@TPicture.RegisterFileFormatRes));

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

function GetListOfRegisteredPictureFileFormats(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(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.
David Heffernan
  • 601,492
  • 42
  • 1,072
  • 1,490
  • Thanks a lot this works !! Note: Overflow check and debug Dcu's needs to be deactivated. With debug Dcus activated the *`Offset_from_RegisterFileFormat = Offset_from_RegisterFileFormatRes`* test gets false. – Frédéric SCHENCKEL Mar 07 '16 at 09:09
  • I get a `[dcc32 Error] E2016 Array type required` error when compiling under XE4/win32, anyway to fix it? Thanks! – Edwin Yip Jun 29 '22 at 08:28
  • The earlier version of your code here (https://stackoverflow.com/a/14677532/133516) compiles under xe4/win32. – Edwin Yip Jun 29 '22 at 08:31