Qrealm.com


LHARC

Komprimieren / Dekomprimieren LHA-Dateien in Pascal.

Anbieter: Haruhiko OKOMURA

(************************************************* *****************************)
(* *)
(* LH5.PAS *)
(* *)
(* Dieser Code Kompresse / Daten mit dem gleichen Algorithmus wie LHARC 2.x * dekomprimieren)
(* Es ist in etwa von der C-Quellcode des AR002 (eine C-Version eines * abgeleitet)
(* Untergruppe von LHARC durch Haruhiko Okomura geschrieben). *)
(* Der Algorithmus wurde von Haruhiko Okomura und Haruyasu Yoshizaki erstellt. *)
(* *)
(************************************************* *****************************)

PROGRAMM LH5;

{Schalten Bereichsprüfung - PFLICHT! und Stapelprüfung (zur Beschleunigung der Dinge)}
{$ B-, R-, S-}

{$ DEFINE versickern}
(*
HINWEIS:
LHARC verwendet eine "sickert" Aktualisierung der Lempel-Ziv-Strukturen.
Wenn Sie das durchsickert Methode verwenden, wird der Kompressor etwas schneller laufen,
mit ein wenig mehr Speicher und wird etwas weniger effizient sein als die
Standardmethode.
Sie können beide Verfahren zu wählen, und beachten Sie, dass der Decompressor nicht
durch diese Wahl beeinflusst und ist in der Lage, Daten, die von jedem dekomprimieren
der Verdichter.
*)

TYPE
PWord = ^ TWORD;
TWORD = ARRAY [0..32759] OF Integer;
PByte = ^ TByte;
TByte = ARRAY [0..65519] OF BYTE;

CONST
(*
HINWEIS:
Die folgenden Konstanten sind, um den von LHARC verwendeten Werte gesetzt.
Sie können drei von ihnen wie folgt ändern:

DICBIT: Lempel-Ziv Dictionnary Größe.
Senken dieser Konstante kann die Kompressionseffizienz senken viel!
Aber steigende sie (auf einem 32-Bit-Plattform nur, dh Delphi 2) nicht nachgeben
deutlich bessere Ergebnisse.
Wenn Sie DICBIT bis 15 oder mehr festgelegt, stellen Sie PBIT bis 5; und wenn Sie DICBIT bis 19 eingestellt
oder höher muss der NPT auf NP, auch.

WINBIT: Schiebefenstergröße.
Das Kompressionsverhältnis hängt viel von diesem Wert.
Sie können es auf 15 zu erhöhen, um bessere Ergebnisse auf große Dateien zu erhalten.
Ich empfehle dies zu tun, wenn Sie über genügend Speicher, es sei denn, Sie wollen, dass
Ihre Druckdaten bleiben mit LHARC kompatibel.
Auf einem 32-Bit-Plattform, können Sie es auf 16 zu erhöhen Mit einem größeren Wert wird
nur Zeit und Erinnerung.

BUFBIT: I / O-Puffergröße. Sie können es zu senken, um Speicherplatz zu sparen, oder erhöhen sie
um Platte zugegriffen wird.
*)

BITBUFSIZ = 16;
UCHARMAX = 255;

DICBIT = 13;
DICSIZ = 1 SHL DICBIT;

MATCHBIT = 8;
MAXMATCH = 1 SHL MATCHBIT;
THRESHOLD = 3;
PERCFLAG = $ 8000;

NC = (UCHARMAX + MAXMATCH + 2-THRESHOLD);
CBIT = 9;
Codebit = 16;

NP = DICBIT + 1;
NT = Codebit + 3;
PBIT = 4; {Log2 (NP)}
TBIT = 5; {Log2 (NT)}
NPT = NT; {Groß von NP und NT}

NUL = 0;
MAXHASHVAL = (3 * DICSIZ + (DICSIZ SHR 9 + 1) * UCHARMAX);

WINBIT = 14;
Window = 1 SHL WINBIT;

BUFBIT = 13;
BUFSIZE = 1 SHL BUFBIT;

VAR
OrigSize, CompSize: Longint;
INFILE, OutFile: Datei;

BitBuf: Wort;
n, HeapSize: Integer;
SubBitBuf, BITCOUNT: Wort;

Buffer: ARRAY [0..PRED (BUFSIZE)] OF BYTE;
BufPtr: Wort;

Links, Rechts: ARRAY [0..2 * (NC-1)] von Word;

PtTable: ARRAY [0..255] OF Wort;
PtLen: ARRAY [0..PRED (NVV)] OF BYTE;
CTable: ARRAY [0..4095] OF Wort;
CLen: ARRAY [0..PRED (NC)] OF BYTE;

Blocksize: Wort;

{Die folgenden Variablen werden von der Kompressions-Engine verwendet nur}

Heap: ARRAY [0..NC] OF Wort;
LenCnt: ARRAY [0..16] OF Wort;

Freq, SortPtr: PWord;
Len: PByte;
Tiefe: Wort;

Buf: PByte;

CFREQ: ARRAY [0..2 * (NC-1)] von Word;
PFREQ: ARRAY [0..2 * (NP-1)] von Word;
TFreq: ARRAY [0..2 * (NT-1)] von Word;

BuKr: ARRAY [0..PRED (NC)] OF Wort;
PtCode: ARRAY [0..PRED (NVV)] OF Wort;

CPO, OutputPos, OutputMask: Wort;
Text, Child: PByte;

Pos, MatchPos, Avail: Wort;
Position, Eltern, Prev, Next: PWord;

Rest, MatchLen: Integer;
Level: PByte;

{********************************** Datei-I / O *********** ***********************}

FUNKTION getc: Byte;
START
IF BufPtr = 0 THEN
Blockread (INFILE, Puffer, BUFSIZE);
Getc: = Buffer [BufPtr]; BufPtr: = SUCC (BufPtr) UND PRED (BUFSIZE);
ENDE;

VERFAHREN putc (c: Byte);
START
IF BufPtr = BUFSIZE THEN
START
Blockwrite (OutFile, Puffer, BUFSIZE); BufPtr: = 0;
ENDE;
Buffer [BufPtr]: = C; INC (BufPtr);
ENDE;

FUNKTION Brot (p: POINTER; n: Integer): Integer;
START
Blockread (INFILE, p ^, n, n);
Brot: = n;
ENDE;

VERFAHREN bWrite (p: POINTER; n: Integer);
START
Blockwrite (OutFile, p ^, n);
ENDE;

{**************************** Bit Behandlungsroutinen ****************** *********}

VERFAHREN FillBuf (n: Integer);
START
BitBuf: = (BitBuf SHL n);
WÄHREND n> BITCOUNT DO BEGIN
Dezember (n, BITCOUNT);
BitBuf: = BitBuf OR (SubBitBuf SHL n);
IF (CompSize <> 0) THEN
START
Dezember (CompSize); SubBitBuf: = getc;
END ELSE
SubBitBuf: = 0;
BITCOUNT: = 8;
ENDE;
Dec (BITCOUNT, n);
BitBuf: = BitBuf OR (SubBitBuf SHR BITCOUNT);
ENDE;

FUNKTION GetBITS (n: Integer): Wort;
START
GetBITS: = BitBuf SHR (BITBUFSIZ-n);
FillBuf (n);
ENDE;

VERFAHREN PutBits (n: Integer; x: Word);
START
WENN DANN n0
HALT (1);
jutbits: = 16-TableBits;
FOR i: = 1 TO DO TableBits
START
Start [i]: = Start [i] SHR jutbits; Gewicht [i]: = 1 SHL (TableBits-i);
ENDE;
i: = SUCC (TableBits);
WÄHREND (i <= 16) do begin
Gewicht [i]: = 1 SHL (16-i); INC (i);
ENDE;
i: = start [SUCC (TableBits)] SHR jutbits;
IF i <> 0 THEN
START
K: = 1 SHL TableBits;
Während ich <> k DO BEGIN
Tabelle ^ [i]: = 0; INC (i);
ENDE;
ENDE;
Avail: = nchar, Maske: = 1 SHL (15-TableBits);
CH: = 0 TO PRED (nchar) DO
START
Len: = BITLEN ^ [ch];
Ist len ​​gleich 0 THEN
WEITER;
k: = start [Len];
nextCode: = k + Gewicht [Len];
Ist len ​​<= TableBits THEN
START
FOR i: = k TO PRED (nextCode) DO
Tabelle ^ [i]: = CH;
END ELSE BEGIN
p: = Addr (Tabelle ^ [k SHR jutbits]); i: = Len-TableBits;
Während ich <> 0 DO BEGIN
IF p ^ [0] = 0 THEN
START
Recht [Avail]: = 0; links [LZ]: = 0; p ^ [0]: = Avail, INC (Avail);
ENDE;
IF (k UND Maske) <> 0 THEN
p: = addr (rechts [p ^ [0]])
ELSE
p: = addr (links [p ^ [0]]);
k: = k SHL 1, Dec (i);
ENDE;
p ^ [0]: = ch;
ENDE;
start [Len]: = nextCode;
ENDE;
ENDE;

VERFAHREN ReadPtLen (nn, nBit, iSpecial: Integer);
VAR
i, c, n: Integer;
Maske: Wort;
START
n: = GetBITS (nBit);
Falls n = 0 THEN
START
c: = GetBITS (nBit);
FOR i: = 0 TO PRED (nn) DO
PtLen [i]: = 0;
FOR i: = 0 bis 255 DO
PtTable [i]: = c;
END ELSE BEGIN
i: = 0;
WHILE (i0 DO BEGIN
Maske: Maske = SHR 1; INC (c);
ENDE;
ENDE;
IF c <7 THEN
FillBuf (3)
ELSE
FillBuf (c-3);
PtLen [i]: = c; INC (i);
IF i = iSpecial THEN
START
c: = PRED (GetBITS (2));
WÄHREND c> = 0 DO BEGIN
PtLen [i]: = 0; INC (i); Dec (c);
ENDE;
ENDE;
ENDE;
WÄHREND i = NT THEN
START
Maske: = 1 SHL (BITBUFSIZ-9);
REPEAT
IF (BitBuf UND Maske) <> 0 THEN
c: = right [c]
ELSE
c: = left [c];
Maske: Maske = SHR 1;
BIS c = 0 DO BEGIN
CLen [i]: = 0; INC (i); Dec (c);
ENDE;
END ELSE BEGIN
CLen [i]: = c-2; INC (i);
ENDE;
ENDE;
WÄHREND i = NC THEN
START
Maske: = 1 SHL (BITBUFSIZ-13);
REPEAT
IF (BitBuf UND Maske) <> 0 THEN
j: = right [j]
ELSE
j: = left [j];
Maske: Maske = SHR 1;
BIS j = NP THEN
START
Maske: = 1 SHL (BITBUFSIZ-9);
REPEAT
IF (BitBuf UND Maske) <> 0 THEN
j: = right [j]
ELSE
j: = left [j];
Maske: Maske = SHR 1;
ERST DANN j0
START
Dec (j); j: = (1 SHL j) + GetBITS (j);
ENDE;
DecodeP: = j;
ENDE;

{Als statisch deklariertes vars}
VAR
decode_i: Wort;
decode_j: Integer;

VERFAHREN DecodeBuffer (count: Wort; Puffer: PByte);
VAR
c, r: Wort;
START
r: = 0; Dec (decode_j);
WHILE (decode_j> = 0) do begin
Buffer ^ [r]: = Buffer ^ [decode_i]; decode_i: = SUCC (decode_i) UND PRED (DICSIZ);
INC (r);
IF r = Zählung THEN
AUSGANG;
Dezember (decode_j);
ENDE;
WÄHREND TRUE DO BEGIN
c: = DecodeC;
IF c <= UCHARMAX THEN
START
Puffer ^ [r]: = c; INC (r);
IF r = Zählung THEN
AUSGANG;
END ELSE BEGIN
decode_j: = c- (UCHARMAX + 1-THRESHOLD);
decode_i: = (r-DecodeP-1) und PRED (DICSIZ);
Dezember (decode_j);
WÄHREND decode_j> = 0 DO BEGIN
Buffer ^ [r]: = Buffer ^ [decode_i];
decode_i: = SUCC (decode_i) UND PRED (DICSIZ);
INC (r);
IF r = Zählung THEN
AUSGANG;
Dezember (decode_j);
ENDE;
ENDE;
ENDE;
ENDE;

VERFAHREN Decode;
VAR
p: PByte;
l: Longint;
a: Wort;
START
{Initialisierung Decoder Variablen}
GetMem (p, DICSIZ);
InitGetBits; Blocksize: = 0;
decode_j: = 0;
{Überspringen Dateigröße}
l: = OrigSize; Dezember (compSize, 4);
{Entpackt die Datei}
WÄHREND l> 0 DO BEGIN
IF l> DICSIZ THEN
a: = DICSIZ
ELSE
a: = l;
DecodeBuffer (a, p);
BWrite (p, a); Dec (l, a);
ENDE;
FreeMem (p, DICSIZ);
ENDE;

{********************************* Compression *************** *****************}

{-------------------------------- Huffman Teil --------------- -----------------}

VERFAHREN CountLen (i: Integer);
START
WENN SIE i0 BEGIN
Dezember (LenCnt [16]);

FOR i: = 15 DOWNTO 1 DO
IF LenCnt [i] <> 0 THEN
START
Dec (LenCnt [i]); INC (LenCnt [SUCC (i)], 2);
BREAK;
ENDE;
Dezember (cum);
ENDE;
FOR i: = 16 DOWNTO 1 DO BEGIN
k: = PRED (LenCnt [i]);
WÄHREND k> = 0 DO BEGIN
Dec (k); Len ^ [SortPtr ^ [0]]: = i;
ASM
ADD WORD PTR SortPtr, 2; {SortPtr: = addr (SortPtr ^ [1]);}
ENDE;
ENDE;
ENDE;
ENDE;

VERFAHREN downheap (i: Integer);
VAR
j, k: Integer;
START
k: = Heap [i]; j: = i SHL 1;
WHILE (j <= HeapSize) DO BEGIN
IF (jFreq ^ [Heap [SUCC (j)]]) DANN ZV (j);
IF Freq ^ [k] <= Freq ^ [Heap [j]] THEN zu brechen;
Heap [i]: = Heap [j]; i: = j; j: = i SHL 1;
ENDE;
Heap [i]: = k;
ENDE;

VERFAHREN Makecode (n: Integer; Len: PByte; Code: PWord);
VAR
i, k: Integer;
Start: ARRAY [0..17] OF Wort;
START
Starten [1]: = 0;
FOR i: = 1 TO DO 16
start [SUCC (i)]: = (Start [i] + LenCnt [i]) SHL 1;
FOR i: = 0 TO PRED (n) DO BEGIN
k: = Len ^ [i];
Code ^ [i]: = start [k];
INC (Start [k]);
ENDE;
ENDE;

FUNKTION MakeTree (NParm: Integer; Freqparm: PWord; LenParm: PByte; Codeparm: PWord): Integer;
VAR
i, j, k, Avail: Integer;
START
n: = NParm, Freq: = Freqparm; Len: = LenParm; Avail: = n; HeapSize: = 0; Heap [1]: = 0;
FOR i: = 0 TO PRED (n) DO BEGIN
Len ^ [i]: = 0;
IF Freq ^ [i] <> 0 THEN
START
INC (HeapSize); Heap [HeapSize]: = i;
ENDE;
ENDE;
IF HeapSize <2 THEN
START
Codeparm ^ [Heap [1]]: = 0; MakeTree: = Heap [1];
AUSGANG;
ENDE;
FOR i: = (HeapSize div 2) DOWNTO 1 DO downheap (i);
SortPtr: = Codeparm;
REPEAT
i: = Heap [1];
IF i0) und (CLen [PRED (n)] = 0) DO
Dec (n);
i: = 0;
WHILE i0) und (PtLen [PRED (n)] = 0) DO
Dec (n);
PutBits (nBit, n); i: = 0;
WHILE (i0) und (CLen [PRED (n)] = 0) DO
Dec (n);
PutBits (CBIT, n); i: = 0;
WHILE (i0 DO BEGIN
q: = q SHR 1; INC (c);
ENDE;
PutBits (PtLen [c], PtCode [c]);
IF c> 1 THEN
PutBits (PRED (c) p und ($ FFFF SHR (17-c)));
ENDE;

VERFAHREN Sendblock;
VAR
i, k, Fahnen, Wurzel, Pos, Größe: Wort;
START
root: = MakeTree (NC, @ CFREQ, @ CLen, @ BuKr);
Größe: = CFREQ [root];
PutBits (16, Größe);
IF root> = NC THEN
START
CountTFreq;
root: = MakeTree (NT, @ TFreq, @ PtLen, @ PtCode);
IF root> = NT THEN
WritePtLen (NT, TBIT, 3)
ELSE
START
PutBits (TBIT, 0);
PutBits (TBIT, root);
ENDE;
WriteCLen;
END ELSE BEGIN
PutBits (TBIT, 0);
PutBits (TBIT, 0);
PutBits (CBIT, 0);
PutBits (CBIT, root);
ENDE;
root: = MakeTree (NP, @ PFREQ, @ PtLen, @ PtCode);
IF root> = NP THEN
WritePtLen (NP, PBIT, -1)
ELSE
START
PutBits (PBIT, 0);
PutBits (PBIT, root);
ENDE;
Pos: = 0;
FOR i: = 0 TO PRED (Größe) DO BEGIN
IF (i UND 7) = 0 THEN
START
Fahnen: = Buf ^ [Pos], INC (Pos);
END ELSE
Fahnen: = Fahnen SHL 1;
IF (Fahnen und (1 SHL 7)) <> 0 THEN
START
k: = Buf ^ [pos] + (1 SHL 8); INC (Pos); EncodeC (k);
k: = Buf ^ [pos] SHL 8; INC (Pos); INC (k, Buf ^ [pos]); INC (Pos); EncodeP (k);
END ELSE BEGIN
k: = Buf ^ [pos]; INC (Pos); EncodeC (k);
ENDE;
ENDE;
FOR i: = 0 TO PRED (NC) DO
CFREQ [i]: = 0;
FOR i: = 0 TO PRED (NP) DO
PFREQ [i]: = 0;
ENDE;

VERFAHREN Ausgang (c, p: Word);
START
OutputMask: = OutputMask SHR 1;
IF OutputMask = 0 THEN
START
OutputMask: = 1 SHL 7;
IF (OutputPos> = Window-24) THEN
START
Sendblock; OutputPos: = 0;
ENDE;
CPOS: = OutputPos; INC (OutputPos); Buf ^ [CPOS]: = 0;
ENDE;
Buf ^ [OutputPos]: = c; INC (OutputPos), INC (CFREQ [c]);
IF c> = (1 SHL 8) THEN
START
Buf ^ [CPOS]: = Buf ^ [CPOS] ODER OutputMask;
Buf ^ [OutputPos]: = (p SHR ​​8); INC (OutputPos);
Buf ^ [OutputPos]: = p; INC (OutputPos), c: = 0;
WÄHREND p <> 0 DO BEGIN
p: = p SHR ​​1; INC (c);
ENDE;
INC (PFREQ [c]);
ENDE;
ENDE;

{------------------------------- Lempel-Ziv Teil -------------- ----------------}

VERFAHREN InitSlide;
VAR
i: Wort;
START
FOR i: = DICSIZ TO (DICSIZ + UCHARMAX) DO BEGIN
Ebene ^ [i]: = 1;
{$ IFDEF versickern}
Position ^ [i]: = NUL;
{$ ENDIF}
ENDE;
FOR i: = DICSIZ TO PRED (2 * DICSIZ) DO
Eltern ^ [i]: = NUL;
Avail: = 1;
FOR i: = 1 TO DICSIZ-2 DO
Nächste ^ [i]: = SUCC (i);
Nächste ^ [PRED (DICSIZ)]: = NUL;
FOR i: = (2 * DICSIZ) TO DO MAXHASHVAL
Nächste ^ [i]: = NUL;
ENDE;

{Hash-Funktion}
FUNKTION Hash (p: Integer; c: Byte): Integer;
START
Raute: = p + (c SHL (DICBIT-9)) + 2 * DICSIZ;
ENDE;

FUNKTION Child (q: Integer; c: Byte): Integer;
VAR
r: Integer;
START
r: = Next ^ [Hash (q, c)]; Eltern ^ [NUL]: = q;
WÄHREND Eltern ^ [r] <> q DO
r: = Next ^ [r];
Kinder: = r;
ENDE;

VERFAHREN MakeChild (q: Integer; c: Byte; r: Integer);
VAR
h, t: Integer;
START
h: = Hash (q, c);
t: = Next ^ [h]; Next ^ [h]: = r; Next ^ [r]: = t;
Zurück ^ [t]: = r; Zurück ^ [r]: = h; Eltern ^ [r]: = q;
INC (Child ^ [q]);
ENDE;

VERFAHREN Split (alt: Integer);
VAR
neue, t: Integer;
START
neu: = Avail; Avail: = Next ^ [neu];
Child ^ [neu]: = 0;
t: = Zurück ^ [alt]; Zurück ^ [neu]: = t;
Nächste ^ [t]: = new;
t: = Next ^ [alt]; Next ^ [neu]: = t;
Zurück ^ [t]: = new;
Eltern ^ [neu]: = Eltern ^ [alt];
Stufe ^ [neu]: = MatchLen;
Position ^ [neu]: = Pos;
MakeChild (neue, Text ^ [MatchPos + MatchLen] alt);
MakeChild (neue, Text ^ [Pos + MatchLen], Pos);
ENDE;

VERFAHREN InsertNode;
VAR
q, r, j, t: Integer;
c: Byte;
t1, t2: PChar;
START
IF MatchLen> = 4 THEN
START
Dezember (MatchLen);
r: = SUCC (MatchPos) ODER DICSIZ;
q: = Eltern ^ [r];
WÄHREND q = NUL DO BEGIN
r: = Next ^ [r]; q: = Eltern ^ [r];
ENDE;
WÄHREND Ebene ^ [q]> = MatchLen DO BEGIN
r: = q, q: = Eltern ^ [q];
ENDE;
t: = q;
{$ IFDEF versickern}
WÄHREND Position ^ [t] <0 DO BEGIN
Position ^ [t]: = Pos; t: = Eltern ^ [t];
ENDE;
IF t = DICSIZ THEN
START
j: = MAXMATCH; MatchPos: = r;
END ELSE BEGIN
j: = Level ^ [r]; MatchPos: = Position ^ [r] AND NOT PERCFLAG;
ENDE;
IF MatchPos> = Pos THEN
Dezember (MatchPos, DICSIZ);
t1: = addr (Text ^ [Pos + MatchLen]); t2: = addr (Text ^ [MatchPos + MatchLen]);
WÄHREND MatchLent2 ^ THEN
START
Split (r);
AUSGANG;
ENDE;
INC (MatchLen); INC (t1); INC (t2);
ENDE;
IF MatchLen> = MAXMATCH THEN
BREAK;
Position ^ [r]: = Pos; q: = r;
r: = Child (q, ORD (t1 ^));
IF r = NUL THEN
START
MakeChild (q, ORD (t1 ^), Pos);
AUSGANG;
ENDE;
INC (MatchLen);
ENDE;
t: = Zurück ^ [r]; Zurück ^ [Pos]: = t; Next ^ [t]: = Pos;
t: = Next ^ [r]; Next ^ [Pos]: = t; Zurück ^ [t]: = Pos;
Eltern ^ [Pos]: = q; Eltern ^ [r]: = NUL; Next ^ [r]: = Pos;
ENDE;

VERFAHREN DeleteNode;
VAR
r, s, t, u: Integer;
{$ IFDEF versickern}
q: Integer;
{$ ENDIF}
START
IF Eltern ^ [Pos] = NUL THEN
AUSGANG;
r: = Zurück ^ [Pos]; s: = Next ^ [Pos]; Next ^ [r]: = s; Zurück ^ [s]: = r;
r: = Eltern ^ [Pos]; Eltern ^ [Pos]: = NUL, Dezember (Child ^ [r]);
(Child ^ [r]> 1) IF (r> = DICSIZ) ODER THEN
AUSGANG;
{$ IFDEF versickern}
t: = Position ^ [r] AND NOT PERCFLAG;
{$ ELSE}
t: = Position ^ [r];
{$ ENDIF}
IF t> = Pos THEN
Dec (t, DICSIZ);
{$ IFDEF versickern}
s: = t, q: = Eltern ^ [r]; u: = Position ^ [q];
WÄHREND (u UND PERCFLAG) <> 0 DO BEGIN
u: = u AND NOT PERCFLAG;
IF u> = Pos THEN
Dezember (u, DICSIZ);
IF u> s THEN
s: = u;
Position ^ [q]: = s ODER DICSIZ; q: = Eltern ^ [q]; u: = Position ^ [q];
ENDE;
IF q = Pos THEN
Dezember (u, DICSIZ);
IF u> s THEN
s: = u;
Position ^ [q]: = s ODER DICSIZ ODER PERCFLAG;
ENDE;
{$ ENDIF}
s: = Child (r, Text ^ [t + Level ^ [r]]);
t: = Zurück ^ [s]; u: = Next ^ [s]; Next ^ [t]: = u; Zurück ^ [u]: = t;
t: = Zurück ^ [r]; Next ^ [t]: = s; Zurück ^ [s]: = t;
t: = Next ^ [r]; Zurück ^ [t]: = s; Next ^ [s]: = t;
Eltern ^ [s]: = Eltern ^ [r]; Eltern ^ [r]: = NUL;
Nächste ^ [r]: = Avail; Avail: = r;
ENDE;

VERFAHREN GetNextMatch;
VAR
n: Integer;
START
Dezember (Rest), INC (Pos);
IF Pos = 2 * DICSIZ THEN
START
bewegen (Text ^ [DICSIZ], Text ^ [0], DICSIZ + MAXMATCH);
n: = Brot (Adr (Text ^ [DICSIZ + MAXMATCH]), DICSIZ);
INC (Rest, n); Pos: = DICSIZ;
ENDE;
DeleteNode; InsertNode;
ENDE;

VERFAHREN Encode;
VAR
LastMatchLen, LastMatchPos: Integer;
START
{Initialize Encoder Variablen}
GetMem (Text, 2 * DICSIZ + MAXMATCH);
GetMem (Stufe, DICSIZ + UCHARMAX + 1);
GetMem (Child, DICSIZ + UCHARMAX + 1);
{$ IFDEF versickern}
GetMem (Position, (DICSIZ + UCHARMAX + 1) SHL 1);
{$ ELSE}
GetMem (Position, (DICSIZ) SHL 1);
{$ ENDIF}
GetMem (Eltern, (DICSIZ * 2) SHL 1);
GetMem (Zurück, (DICSIZ * 2) SHL 1);
GetMem (nächstes (MAXHASHVAL + 1) SHL 1);

Tiefe: = 0;
InitSlide;
GetMem (Buf, Window);
Buf ^ [0]: = 0;
FillChar (CFREQ, sizeof (CFREQ), 0);
FillChar (PFREQ, sizeof (PFREQ), 0);
OutputPos: = 0; OutputMask: = 0; InitPutBits;
Rest: = Brot (Adr (Text ^ [DICSIZ]), DICSIZ + MAXMATCH);
MatchLen: = 0; Pos: = DICSIZ; InsertNode;
IF MatchLen> Rest THEN
MatchLen: = Rest;
WÄHREND Rest> 0 DO BEGIN
LastMatchLen: = MatchLen; LastMatchPos: = MatchPos; GetNextMatch;
IF MatchLen> Rest THEN
MatchLen: = Rest;
IF (MatchLen> LastMatchLen) OR (LastMatchLen0 DO BEGIN
GetNextMatch; Dezember (LastMatchLen);
ENDE;
IF MatchLen> Rest THEN
MatchLen: = Rest;
ENDE;
ENDE;
{Flush buffers}
Sendblock; PutBits (7,0);
IF BufPtr <> 0 THEN
Blockwrite (OutFile, Puffer, BufPtr);

FreeMem (Buf, Window);
FreeMem (nächstes (MAXHASHVAL + 1) SHL 1);
FreeMem (Zurück, (DICSIZ * 2) SHL 1);
FreeMem (Eltern, (DICSIZ * 2) SHL 1);
{$ IFDEF versickern}
FreeMem (Position, (DICSIZ + UCHARMAX + 1) SHL 1);
{$ ELSE}
FreeMem (Position, (DICSIZ) SHL 1);
{$ ENDIF}
FreeMem (Child, DICSIZ + UCHARMAX + 1);
FreeMem (Stufe, DICSIZ + UCHARMAX + 1);
FreeMem (Text, 2 * DICSIZ + MAXMATCH);
ENDE;

{******************************** Hauptprogramm *************** *****************}

START
IF NOT (ParamCount IN [2..3]) THEN
START
Writeln ('Anwendung:');
Writeln ('Um infile outfile zu komprimieren: LH5 infile outfile');
Writeln ('So erweitern infile in outfile: LH5 infile outfile E');
HALT;
ENDE;
BufPtr: = 0;
Zuordnen (INFILE, ParamStr (1)), Reset (INFILE, 1);
Vergeben (OutFile, ParamStr (2)); Rewrite (OutFile, 1);
IF ParamCount = 2 THEN
START
OrigSize: = Filesize (INFILE);
CompSize: = 0;
Blockwrite (OutFile, OrigSize, 4);
Kodieren;
END ELSE BEGIN
CompSize: = Filesize (INFILE);
Blockread (INFILE, OrigSize, 4);
Zu decodieren;
ENDE;
Schließen (INFILE) Close (OutFile);
ENDE.


In Verbindung stehende Artikel