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