AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Sprachen und Entwicklungsumgebungen Object-Pascal / Delphi-Language GetJPGSize Funktion (wollen wir sie verbessern?)
Thema durchsuchen
Ansicht
Themen-Optionen

GetJPGSize Funktion (wollen wir sie verbessern?)

Ein Thema von MicMic · begonnen am 7. Feb 2020 · letzter Beitrag vom 10. Mär 2020
Antwort Antwort
Seite 4 von 4   « Erste     234   
Benutzerbild von KodeZwerg
KodeZwerg

Registriert seit: 1. Feb 2018
3.691 Beiträge
 
Delphi 11 Alexandria
 
#31

AW: GetJPGSize Funktion (wollen wir sie verbessern?)

  Alt 10. Mär 2020, 07:51
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...
Angehängte Dateien
Dateityp: 7z JpegLister.7z (608,4 KB, 6x aufgerufen)
Gruß vom KodeZwerg

Geändert von KodeZwerg (10. Mär 2020 um 12:49 Uhr)
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 4 von 4   « Erste     234   


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 06:28 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz