Pascal lzh

7/7/2018

2276

Pascal lzh

Ein Extemely schnell LZH-Kompressor

Autor: KURT HAENEN

{$R-} {KEINE Bereichsüberprüfung!!}

{
---------------------------------------------------------------
Dieser Beitrag enthält die Quellen für Turbo Pascal
Version des LZRW1/KH-Komprimierung-Algoritm.
---------------------------------------------------------------
Datei #1: Die LZRW1KH-Einheit
--------------------------
}
{ ################################################################### }
{ ## ## }
{ ## ## ##### ##### ## ## ## ## ## ## ## ## ## }
{ ## ## ### ## ## ## # ## ### ## ## ## ## ## ## }
{ ## ## ### ##### ####### ## ## #### ###### ## }
{ ## ## ### ## ## ### ### ## ## ## ## ## ## ## }
{ ## ##### ##### ## ## ## ## #### ## ## ## ## ## ## }
{ ## ## }
{## EXTREM SCHNELL UND LEICHT VERSTÄNDLICHE KOMPRESSION ALGORITM ##}
{ ## ## }
{ ################################################################### }
{ ## ## }
{## Dieser Einheit implementiert die aktualisierte LZRW1/KH Algoritm die ##}
{## setzt auch einige RLE Codierung ist nützlich beim ##}
{## Komprimieren Dateien, die viel fortlaufenden Datenbytes ##}
{## mit dem gleichen Wert. Die Algoritm ist nicht so gut wie ##}
{## LZH, aber mit Lempel-Ziff konkurrieren kann. Es ist die schnellste ##}
{## ich habe jetzt bis zu begegnet. ##}
{ ## ## }
{ ## ## }
{ ## ## }
{## Kurt HAENEN ##}
{ ## ## }
{ ################################################################### }

EINHEIT LZRW1KH;

SCHNITTSTELLE

SysUtils verwendet;

{$IFDEF WIN32}
Geben Sie Int16 = SmallInt;
{$ELSE}
Geben Sie Int16 = Integer;
{$ENDIF}

CONST
BufferMaxSize = 32768;
BufferMax = BufferMaxSize-1;
FLAG_Copied = $80;
FLAG_Compress = $40;

TYP
BufferIndex = 0..BufferMax + 15;
BufferSize = 0..BufferMaxSize;
{zusätzlichen Bytes benötigt hier scheitert Komprimierung * dh *}
BufferArray = ARRAY [BufferIndex] Byte;
BufferPtr = ^ BufferArray;

ELzrw1KHCompressor = Class(Exception);

Funktion-Komprimierung (Quelle, Dest: BufferPtr;
SourceSize: BufferSize): BufferSize;

Funktion-Dekompression (Quelle, Dest: BufferPtr;
SourceSize: BufferSize): BufferSize;

UMSETZUNG

Typ
HashTable = ARRAY [0..4095] von Int16;
HashTabPtr = ^ Hashtable;

VAR
Hash: HashTabPtr;

{Überprüfen Sie, ob diese Zeichenfolge bereits erlebt hat}
{im aktuellen Fenster 4 KB}
Funktion GetMatch (Quelle: BufferPtr;
X: BufferIndex;
SourceSize: BufferSize;
Hash: HashTabPtr;
VAR-Größe: WORD;
VAR-Pos: BufferIndex): BOOLEAN;
VAR
HashValue: WORD;
TmpHash: Int16;
BEGIN
HashValue: = (40543 * (((Quelle ^ [X] SHL 4) XOR Source^[X+1]) SHL 4) XOR
Source^[X+2]) SHR 4) und $0FFF;
Ergebnis: = FALSE;
TmpHash: Hash = ^ [HashValue];
IF (TmpHash-<> -1) und (X - TmpHash < 4096) dann beginnen
POS: = TmpHash;
Größe: = 0;
WÄHREND ((Size < 18) und (Quelle ^ [X + Size] = Source^[Pos+Size])
UND (X + Größe < SourceSize)) fangen
Inc(Size);
Ende;
Ergebnis: = (Größe > = 3)
ENDE;
Hash ^ [HashValue]: = X
ENDE;
{einen Puffer von Max zu komprimieren. 32 KB}
Funktion-Komprimierung (Quelle, Dest: BufferPtr;
SourceSize: BufferSize): BufferSize;
VAR
Bit, Befehl, Größe: WORD;
Schlüssel: Word;
X, Y, Z, Pos: BufferIndex;
BEGIN
FillChar(Hash^,SizeOf(Hashtable), $FF);
Dest ^ [0]: = FLAG_Compress;
X: = 0;
Y: = 3;
Z: = 1;
Bit: = 0;
Befehl: = 0;
WÄHREND (X < SourceSize) und (Y < = SourceSize) fangen
IF (> 15 Bit) dann beginnen
Dest ^ [Z]: = HI(Command);
Dest ^ [Z + 1]: = LO(Command);
Z: = Y;
Bit: = 0;
INC(Y,2)
ENDE;
Größe: = 1;
WÄHREND ((Quelle ^ [X] = Source^[X+Size]) und (Größe < $FFF)
UND (X + Größe < SourceSize)) fangen
Inc(Size);
Ende;
IF (Size > = 16) dann beginnen
Dest ^ [Y]: = 0;
Dest ^ [Y + 1]: = HI(Size-16);
Dest ^ [Y + 2]: = LO(Size-16);
Dest ^ [Y + 3]: = Quelle ^ [X];
INC(Y,4);
Inc(X,Size);
Befehl: = (Befehl SHL 1) + 1;
ENDE
ELSE begin {nicht Größe > = 16}
Wenn (GetMatch(Source,X,SourceSize,Hash,Size,Pos)) dann beginnen
Schlüssel: = ((X-Pos) SHL 4) + (Größe-3);
Dest ^ [Y]: = HI(Key);
Dest ^ [Y + 1]: = LO(Key);
INC(Y,2);
Inc(X,Size);
Befehl: (Befehl SHL 1) = + 1
ENDE
SONST BEGINNEN
Dest ^ [Y]: = Quelle ^ [X];
INC(Y);
INC(X);
Befehl: = Befehl SHL 1
ENDE;
Ende; {Größe < = 16}
Inc(Bit);
ENDE; {während x < Sourcesize...}
Befehl: = Befehl SHL (16-Bit);
Dest ^ [Z]: = HI(Command);
Dest ^ [Z + 1]: = LO(Command);
IF (Y > SourceSize) dann beginnen
Move(Source^[0],dest^[1],SourceSize);
Dest ^ [0]: = FLAG_Copied;
Y: = SUCC(SourceSize)
ENDE;
Ergebnis: = Y
ENDE;

{Dekomprimieren Sie einen Puffer von Max. 32 KB}
Funktion-Dekompression (Quelle, Dest: BufferPtr;
SourceSize: BufferSize): BufferSize;
VAR
X, Y-Pos: BufferIndex;
Befehl, Größe, K: WORD;
Bisschen: BYTE;
SaveY: BufferIndex; {* dh * unsichere for-Schleife Variable Y}

BEGIN
IF (Quelle ^ [0] = FLAG_Copied) dann beginnen
Y: = 1 PRED(SourceSize) zu tun beginnen
Dest^[pred(Y)]: = Quelle ^ [Y];
SaveY: = Y;
Ende;
Y: = SaveY;
Ende
SONST BEGINNEN
Y: = 0;
X: = 3;
Befehl: = (Quelle ^ [1] SHL 8) + Source ^ [2];
Bit: = 16;
WÄHREND (X < SourceSize) fangen
IF (Bit = 0) dann beginnen
Befehl: = (Quelle ^ [X] SHL 8) + Source ^ [X + 1];
Bit: = 16;
INC(X,2)
ENDE;
IF ((Befehl und $8000) = 0) dann beginnen
Dest ^ [Y]: = Quelle ^ [X];
INC(X);
INC(Y)
ENDE
ELSE BEGIN {Befehl und $8000}
POS: = ((Quelle ^ [X] SHL 4)
+ (Quelle ^ [X + 1] SHR 4));
IF (Pos = 0) dann beginnen
Größe: = (Quelle ^ [X + 1] SHL 8) + Source ^ [X + 2] + 15;
FÜR K: = 0 Größe zu tun beginnen
Dest ^ [Y + K]: = Quelle ^ [X + 3];
Ende;
INC(X,4);
Inc(Y,size+1)
ENDE
ELSE BEGIN {pos = 0}
Größe: = (Quelle ^ [X + 1] und $0F) + 2;
FÜR K: = 0 bis Größe
Dest ^ [Y + K]: = Dest ^ [Y-Pos + K];
INC(X,2);
Inc(Y,size+1)
ENDE; {pos = 0}
ENDE; {Befehl und $8000}
Befehl: = Befehl SHL-1;
Dec(Bit)
Ende {während x < Sourcesize}
ENDE;
Ergebnis: = Y
ENDE; {Dekompression}

{
Einheit 'Finalisierung' als Delphi 2.0 hätte es
}

var
ExitSave: Zeiger;

Prozedur Cleanup; weit;
beginnen
ExitProc: = ExitSave;
Wenn (Hash-<> Nil) dann
FreeMem (Hash, Sizeof(HashTable));
Ende;

Initialisierung

Hash: = Nil;
versuchen Sie
GetMem(Hash,sizeof(Hashtable));
mit Ausnahme von
ELzrw1KHCompressor.Create zu erhöhen ('LZRW1KH: kein Speicher für HASH-Tabelle');
Ende;
ExitSave: = ExitProc;
ExitProc: = die @Cleanup;
ENDE.