wie art der daten in blob erkennen?

[KodeZwerg]

Zitat von mytbo:

Zitat von schorsch666:

ich habe gelesen, dass man das in den ersten bytes erkennen koennte, aber da muesste ich ja ne dicke liste fuehren.

List of file signatures. Bist du Herr über die Daten, speichere das Format besser gleich mit ab.

Bis bald...
Thomas

Jupp, basierend auf dieser Liste hatte ich mir mal was gebastelt was mir die Hauptgraphikformate zurück gibt:

Delphi-Quellcode:

function GetBytesFormat(const AData: TBytes): Integer;
var
  signature: TBytes;
begin
  Result := -1;
  signature := Copy(AData, 0, 8);

  if CompareMem(@signature[0], @[$FF, $D8, $FF, $DB], 4) then
    Result := 0 // JPEG
  else
  if CompareMem(@signature[0], @[$FF, $D8, $FF, $E0, $00, $10, $4A, $46], 8) then
    Result := 0 // JPEG
  else
  if CompareMem(@signature[0], @[$49, $46, $00, $01], 4) then
    Result := 0 // JPEG
  else
  if CompareMem(@signature[0], @[$FF, $D8, $FF, $EE], 4) then
    Result := 0 // JPEG
  else
  if CompareMem(@signature[0], @[$FF, $D8, $FF, $E1], 4) and CompareMem(@signature[6], @[$45, $78], 2) then
    Result := 0 // JPEG
  else
  if CompareMem(@signature[0], @[$69, $66, $00, $00], 4) then
    Result := 0 // JPEG
  else
  if CompareMem(@signature[0], @[$FF, $D8, $FF, $E0], 4) then
    Result := 0 // JPEG
  else
  if CompareMem(@signature[0], @[$89, $50, $4E, $47, $0D, $0A, $1A, $0A], 8) then
    Result := 1 // PNG
  else
  if CompareMem(@signature[0], @[$47, $49, $46, $38, $37, $61], 6) then
    Result := 2 // GIF87a
  else
  if CompareMem(@signature[0], @[$47, $49, $46, $38, $39, $61], 6) then
    Result := 2 // GIF89a
  else
  if CompareMem(@signature[0], @[$42, $4D], 2) then
    Result := 3 // BMP
  else
  if CompareMem(@signature[0], @[$00, $00, $01, $00], 4) then
    Result := 4 // ICO
  else
  if CompareMem(@signature[0], @[$49, $49, $2A, $00], 4) then
    Result := 5 // TIF
  else
  if CompareMem(@signature[0], @[$4D, $4D, $00, $2A], 4) then
    Result := 5 // TIFF
  ;
end;

Wobei es sich eher um ein Proof-of-Concept anstelle eines voll ausgereiften hoch optimierten quelltext handelt.

[himitsu]

Boar eh ... immer und immer wieder ... die sollem mal richtige Entwickler einstellen, die ihr eigenes Produckt selber benutzen.

Du kannst dich aber selber an jedes einzelne ImageFormat wenden und es fragen,
TGraphic.CanLoadFromStream

also TBitmap.CanLoadFromStream, TPngImage.CanLoadFromStream, TJPEGImage.CanLoadFromStream usw.

Ein GetFileFormats.FindFormat wäre natürlich einfacher, aber ..... mähhhhhhhhhh

Delphi-Quellcode:

unit Vcl.Graphics;

implementation  <-    was soll dieser perverse Scheiß immer?

var
  ClipboardFormats: TClipboardFormats = nil;
  FileFormats: TFileFormatsList = nil;

function GetFileFormats: TFileFormatsList;
begin
  if FileFormats = nil then FileFormats := TFileFormatsList.Create;
  Result := FileFormats;
end;

function GetClipboardFormats: TClipboardFormats;
begin
  if ClipboardFormats = nil then ClipboardFormats := TClipboardFormats.Create;
  Result := ClipboardFormats;
end;

Delphi-Quellcode:

procedure TPicture.LoadFromFile(const Filename: string);
var
  Ext: string;
  GraphicClass: TGraphicClass;
  Context: TFindGraphicClassContext;
begin
  Ext := ExtractFileExt(Filename).Remove(0, 1);
  GraphicClass := FileFormats.FindExt(Ext);

Delphi-Quellcode:

procedure TPicture.LoadFromStream(Stream: TStream);
var
  GraphicClass: TGraphicClass;
  Context: TFindGraphicClassContext;
begin
  if Stream.Size - Stream.Position = 0 then
    GraphicClass := TBitmap
  else
    GraphicClass := FileFormats.FindFormat(Stream);

Delphi-Quellcode:

procedure TPicture.LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  APalette: HPALETTE);
var
  GraphicClass: TGraphicClass;
  Context: TFindGraphicClassContext;
begin
  GraphicClass := ClipboardFormats.FindFormat(AFormat);

das was öffentlich ist, ist hierfür nicht nutzbar.

Delphi-Quellcode:

function GraphicFilter(GraphicClass: TGraphicClass): string;
var
  Filters: string;
begin
  GetFileFormats.BuildFilterStrings(GraphicClass, Result, Filters);
end;

function GraphicExtension(GraphicClass: TGraphicClass): string;
var
  I: Integer;
begin
  for I := GetFileFormats.Count-1 downto 0 do
    if TFileFormatType(FileFormats[I]).GraphicClass.ClassName = GraphicClass.ClassName then
    begin
      Result := TFileFormatType(FileFormats[I]).Extension;
      Exit;
    end;
  Result := '';
end;

function GraphicFileMask(GraphicClass: TGraphicClass): string;
var
  Descriptions: string;
begin
  GetFileFormats.BuildFilterStrings(GraphicClass, Descriptions, Result);
end;

[KodeZwerg]

Mein schnippsel sollte lediglich als Hilfestellung dienen wie man Signaturen erkennen könnte, er stammt aus etwas was keine Graphics oder Vcl kennt.
Das ich Graphikformate erkennen wollte ist in diesem Zusammenhang irrelevant.

[himitsu]

meinte nicht dich ... war auf die Entwickler bei Emba bezogen, weil die zwanghaft immer jeden Dreck verstecken müssen und sich regelrecht weigern etwas öffentlich zugänglich zu machen.

[Rollo62]

Zitat von KodeZwerg:

Jupp, basierend auf dieser Liste hatte ich mir mal was gebastelt

Hallo KodeZwerg, ich war so frei mal Deinen Code durch ChatGPT "verbessern" zu lassen, ging in nur zwei Steps:

UNGETESTET:

Zitat:

Sie haben Recht, das Kopieren des Arrays ist in diesem Fall nicht unbedingt erforderlich. Sie können direkt auf den Speicherbereich von AData zugreifen, um die Überprüfung durchzuführen. Das Entfernen des Kopiervorgangs kann die Leistung der Funktion verbessern, insbesondere wenn sie häufig aufgerufen wird.

Hier ist eine überarbeitete Version des Codes, die das Kopieren vermeidet:

Delphi-Quellcode:

function GetBytesFormat(const AData: TBytes): Integer;
begin
  Result := -1;
  if Length(AData) < 8 then Exit;

  case AData[0] of
    $FF: if CompareMem(@AData[0], @[$FF, $D8, $FF], 3) then Result := 0; // JPEG
    $89: if CompareMem(@AData[0], @[$89, $50, $4E, $47, $0D, $0A, $1A, $0A], 8) then Result := 1; // PNG
    $47: if CompareMem(@AData[0], @[$47, $49, $46, $38], 4) then Result := 2; // GIF
    $42: if CompareMem(@AData[0], @[$42, $4D], 2) then Result := 3; // BMP
    $00: if CompareMem(@AData[0], @[$00, $00, $01, $00], 4) then Result := 4; // ICO
    $49, $4D:
      if CompareMem(@AData[0], @[$49, $49, $2A, $00], 4) or
         CompareMem(@AData[0], @[$4D, $4D, $00, $2A], 4) then Result := 5; // TIF/TIFF
  end;
end;

Zitat:

In dieser Version wird direkt auf den Speicherbereich von AData zugegriffen, um die notwendigen Überprüfungen durchzuführen.
Dadurch wird der zusätzliche Kopiervorgang vermieden.

Das Ergebnis finde ich gar nicht so verkehrt, obwohl es ja nur ein von einem Text-Parser stammt

[dummzeuch]

Zitat von Rollo62:

ich war so frei mal Deinen Code durch ChatGPT "verbessern" zu lassen, ging in nur zwei Steps:

Delphi-Quellcode:

function GetBytesFormat(const AData: TBytes): Integer;
begin
  Result := -1;
  if Length(AData) < 8 then Exit;

  case AData[0] of
    $FF: if CompareMem(@AData[0], @[$FF, $D8, $FF], 3) then Result := 0; // JPEG
    $89: if CompareMem(@AData[0], @[$89, $50, $4E, $47, $0D, $0A, $1A, $0A], 8) then Result := 1; // PNG
    $47: if CompareMem(@AData[0], @[$47, $49, $46, $38], 4) then Result := 2; // GIF
    $42: if CompareMem(@AData[0], @[$42, $4D], 2) then Result := 3; // BMP
    $00: if CompareMem(@AData[0], @[$00, $00, $01, $00], 4) then Result := 4; // ICO
    $49, $4D:
      if CompareMem(@AData[0], @[$49, $49, $2A, $00], 4) or
         CompareMem(@AData[0], @[$4D, $4D, $00, $2A], 4) then Result := 5; // TIF/TIFF
  end;
end;

Das Ergebnis finde ich gar nicht so verkehrt, obwohl es ja nur ein von einem Text-Parser stammt

Naja, lesbar ist aber anders. Und ob es dabei wirklich auf die paar Millisekunden ankommt, die diese "Verbesserung" bringt, wage ich mal zu bezweifeln.

[himitsu]

Zitat:

Naja, lesbar ist aber anders. Und ob es dabei wirklich auf die paar Millisekunden ankommt, die diese "Verbesserung" bringt, wage ich mal zu bezweifeln.

Wie oft kommt es denn vor, dass diese Prüfung 2 Millionen Mal pro Sekunde ausführen muß, um es nötig zu haben, das noch zu optimieren?

Delphi-Quellcode:

{$SCOPEDENUMS ON}
type TImageFormat = (Unknown, BMP, GIF87a, TIFF, JPEG, PNG, ICO);

{$POINTERMATH ON}
function GetBytesFormat(const AData: TBytes): TImageFormat;
var
  Signature: LongWord;
begin
  Result := TImageFormat.Unknown;
  if Length(AData) >= 2 then
    if PWord(AData)^ = $4D42 then
      Result := TImageFormat.BMP;
  if Length(AData) >= 4 then
    case PLongWord(AData)^ of
      $DBFFD8FF, $01004649, $EEFFD8FF, $00006669, $E0FFD8FF:
        Result := TImageFormat.JPEG;
      $E0FFD8FF:
        if (Length(AData) >= 8) and ((PLongWord(AData) + 1)^ = $464A1000) then
          Result := TImageFormat.JPEG;
      $E1FFD8FF:
        if (Length(AData) >= 6) and ((PWord(AData) + 2)^ = $7845) then
          Result := TImageFormat.JPEG;
      $474E5089:
        if (Length(AData) >= 8) and ((PLongWord(AData) + 1)^ = $0A1A0A0D) then
          Result := TImageFormat.PNG;
      $38464947:
        if Length(AData) >= 6 then
          case (PWord(AData) + 2)^ of
            $6137, $6139:
              Result := TImageFormat.GIF87a;
          end;
      $00010000:
        Result := TImageFormat.ICO;
      $002A4949, $2A004D4D:
        Result := TImageFormat.TIFF;
    end;
end;

Lesbarer wird es jedenfalls, wenn man Daten und Code noch etwas trennt.

Code:

type
  {$SCOPEDENUMS ON}
  TImageFormat = (Unknown, BMP, GIF87a, TIFF, JPEG, PNG, ICO);
  {$SCOPEDENUMS OFF}
  TImageSignature = array[-2..7] of Byte;

const
  cImageSignatures: array[0..13] of TImageSignature = (
    (Ord(TImageFormat.JPEG),    4, $FF, $D8, $FF, $DB,    0,    0,    0,    0),
    (Ord(TImageFormat.JPEG),    8, $FF, $D8, $FF, $E0, $00, $10, $4A, $46),
    (Ord(TImageFormat.JPEG),    4, $49, $46, $00, $01,    0,    0,    0,    0),
    (Ord(TImageFormat.JPEG),    4, $FF, $D8, $FF, $EE,    0,    0,    0,    0),
    (Ord(TImageFormat.JPEG),    6, $FF, $D8, $FF, $E1, $45, $78,    0,    0),
    (Ord(TImageFormat.JPEG),    4, $69, $66, $00, $00,    0,    0,    0,    0),
    (Ord(TImageFormat.JPEG),    4, $FF, $D8, $FF, $E0,    0,    0,    0,    0),
    (Ord(TImageFormat.PNG),     8, $89, $50, $4E, $47, $0D, $0A, $1A, $0A),
    (Ord(TImageFormat.GIF87a), 6, $47, $49, $46, $38, $37, $61,    0,    0),
    (Ord(TImageFormat.GIF87a), 6, $47, $49, $46, $38, $39, $61,    0,    0),
    (Ord(TImageFormat.BMP),     2, $42, $4D,    0,    0,    0,    0,    0,    0),
    (Ord(TImageFormat.ICO),     4, $00, $00, $01, $00,    0,    0,    0,    0),
    (Ord(TImageFormat.TIFF),    4, $49, $49, $2A, $00,    0,    0,    0,    0),
    (Ord(TImageFormat.TIFF),    4, $4D, $4D, $00, $2A,    0,    0,    0,    0)
  );

function GetBytesFormat(const Data: TBytes): TImageFormat;
begin
  for var Signature: TImageSignature in cImageSignatures do
    if (Length(Data) >= Signature[-1]) and CompareMem(@Data[0], @Signature[0], Signature[-1]) then
      Exit(TImageFormat(Signature[-2]));
  Result := TImageFormat.Unknown;
end;

Delphi-Quellcode:

{$SCOPEDENUMS ON}
type
  TImageFormat = (Unknown, BMP, GIF87a, TIFF, JPEG, PNG, ICO);
{$SCOPEDENUMS OFF}

var
  cImageSignatures: array of array of Byte = [
    [Ord(TImageFormat.JPEG),   $FF, $D8, $FF, $DB],
    [Ord(TImageFormat.JPEG),   $FF, $D8, $FF, $E0, $00, $10, $4A, $46],
    [Ord(TImageFormat.JPEG),   $49, $46, $00, $01],
    [Ord(TImageFormat.JPEG),   $FF, $D8, $FF, $EE],
    [Ord(TImageFormat.JPEG),   $FF, $D8, $FF, $E1, $45, $78],
    [Ord(TImageFormat.JPEG),   $69, $66, $00, $00],
    [Ord(TImageFormat.JPEG),   $FF, $D8, $FF, $E0],
    [Ord(TImageFormat.PNG),    $89, $50, $4E, $47, $0D, $0A, $1A, $0A],
    [Ord(TImageFormat.GIF87a), $47, $49, $46, $38, $37, $61],
    [Ord(TImageFormat.GIF87a), $47, $49, $46, $38, $39, $61],
    [Ord(TImageFormat.BMP),    $42, $4D],
    [Ord(TImageFormat.ICO),    $00, $00, $01, $00],
    [Ord(TImageFormat.TIFF),   $49, $49, $2A, $00],
    [Ord(TImageFormat.TIFF),   $4D, $4D, $00, $2A]
  ];

function GetBytesFormat(const Data: TBytes): TImageFormat;
begin
  for var Signature in cImageSignatures do
    if (Length(Data) >= Length(Signature)-1) and CompareMem(@Data[0], @Signature[1], Length(Signature)-1) then
      Exit(TImageFormat(Signature[0]));
  Result := TImageFormat.Unknown;
end;

[KodeZwerg]

Zitat von Rollo62:

Hallo KodeZwerg, ich war so frei mal Deinen Code durch ChatGPT "verbessern" zu lassen, ging in nur zwei Steps:

Interessanter Ansatz der leider manche Signaturen von meinem original komplett "weg-optimiert"

@himitsu:
Cooler Ansatz, das muss ich dringend mal testen wie das bei den verschieden langen Signaturen aufgefüllt mit Nullen klappt.
TImageSignature = array[-2..7] of Byte; Das muss ich erstmal verdauen das da ein negativer Startindex steht.
 (Ord(TImageFormat.BMP), 2, $42, $4D, 0, 0, 0, 0, 0, 0), und wie sowas funktionieren soll mit den Nullen die nicht zur Signatur gehören.

Delphi-Quellcode:

 if CompareMem(@signature[0], @[$FF, $D8, $FF, $E1], 4) and CompareMem(@signature[6], @[$45, $78], 2) then
    Result := 0 // JPEG

 (Ord(TImageFormat.JPEG), 6, $FF, $D8, $FF, $E1, $45, $78, 0, 0), hier kann ich schonmal sagen ist ein Fehler unterlaufen, der zweite Teil fängt bei Offset 6 an, wo da Nullen stehen.

Danke auf jeden Fall für die Verschönerung meines PoC!

[himitsu]

Ja, damit die Signatur bei [0] beginnt
bei [-1] die eigentliche Länge (ohne die Nullen)
und auf [-2] das Format (hab mir ersparrt das mit einem Record-Array zu bauen (array of record Format: TImageFormat; Len: Integer; Signature: array[0..7] of Byte; end; )
Vor allem, da Record-Konstanten sinnlos pervers hässlich sind.

Aber ginge auch mit array[0..9] , also [0] das Format, [1] die Länge und ab [2] die Signatur.


Bei einem statischen Array ist die zweite Ebene immer gleich groß, darum mußte aufgefüllt werden,
aber nachfolgend, mit dynamischen Arrays, geht es ohne Füllbytes.

[himitsu]

Zitat:

(Ord(TImageFormat.JPEG), 6, $FF, $D8, $FF, $E1, $45, $78, 0, 0)

Mist ... hast Recht.
Offset 6 ... falsch gelesen.
also eigentlich (Ord(TImageFormat.JPEG), 8, $FF, $D8, $FF, $E1, 0, 0, $45, $78)



joar dann muß man das Ganze noch um eine Maske (AND) erweitern, um die zwischenliegenden FüllBytes "ignorieren" zu können
(Ord(TImageFormat.JPEG), {Len} 8, {Daten} $FF, $D8, $FF, $E1, 0, 0, $45, $78, {Maske} $FF, $FF, $FF, $FF, 0, 0, $FF, $FF)

oder um eine zweite Prüfung (CompareMem) mit zusätzlichem Offset+Len.
(Ord(TImageFormat.JPEG), {Len1} 4, {Offest2} 6, {Len2} 2, {Daten1} $FF, $D8, $FF, $E1, 0, 0, {Daten2} $45, $78) // für Daten an gleicher Stelle (0..3 und 6..7)
(Ord(TImageFormat.JPEG), {Len1} 4, {Offest2} 6, {Len2} 2, {Daten1} $FF, $D8, $FF, $E1, {Daten2} $45, $78, 0, 0) // oder für Daten hintereinander (4+2 von 8)
und die Anderen alle mit {Offest2} 0, {Len2} 0, , also Offest2=0 für "gibt's nicht"

Die Maske hätte den Vorteil auch Bits ignorieren zu können, bzw. mehr als nur einen Sprung machen zu können.