delphi - texto - ¿Cómo obtener todos los formatos de archivo admitidos desde la unidad de gráficos?

tipos de archivos de texto

Question

Cuando un descendiente de TGraphic registra su propio formato de archivo gráfico con un procedimiento de clase TPicture.RegisterFileFormat (), todos se almacenan en la variable global Graphics.FileFormats.

Lástima que la variable FileFormats no se encuentre en la sección "interfaz" de "Graphics.pas", por lo que no puedo acceder a ella. Necesito leer esta variable para implementar un filtro especial para mi control de lista de archivos.

¿Puedo obtener esa lista sin una reparación manual del código fuente de Graphics.pas?

Answer 1

El proyecto GlScene tiene una unidad PictureRegisteredFormats.pas que implementa un hack para eso.

Answer 2

Está trabajando con un control de lista de archivos y, presumiblemente, una lista de nombres de archivos. Si no necesita conocer los tipos reales de clase TGraphic que están registrados, solo si una extensión de archivo determinada está registrada o no (por ejemplo, para verificar si una llamada posterior a TPicture.LoadFromFile() es probable que tenga éxito), puede use la función pública GraphicFileMask() para obtener una lista de extensiones de archivos registradas y luego compare sus nombres de archivo con esa lista. Por ejemplo:

uses
SysUtils, Classes, Graphics, Masks;
function IsGraphicClassRegistered(const FileName: String): Boolean;
var
Ext: String;
List: TStringList;
I: Integer;
begin
Result := False;
Ext := ExtractFileExt(FileName);
List := TStringList.Create;
try
List.Delimiter := '';'';
List.StrictDelimiter := True;
List.DelimitedText := GraphicFileMask(TGraphic);
for I := 0 to List.Count-1 do
begin
if MatchesMask(FileName, List[I]) then
begin
Result := True;
Exit;
end;
end;
finally
List.Free;
end;
end;

O bien, simplemente puede cargar el archivo y ver qué sucede:

uses
Graphics;
function GetRegisteredGraphicClass(const FileName: String): TGraphicClass;
var
Picture: TPicture;
begin
Result := nil;
try
Picture := TPicture.Create;
try
Picture.LoadFromFile(FileName);
Result := TGraphicClass(Picture.Graphic.ClassType);
finally
Picture.Free;
end;
except
end;
end;

Actualización: si desea extraer las extensiones y descripciones, puede usar TStringList.DelimitedText para analizar el resultado de la función GraphicFilter() :

uses
SysUtils, Classes, Graphics;
function RPos(const ASub, AIn: String; AStart: Integer = -1): Integer;
var
i: Integer;
LStartPos: Integer;
LTokenLen: Integer;
begin
Result := 0;
LTokenLen := Length(ASub);
// Get starting position
if AStart < 0 then begin
AStart := Length(AIn);
end;
if AStart < (Length(AIn) - LTokenLen + 1) then begin
LStartPos := AStart;
end else begin
LStartPos := (Length(AIn) - LTokenLen + 1);
end;
// Search for the string
for i := LStartPos downto 1 do begin
if Copy(AIn, i, LTokenLen) = ASub then begin
Result := i;
Break;
end;
end;
end;
procedure GetRegisteredGraphicFormats(AFormats: TStrings);
var
List: TStringList;
i, j: Integer;
desc, ext: string;
begin
List := TStringList.Create;
try
List.Delimiter := ''|'';
List.StrictDelimiter := True;
List.DelimitedText := GraphicFilter(TGraphic);
i := 0;
if List.Count > 2 then
Inc(i, 2); // skip the "All" filter ...
while i <= List.Count-1 do
begin
desc := List[i];
ext := List[i+1];
j := RPos(''('', desc);
if j > 0 then
desc := TrimRight(Copy(desc, 1, j-1)); // remove extension mask from description
AFormats.Add(ext + ''='' + desc);
Inc(i, 2);
end;
finally
List.Free;
end;
end;

Actualización 2: si solo está interesado en una lista de extensiones de archivos gráficos registrados, suponiendo que List es un descendiente TStrings ya creado, use esto:

ExtractStrings(['';''], [''*'', ''.''], PChar(GraphicFileMask(TGraphic)), List);

Answer 3

Aquí hay un truco alternativo que podría ser más seguro que la solución GLScene . Todavía es un truco , porque la estructura deseada es global, pero en la sección de implementación de la unidad Graphics.pas , pero mi método utiliza muchas menos "constantes maigc" (desplazamientos codificados en el código) y utiliza dos métodos distintos para detectar la función GetFileFormats en Graphics.pas .

Mi código explota el hecho de que tanto TPicture.RegisterFileFormat como TPicture.RegisterFileFormatRes necesitan llamar inmediatamente a la función Graphics.GetFileFormats . El código detecta el código de operación CALL desplazamiento relativo y registra la dirección de destino para ambos . Solo avanza si ambos resultados son iguales y esto agrega un factor de seguridad. El otro factor de seguridad es el método de detección en sí mismo: incluso si el prólogo generado por el compilador cambiara, siempre que la primera función llamada sea GetFileFormats , este código la encuentre.

No voy a poner la "Warning: This will crash when Graphics.pas is compiled with the ''Use Debug DCUs'' option." en la parte superior de la unidad (como se encuentra en el código GLScene ), porque probé con depuración de dcu y sin depuración y funcionó. También probado con paquetes y todavía funcionó.

Este código solo funciona para objetivos de 32 bits, de ahí el uso extensivo de Integer para operaciones de puntero. Intentaré hacer que esto funcione para objetivos de 64 bits tan pronto como tenga mi compilador Delphi XE2 instalado.

Actualización: una versión que admite 64 bits se puede encontrar aquí: https://.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.