Einzelnen Beitrag anzeigen

Benutzerbild von x000x
x000x

Registriert seit: 21. Jan 2004
Ort: Bei Hamburg
308 Beiträge
 
Delphi XE2 Professional
 
#53

Re: Effiziente Kompressionsverfahren

  Alt 19. Feb 2006, 17:31
Moin moin,

der Thread ist zwar schon in die Jahre gekommen, trotzdem war hier immer noch eine Frage offen
(Betrifft LZRW1/KH)

Die Funktion CompressAny hat nicht die korrekte Größe des komprimierten Puffers
zurückgegeben, hier wurden die 2 Bytes für die Chunks unterschlagen

Hier mal die korrigierte Version und die noch fehlende DeCompressAny
Delphi-Quellcode:
function TLZR.CompressAny(Source, Dest: BufferPtr;
  SourceSize: Integer): Integer;
Var
  Remaining, chunk : Integer;
  Head : ^Word;

  Function AddPtr (p : BufferPtr; Offset : Integer) : BufferPtr;
  Begin
    Result := BufferPtr (Integer (p) + Offset);
  End;

begin
  Remaining := SourceSize;
  Result := 0;
  Repeat
    If Remaining < BufferMaxSize Then Begin
      chunk := Remaining;
      Remaining := 0;
      End
    Else Begin
      chunk := BufferMaxSize;
      Dec (Remaining, BufferMaxSize);
      End;
    // Pointer vom Ziel holen
    Head := @Dest^;
    // Zielpointer um SizeOf(Word) erhöhen
    Dest := AddPtr (Dest, 2);
    // Chunk komprimieren und die größe des komprimierten Chunks
    // ins erste Word schreiben
    Head^ := Compression(Source, Dest, Chunk);
    // Quellpointer auf den Anfang vom nächsten Chunk setzen
    Source := AddPtr (Source, chunk);
    // Zielpointer um die größe des Komprimierten Puffers erhöhen
    Dest := AddPtr (Dest, Head^);
    // und die neue größe zurückgeben
    Inc (Result, Head^);
    // und auch den Header berücksichtigen
    inc (Result, 2);
  Until Remaining = 0;
end;

function TLZR.DeCompressAny(Source, Dest: BufferPtr;
  SourceSize: Integer): Integer;
Var
  Remaining : Integer;
  chunk : ^Word;
  NewSize : Word;

  Function AddPtr (p : BufferPtr; Offset : Integer) : BufferPtr;
  Begin
    Result := BufferPtr (Integer (p) + Offset);
  End;

begin
  Remaining := SourceSize;
  Result := 0;
  while Remaining > 0 do begin
    // im ersten Word steht die größe des Chunks --> merken
    chunk := @Source^;
    // Quelle um ein Word erhöhen
    Source := AddPtr(Source, 2);
    // Dekomprimieren und größe merken
    NewSize := DeCompression(Source, Dest, chunk^);
    // Jetzt Quelle einen Chunk weiter setzen
    Source := AddPtr (Source, chunk^);
    // und den Zielpointer um die neue Größe erhöhen
    Dest := AddPtr (Dest, NewSize);
    // Jetzt die Rückgabe anpassen
    inc(Result, NewSize);
    // Größe des Headers abziehen
    dec(Remaining, 2);
    // und Größe des Chunks abziehen
    dec(Remaining, chunk^);
  end;
end;
Habe zu der LZRW1 unit aber nochmal eine Frage:
Wenn ich die Überlaufprüfung {$Q} aktiviert habe, bekomme ich in der funktion
GetMatch einen Fehler (Integer overflow).
Delphi-Quellcode:
//..
VAR
  HashValue : WORD;
  TmpHash : Int16;
BEGIN
  // An dieser stelle kracht es bei {$Q} ab und zu
  HashValue := (40543*((((Source^[X] SHL 4) XOR Source^[X+1]) SHL 4) XOR
                                     Source^[X+2]) SHR 4) AND $0FFF;
//..
Wenn ich die Überlaufprüfung abschalte funktioniert alles, komprimieren dekomprimieren etc.
Kann ich das jetzt einfach ignorieren, bzw. was bewirkt diese Überlaufprüfung überhaupt?
Peter
-= Gruss Peter =-
-= alias x000x =-
  Mit Zitat antworten Zitat