如何从VCL.Graphics ...中获取所有已注册文件格式...但64位 [英] How to get all of the registered file formats from VCL.Graphics... but 64bit

问题描述

在我的32位应用程序中，我使用的是 Cosmin Prund提供的FindRegisteredPictureFileFormats单元 =>（如何从图形单元获取所有受支持的文件格式？ ）。

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?).

我需要相同的功能，但必须使用64位。 David Heffernan回答说它已经具有64位版本。可以将此代码公开吗？

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

非常感谢！

推荐答案

我相信这个部门可以满足您的需求。我已经在32位和64位Windows（带或不带运行时程序包）上对其进行了测试。我没有使用自上而下的内存分配对其进行测试，但是我不相信存在指针截断错误。

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.

这篇关于如何从VCL.Graphics ...中获取所有已注册文件格式...但64位的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！