GetJPGSize Funktion (wollen wir sie verbessern?)

[KodeZwerg]

Lang hat's gedauert, da ich pers. Jpeg absolut nicht mag.
Hier ist mein Versuch was schnelles draus zu basteln, keine Benchmarks durchgeführt, selbst ist der Mann/die Frau :-)

Hier meine herangehensweise, in der Hoffnung das es tatsächlich hilft:
Ps: Übergeben werden muss ein gültiger kompletter Pfad.
(MyGetFiles holt aus dem Verzeichniss nur die Dateinamen ab)

Delphi-Quellcode:

procedure TfrmMain.ComputeData(const input: String);
type
  TJpgInfo = record
    IsJpeg: Boolean;
    Version : String;
    Dimension : String;
    Mode: String;
  end;
  function BytesToWord(HiByte, LoByte: Byte): Word;
    type
      TWord = record
        case integer of
          0 : (Both : Word);
          1 : (Lo, Hi : Byte);
      end;
    var
      Long : TWord;
  begin
    with Long do
      begin
        Hi := HiByte;
        Lo := LoByte;
        Result := Both;
      end;
  end; // BytesToWord
  function GetJpgInfo(const FS: TFileStream): TJpgInfo;
    var
      Buf: TBytes;
      i: Integer;
      checker: Boolean;
      LastPos: Integer;
      S: String;
      MaxCache: Int64;
  begin
    MaxCache := (20 * 1024); // ggf anpassen für noch dickere header...
    checker := True;
    Result.IsJpeg := False;
    LastPos := 0;
    FS.Position := LastPos;
    if (FS.Size >= MaxCache) then
      SetLength(Buf, MaxCache)
    else
      SetLength(Buf, FS.Size);
    FS.Read(Pointer(Buf)^, Length(Buf)); // daten puffern um es flott im RAM dynamisch auswerten zu können
                                         // dyn = wenn signaturen nicht direkt bei position 0 anfangen
                                         // Jpeg's mit exif header zBsp
    if checker then // Signatur Check
      begin
        checker := False;
        for I := Low(Buf) to High(Buf) do
          begin
            if i + 3 < High(Buf) then
              if ((Buf[I] = $ff) and (Buf[I+1] = $d8) and (Buf[I+2] = $ff) and (Buf[I+3] = $e0)) then
                begin
                  checker := True;
                  LastPos := i + 3;
                  Break;
                end;
          end;
      end;
    if checker then // prüfe ob JFIF vorhanden ist, erst ab hier akzeptiere ich es als Jpeg Datei
      begin
        checker := False;
        for I := LastPos to High(Buf) do
          begin
              if i + 3 < High(Buf) then
              if ((Buf[I] = $4a) and (Buf[I+1] = $46) and (Buf[I+2] = $49) and (Buf[I+3] = $46)) then
                begin
                  checker := True;
                  Result.IsJpeg := True;
                  // Application.MessageBox(PChar('gefunden'), PChar('gefunden'), MB_OK);
                  LastPos := i + 3;
                  Break;
                end;
          end;
      end;
    if Result.IsJpeg then // hole Version
      begin
        if LastPos + 3 < High(Buf) then
          begin
            if Buf[LastPos+3] < 10 then
              Result.Version := IntToStr(Buf[LastPos+2]) + '.' + '0' + IntToStr(Buf[LastPos+3])
            else
              Result.Version := IntToStr(Buf[LastPos+2]) + '.' + IntToStr(Buf[LastPos+3]);
            LastPos := LastPos + 3;
          end;
      end;
    if Result.IsJpeg then // hole Dimension und Farbmodus vom letzten C0 segment was sich hoffentlich im MaxCache bereich befindet...
                          // da diese operation den kompletten puffer betrifft
                          // kann man hier bestimmt noch mehr speed rausholen
      begin
        checker := False;
        for I := LastPos to High(Buf) do
          begin
            if i + 1 < High(Buf) then
              if ((Buf[I] = $ff) and (Buf[I+1] = $c0)) then
                begin
                  checker := True;
                  LastPos := i;
                end;
          end;
        if checker then
          if LastPos + 10 < High(Buf) then
            begin
              Result.Dimension := IntToStr(BytesToWord(Buf[LastPos + 7], Buf[LastPos + 8])) + ' x ' + IntToStr(BytesToWord(Buf[LastPos + 5], Buf[LastPos + 6]));
              case Buf[LastPos + 9] of
                $1: Result.Mode := 'Grey';
                $3: Result.Mode := 'YCbCr';
                $4: Result.Mode := 'CMYK';
              end;
            end;
      end;
  end; // GetJpgInfo
var
  FileList: TStringDynArray;
  lvItem: TListItem;
  i: Integer;
  fs: TFileStream;
  JpgInfo: TJpgInfo;
begin
  lvFolder.Clear;
  if Length(input) <= 3 then Exit;
  edtFolder.Text := input;
  FileList := MyGetFiles(input, '*.jpg;*.jpeg;*.jpe;*.jfif', False);
  if Length(FileList) > 0 then
    begin
      for I := Low(FileList) to High(FileList) do
        begin
          lvItem := lvFolder.Items.Add;
          lvItem.Caption := ExtractFileName(FileList[I]);
          fs := TFile.OpenRead(FileList[I]);
          lvItem.SubItems.Add(IntToStr(fs.Size));
          JpgInfo := GetJpgInfo(fs);
          if JpgInfo.IsJpeg then
            begin
              lvItem.SubItems.Add(JpgInfo.Version);
              lvItem.SubItems.Add(JpgInfo.Dimension);
              lvItem.SubItems.Add(JpgInfo.Mode);
            end;
        end;
      fs.Free;
    end;
end; // ComputeData

Ein kleines Testprogramm dem dieser Code entspringt ist angepappt.
Viel Spass


/edit
Mir ist gerade noch 'ne Speed optimierung eingefallen betreffend diesem Abschnitt:

Code:

    if Result.IsJpeg then // hole Dimension und Farbmodus vom letzten C0 segment was sich hoffentlich im MaxCache bereich befindet...
                          // da diese operation den kompletten puffer betrifft
                          // kann man hier bestimmt noch mehr speed rausholen
      begin
        checker := False;
        for I := LastPos to High(Buf) do

genau andersrum machen, rückwärts abarbeiten lassen und einen break beim ersten fund...