En ekstremt rask LZH kompressor
bidragsyter: KURT Haenen
{$ R-} {NEI utvalg kontroll !! } product: {--------------------------------------------- ------------------ Dette oppslaget inneholder kildene til Turbo Pascal versjon av LZRW1 /KH-komprimering algoritmen. -------------------------------------------------- ------------- File # 1: LZRW1KH Enheten --------------------------} {## ################################################## ###############} {## ##} {## ## ##### ##### ## ## ## ## ## ## # # ## ##} {## ## ### ## ## ## # ## ### ## ## ## ## ## ##} {## ## ### ### ## ####### ## ## #### ###### ##} {## ## ### ## ## ### ### ## ## ## ## ## ## ##} {## ##### ##### ## ## ## ## #### ## ## ## ## ## ##} {## ##} {## ekstremt rask og lett å forstå COMPRESSION algoritmen ##} {## ##} {########################## #########################################} {## ##} {# # Denne enheten implementerer den oppdaterte LZRW1 /KH algoritmen som ##} {## implementerer også noen RLE koding som er nyttig når ##} {## komprimere filer som inneholder en rekke sammenhengende bytes ##} {## har samme verdi . Den algoritmen er ikke så god som ##} {## LZH, men kan konkurrere med Lempel-Ziff. Det er fastende ##} {## ene jeg har møtt opp til nå. ##} {## ##} {## ##} {## ##} {## Kurt Haenen ##} {## ##} {############## ################################################## ###}
UNIT LZRW1KH;
INTERFACE
bruker SysUtils; product: {$ ifdef WIN32} skriver Int16 = SMALLINT; {$ ELSE} skriver Int16 = Integer; {$ ENDIF}
CONST BufferMaxSize = 32768; BufferMax = BufferMaxSize-en; FLAG_Copied = $ 80; FLAG_Compress = $ 40;
TYPE BufferIndex = 0..BufferMax + 15; Buffer = 0..BufferMaxSize; {Ekstra byte nødvendig her hvis komprimering svikter * dh *} BufferArray = array [BufferIndex] AV BYTE; BufferPtr = ^ BufferArray;
ELzrw1KHCompressor = Class (Unntak);
FUNKSJON Compression (Kilde, Mål: BufferPtr; SourceSize: buffer): buffer;
FUNKSJON Dekompresjon (Kilde, Mål: BufferPtr; SourceSize: buffer) : buffer;
GJENNOMFØRING
typen hashtabellen = array [0..4095] AV Int16; HashTabPtr = ^ hashtabellen;
VAR Hash: HashTabPtr; product: {sjekke om denne strengen har allerede blitt sett} {i inneværende 4 KB vindu} FUNKSJON GetMatch (Kilde: BufferPtr; X: BufferIndex; SourceSize: buffer; Hash : HashTabPtr; VAR Størrelse: WORD; VAR Pos: BufferIndex): BOOLEAN; VAR HashValue: WORD; TmpHash: Int16; BEGIN HashValue: = (40543 * ((((Kilde ^ [X] SHL 4) XOR Kilde ^ [X + 1]) SHL 4) XOR Kilde ^ [X + 2]) SHR 4) OG $ 0FFF; Resultat: = false; TmpHash: = Hash ^ [HashValue]; IF (TmpHash < > -1) og (X - TmpHash < 4096), og start Pos: = TmpHash; Størrelse: = 0; MENS ((Size < 18) og (Kilde ^ [X + format] = Kilde ^ [Pos + format]) AND (X + Size < SourceSize)) MÅ begynne INC (Size); ende; Resultat: = (Size > = 3) END; Hash ^ [HashValue]: = X END; {Komprimere en buffer på maks. 32 KB} FUNKSJON Compression (Kilde, Mål: BufferPtr; SourceSize: buffer): buffer; VAR Bit, Command, Mål: WORD; Nøkkel: Word; X, Y, Z, Pos: BufferIndex; BEGIN FillChar (Hash ^, sizeof (hashtabellen), $ FF); Dest ^ [0]: = FLAG_Compress; X: = 0; Y: = 3; Z: = 1; Bit: = 0; Command: = 0; MENS (X < SourceSize) og (Y < = SourceSize) DO BEGIN IF (Bit > 15), og start Dest ^ [Z]: = HI (Command); Dest ^ [Z + 1]: = LO (Command); Z: = Y; Bit: = 0; INC (Y, 2) END; Størrelse: = 1; MENS ((Kilde ^ [X] = Kilde ^ [X + format]) AND (Size < $ FFF) og (X + Size < SourceSize)) MÅ begynne INC (Size); ende; IF (Size > = 16), og start Dest ^ [Y]: = 0; Dest ^ [Y + 1]: = HI (Size-16); Dest ^ [Y + 2]: = LO (Size-16); Dest ^ [Y + 3]: = Kilde ^ [X]; INC (Y, 4); INC (X, Size); Command: = (Command SHL 1) + 1; END ELSE begin {ikke størrelsen > = 16} IF (GetMatch (Kilde, X, SourceSize, Hash, størrelse, Pos)), og start Key: = ((X-Pos) SHL 4) + (Size-3); Dest ^ [Y]: = HI (Key); Dest ^ [Y + 1]: = LO (Key); INC (Y, 2); INC (X, Size); Command: = (Command SHL 1) + 1 END ELSE BEGIN Dest ^ [Y]: = Kilde ^ [X]; INC (Y); INC (X); Command: = Command SHL en END; ende; {Size < = 16} INC (Bit); END; {Mens x < sourcesize ...} Command: = Command SHL (16-Bit); Dest ^ [Z]: = HI (Command); Dest ^ [Z + 1]: = LO (Command); IF (Y > SourceSize) da begynne MOVE (Kilde ^ [0], Dest ^ [1], SourceSize); Dest ^ [0]: = FLAG_Copied; Y: = SUCC (SourceSize) END; Resultat: = Y END; product: {dekomprimere en buffer på maks 32 KB} FUNKSJON Dekompresjon (Kilde, Mål: BufferPtr; SourceSize: buffer): buffer; VAR X, Y, Pos: BufferIndex; Command, Størrelse, K: WORD; Bit: BYTE; Savey: BufferIndex; {* Dh * utrygt for-loop variabel Y}
BEGIN IF (Kilde ^ [0] = FLAG_Copied) SÅ begynne FOR Y: = 1 TO PRED (SourceSize) MÅ begynne Dest ^ [PRED (Y)]: = Source ^ [Y]; Savey: = Y; ende; Y: = Savey; ende ELSE BEGIN Y: = 0; X: = 3; Command: = (Kilde ^ [1] SHL 8) + Kilde ^ [2]; Bit: = 16; MENS (X < SourceSize) DO BEGIN IF (Bit = 0), og start Command: = (Kilde ^ [X] SHL 8) + Kilde ^ [X + 1]; Bit: = 16; INC (X, 2) END; IF ((kommando og $ 8000) = 0), og start Dest ^ [Y]: = Kilde ^ [X]; INC (X); INC (Y) END ELSE BEGIN {kommando og $ 8000} Pos: = ((Kilde ^ [X] SHL 4) + (Kilde ^ [X + 1] SHR 4)); IF (Pos = 0), og start Størrelse: = (Kilde ^ [X + 1] SHL 8) + Kilde ^ [X + 2] + 15; FOR K: = 0 til størrelse MÅ begynne Dest ^ [Y + K]: = Kilde ^ [X + 3]; ende; INC (X, 4); INC (Y, størrelse + 1) END ELSE BEGIN {pos = 0} Størrelse: = (Kilde ^ [X + 1] og $ 0F) 2; FOR K: = 0 til størrelse DO Dest ^ [Y + K]: = Dest ^ [Y-Pos + K]; INC (X, 2); INC (Y, størrelse + 1) END; {Pos = 0} END; {Kommando og $ 8000} Command: = Command SHL 1; DEC (Bit) END {mens x < sourcesize} END; Resultat: = Y END; {Dekompresjon} product: {Unit " Finalization " som Delphi 2.0 ville ha det}
Var ExitSave: Pointer;
Prosedyre Opprydding; langt; begynne ExitProc: = ExitSave; if (Hash < > Nil) så FreeMem (Hash, sizeof (hashtabellen)); end;
initialisering
Hash: = Nil; prøv Getmem (Hash, sizeof (hashtabellen)); bortsett Raise ELzrw1KHCompressor.Create ('LZRW1KH: nei minne for hash table'); ende; ExitSave: = ExitProc; ExitProc: =Cleanup; END.