home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 01 / leser / lzhuf.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-10-09  |  20.1 KB  |  662 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    LZHUF.PAS                           *)
  3. (*       Verschlüsseln und Packen von Daten mit dem       *)
  4. (*                 Huffman-Algorithmus                    *)
  5. (*         Update 10/90: Beseitigung einiger Bugs         *)
  6. (*            (c) 1990 Ralf Hensmann & TOOLBOX            *)
  7. (* ------------------------------------------------------ *)
  8. PROGRAM LZHuf;
  9.  
  10. TYPE
  11.   CARDINAL = WORD;
  12.  
  13. VAR
  14.   InBuffer, OutBuffer : ARRAY [0..2051] OF BYTE;
  15.   InBufP,   OutBufP   : 0..2050;
  16.   InBitP,   OutBitP   : 0..8;
  17.   InFile,   OutFile   : FILE;
  18.   MaxIn               : INTEGER;
  19.   test                : TEXT;
  20.   ReadBuf, WriteBuf   : ARRAY [0..2048] OF BYTE;
  21.   ReadPtr, WritePtr,
  22.   ReadMax             : INTEGER;
  23.  
  24.   (* ----- Hilfsfunktionen zum Lesen von Bits ----------- *)
  25.  
  26.   FUNCTION BufRead : BYTE;
  27.   BEGIN
  28.     IF ReadPtr = ReadMax THEN BEGIN
  29.       BlockRead(InFile, ReadBuf, 2048, ReadMax);
  30.       ReadPtr := 0;
  31.     END;
  32.     BufRead := ReadBuf[ReadPtr];
  33.     Inc(ReadPtr);
  34.   END;
  35.  
  36.   PROCEDURE BufWrite(B : BYTE);
  37.   VAR
  38.    written : CARDINAL;
  39.   BEGIN
  40.     IF WritePtr = 2048 THEN BEGIN
  41.       Blockwrite(OutFile, WriteBuf, 2048, written);
  42.       IF written <> 2048 THEN BEGIN
  43.         WriteLn('Kein Platz');
  44.         Halt;
  45.       END;
  46.       WritePtr := 0;
  47.     END;
  48.     WriteBuf[WritePtr] := B;
  49.     Inc(WritePtr);
  50.   END;
  51.  
  52.   PROCEDURE BufFlush;
  53.   VAR
  54.     written : CARDINAL;
  55.   BEGIN
  56.     Blockwrite(OutFile, WriteBuf, WritePtr, written);
  57.     IF written <> WritePtr THEN BEGIN
  58.       WriteLn('Kein Platz');
  59.       Halt;
  60.     END;
  61.     WritePtr := 0;
  62.   END;
  63.  
  64.   PROCEDURE PutCode(Bits : CARDINAL; Len : CARDINAL);
  65.   VAR
  66.     hilf : CARDINAL;
  67.   BEGIN
  68.       (* unbenutzte Bits löschen *)
  69.     Bits := Bits AND ($FFFF SHL(16 - Len));
  70.       (* wenn notwendig, Flush *)
  71.     IF OutBufP >= 2048 THEN BEGIN
  72.       BlockWrite(OutFile, OutBuffer, 2048, hilf);
  73.       IF hilf <> 2048 THEN BEGIN
  74.         WriteLn('Schreibfehler: Platte ist voll');
  75.         Halt;
  76.       END;
  77.       FOR hilf := 2048 TO OutBufP DO
  78.         OutBuffer[hilf-2048] := OutBuffer[hilf];
  79.       Dec(OutBufP, 2048);
  80.     END;
  81.     IF OutBitP + Len > 16 THEN
  82.       OutBuffer[OutBufP + 2] := Hi(Bits SHL(16 - OutBitP));
  83.     IF OutBitP > 0 THEN
  84.       Bits := (Bits SHR OutBitP) OR
  85.               (OutBuffer[OutBufP] SHL 8);
  86.     OutBuffer[OutBufP]   := Hi(Bits);
  87.     OutBuffer[OutBufP+1] := Lo(Bits);
  88.     Inc(OutBufP, (OutBitP + Len) SHR 3);
  89.     OutBitP := (OutBitP + Len) AND 7;
  90.   END;
  91.  
  92.   PROCEDURE FlushCode;
  93.   VAR
  94.     written : CARDINAL;
  95.   BEGIN
  96.     IF OutBitP > 0 THEN Inc(OutBufP);
  97.     BlockWrite(OutFile, OutBuffer, OutBufP, written);
  98.     IF written <> OutBufP THEN BEGIN
  99.       WriteLn('Platte ist voll');
  100.       Halt;
  101.     END;
  102.   END;
  103.  
  104.   FUNCTION GetBit : BYTE;
  105.   BEGIN
  106.     IF InBitP = 8 THEN BEGIN
  107.       InBitP := 0;
  108.       Inc(InBufP);
  109.     END;
  110.     IF (InBufP > MaxIn) THEN BEGIN
  111.       BlockRead(InFile, InBuffer, 2048, MaxIn);
  112.       Dec(MaxIn);
  113.       InBufP := 0;
  114.     END;
  115.     Inc(InBitP);
  116.     GetBit := InBuffer[InBufP] SHR (8 - InBitP) AND 1;
  117.   END;
  118.  
  119.   FUNCTION GetByte : BYTE;
  120.   VAR
  121.     HilfB : BYTE;
  122.   BEGIN
  123.     HilfB := LO( CARDINAL(InBuffer[InBufP]) SHL InBitP);
  124.     Inc(InBufP);
  125.     IF InBufP > MaxIn THEN BEGIN
  126.       BlockRead(InFile, InBuffer, 2048, MaxIn);
  127.       Dec(MaxIn);
  128.       InBufP := 0;
  129.     END;
  130.     GetByte := HilfB OR InBuffer[InBufP] SHR (8 - InBitP);
  131.   END;
  132.  
  133.   (* ----- Multiple Binary Trees ------------------------ *)
  134.  
  135. CONST
  136.   BufMax    = 4096;            (* Puffergröße             *)
  137.   LookAhead = 60;              (* vorausschauender Puffer *)
  138.   ThresHold = 2;               (* Minimaler Wert für LZSS *)
  139.   NUL       = BufMax;          (* Null-Zeiger             *)
  140.   TextMax   = BufMax + LookAhead - 1;
  141.  
  142. VAR
  143.   TextBuf   : ARRAY [0..TextMax] OF BYTE;   (* Textpuffer *)
  144.   LSon, Dad : ARRAY [0..BufMax] OF CARDINAL;  (* "Zeiger" *)
  145.   RSon      : ARRAY [0..BufMax+256] OF CARDINAL;
  146.          (* "Zeiger" - die oberen Elemente sind die Root- *)
  147.          (* Zeiger der einzelnen Zeichen                  *)
  148.   MatchPos,
  149.   MatchLen  : CARDINAL;
  150.                     (* Pos. und Länge des besten Matching *)
  151.  
  152.   PROCEDURE InitTree;      (* Initialisiert den Binärbaum *)
  153.   VAR
  154.     i : CARDINAL;
  155.   BEGIN
  156.                             (* Root-Zeiger auf NUL setzen *)
  157.     FOR i := BufMax + 1 TO BufMax + 256 DO
  158.       RSon[i] := NUL;
  159.                             (* Zeiger der Tabelle löschen *)
  160.     FOR i := 0 TO BufMax - 1 DO
  161.       Dad[i] := NUL;
  162.   END;
  163.  
  164.   PROCEDURE InsertNode(pos : CARDINAL);
  165.                  (* Fügt String an Stelle pos in Baum ein *)
  166.   VAR
  167.     cmp     : INTEGER;     (* Vergleich der Zeichenketten *)
  168.     i, hilf : CARDINAL;
  169.     node    : CARDINAL;    (* gerade untersuchter Knoten  *)
  170.   BEGIN
  171.     node := TextBuf[pos] + BufMax+1;  (* Wurzel des Baums *)
  172.     RSon[pos] := NUL;                 (* Zeiger "erden"   *)
  173.     LSon[pos] := NUL;
  174.     MatchLen  := 0;
  175.     cmp       := 1;              (* Root steht in RSon... *)
  176.     REPEAT
  177.                                  (* Knoten weiterbewegen  *)
  178.       IF cmp >= 0 THEN
  179.         IF RSon[node] <> NUL THEN
  180.           node := RSon[node]       (* Wurzel weitersetzen *)
  181.         ELSE BEGIN
  182.            (* Baumende ist erreicht, Element hier anfügen *)
  183.           RSon[node] := pos;
  184.           Dad[pos]   := node;
  185.           Exit;
  186.         END
  187.       ELSE IF LSon[node] <> NUL THEN
  188.         node := LSon[node]         (* Wurzel weitersetzen *)
  189.       ELSE BEGIN
  190.            (* Baumende ist erreicht, Element hier anfügen *)
  191.         LSon[node] := pos;
  192.         Dad[pos]   := node;
  193.         Exit;
  194.       END;
  195.         (* Knoten mit Element vergleichen *)
  196.       i := 1;
  197.       REPEAT
  198.         cmp := INTEGER(TextBuf[pos + i]) - TextBuf[node +i];
  199.         IF cmp = 0 THEN Inc(i);
  200.       UNTIL (i >= LookAhead) OR (cmp <> 0);
  201.  
  202.         (* i enthält die Anzahl der gleichen Zeichen ... *)
  203.       IF i > ThresHold THEN BEGIN
  204.         IF (i > MatchLen) THEN BEGIN
  205.             (* neue Position *)
  206.           MatchPos := (pos - node) AND (BufMax - 1) - 1;
  207.           MatchLen := i;
  208.         END;
  209.         IF (i = MatchLen) AND (i < LookAhead) THEN BEGIN
  210.           hilf := (pos - node) AND (BufMax - 1) - 1;
  211.           IF hilf < MatchPos THEN
  212.             MatchPos := hilf;
  213.         END;
  214.       END;
  215.     UNTIL (MatchLen >= LookAhead);
  216.               (* Sonderfall: node wird durch pos ersetzt, *)
  217.               (*             da beide gleich sind.        *)
  218.     Dad[pos]  := Dad[node];
  219.     LSon[pos] := LSon[node];
  220.     RSon[pos] := RSon[node];
  221.     Dad[LSon[node]] := pos;
  222.     Dad[RSon[node]] := pos;
  223.     IF RSon[Dad[node]] = node THEN
  224.       RSon[Dad[node]] := pos
  225.     ELSE
  226.       LSon[Dad[node]] := pos;
  227.     Dad[node] := NUL;      (* node als gelöscht eintragen *)
  228.   END;
  229.  
  230.   PROCEDURE DeleteNode(pos : CARDINAL);
  231.   VAR
  232.     node : CARDINAL;
  233.   BEGIN
  234.     IF Dad[pos]  = NUL THEN Exit;     (* bereits gelöscht *)
  235.     IF RSon[pos] = NUL THEN
  236.       node := LSon[pos]
  237.     ELSE IF LSon[pos] = NUL THEN
  238.       node := RSon[pos]
  239.     ELSE BEGIN
  240.       node := LSon[pos];
  241.       IF RSon[node] <> NUL THEN BEGIN
  242.         (* Unterstes rechtes Element suchen und vor den   *)
  243.         (* linken Ast hängen                              *)
  244.         REPEAT
  245.           node := RSon[node];
  246.         UNTIL RSon[node] = NUL;
  247.         RSon[Dad[node]] := LSon[node];
  248.         Dad[LSon[node]] := Dad[node];
  249.         LSon[node]      := LSon[pos];
  250.         Dad[LSon[pos]]  := node;
  251.       END;
  252.       RSon[node]     := RSon[pos];
  253.       Dad[RSon[pos]] := node;
  254.     END;
  255.       (* node enthält nun das Element, um pos zu ersetzen *)
  256.     Dad[node] := Dad[pos];
  257.     IF RSon[Dad[pos]] = pos THEN
  258.       RSon[Dad[pos]] := node
  259.     ELSE
  260.       LSon[Dad[pos]] := node;
  261.     Dad[pos] := NUL;
  262.   END;
  263.  
  264.   (* ----- Positionstabellen für LZSS ------------------- *)
  265.   (* Tabellen zur Ver- und Entschlüsselung der ersten     *)
  266.   (* 6 Bit in ein Alphabet mit variablen Längen, da       *)
  267.   (* kleinere 6-Bit-Werte sehr viel häufiger auftauchen   *)
  268.   (* als längere.                                         *)
  269.  
  270.   (* Kompression: *)
  271.  
  272. CONST
  273.   c_len  : ARRAY [0..63] OF BYTE =
  274.             ($03, $04, $04, $04, $05, $05, $05, $05,
  275.              $05, $05, $05, $05, $06, $06, $06, $06,
  276.              $06, $06, $06, $06, $06, $06, $06, $06,
  277.              $07, $07, $07, $07, $07, $07, $07, $07,
  278.              $07, $07, $07, $07, $07, $07, $07, $07,
  279.              $07, $07, $07, $07, $07, $07, $07, $07,
  280.              $08, $08, $08, $08, $08, $08, $08, $08,
  281.              $08, $08, $08, $08, $08, $08, $08, $08);
  282.  
  283.   c_code : ARRAY [0..63] OF CARDINAL =
  284.             ($00, $20, $30, $40, $50, $58, $60, $68,
  285.              $70, $78, $80, $88, $90, $94, $98, $9C,
  286.              $A0, $A4, $A8, $AC, $B0, $B4, $B8, $BC,
  287.              $C0, $C2, $C4, $C6, $C8, $CA, $CC, $CE,
  288.              $D0, $D2, $D4, $D6, $D8, $DA, $DC, $DE,
  289.              $E0, $E2, $E4, $E6, $E8, $EA, $EC, $EE,
  290.              $F0, $F1, $F2, $F3, $F4, $F5, $F6, $F7,
  291.              $F8, $F9, $FA, $FB, $FC, $FD, $FE, $FF);
  292.  
  293.   (* Dekompression: *)
  294.  
  295. VAR
  296.   d_len  : ARRAY [0..255] OF BYTE;
  297.   d_code : ARRAY [0..255] OF CARDINAL;
  298.  
  299.   PROCEDURE MakeTable;
  300.   VAR
  301.     i, entry : CARDINAL;
  302.   BEGIN
  303.     FOR entry := 0 TO 62 DO BEGIN
  304.       i := c_code[entry];
  305.       WHILE (i < c_code[entry+1]) DO BEGIN
  306.         d_len[i]  := c_len[entry];
  307.         d_code[i] := entry SHL 6;
  308.         Inc(i);
  309.       END;
  310.     END;
  311.     i := c_code[63];
  312.     WHILE (i <= 255) DO BEGIN
  313.       d_len[i]  := c_len[entry];
  314.       d_code[i] := 63 SHL 6;
  315.       Inc(i);
  316.     END;
  317.     FOR i := 0 TO 63 DO
  318.       c_code[i] := c_code[i] SHL 8;
  319.   END;
  320.  
  321.   (* ----- Adaptive Huffman Coding ---------------------- *)
  322.  
  323. CONST
  324.   NChar   = 256 + (LookAhead-ThresHold);
  325.               (* ASCII-Char + Längen der LZSS-Codierungen *)
  326.   NTable  = 2*NChar - 1;
  327.               (* Anzahl der N-1 Knoten + N Blätter        *)
  328.   Root    = NTable - 1;    (* Position der Wurzel         *)
  329.   MaxFreq = $8000;         (* Neuaufbau des Huffman-Trees *)
  330.  
  331. VAR
  332.   Freq    : ARRAY [0..NTable] OF CARDINAL;
  333.               (* Häufigkeiten                             *)
  334.   Prnt    : ARRAY [0..NTable+NChar-1] OF CARDINAL;
  335.               (* Zeiger auf den "oberen" Knoten.          *)
  336.               (* Die Elemente NTable..NTable+NChar-1      *)
  337.               (* zeigen auf die Grundknoten des Baums     *)
  338.   Son     : ARRAY [0..NTable] OF CARDINAL;
  339.               (* Zeiger auf die Zweig-Elemente Son[] und  *)
  340.               (* Son[+1]                                  *)
  341.  
  342.   PROCEDURE InitHuff;           (* Initialisiert den Baum *)
  343.   VAR
  344.    i, j : CARDINAL;
  345.   BEGIN
  346.                                 (* Blätter initialisieren *)
  347.     FOR i := 0 TO NChar-1 DO BEGIN
  348.       Freq[i] := 1;  Son[i]  := i + NTable;
  349.       Prnt[i + NTable] := i;
  350.     END;
  351.                                 (* Knoten initialisieren  *)
  352.     i := 0;
  353.     FOR j := NChar TO Root DO BEGIN
  354.       Freq[j]  := Freq[i] + Freq[i+1];
  355.       Son[j]   := i;  Prnt[i] := j;  Prnt[i+1]:= j;
  356.       i := i + 2;
  357.     END;
  358.     Freq[NTable] := $FFFF;              (* Frequenzzähler *)
  359.     Prnt[Root]   := 0;                  (* Wurzel         *)
  360.   END;
  361.  
  362.   PROCEDURE Reconstruct;
  363.   VAR
  364.     i, j : CARDINAL;
  365.     f, k : CARDINAL;
  366.     l    : CARDINAL;
  367.   BEGIN
  368.       (* Teil 1: Blätter suchen und Frequenzen halbieren  *)
  369.     j := 0;
  370.     FOR i := 0 TO Root DO BEGIN
  371.       IF Son[i] >= NTable THEN BEGIN
  372.          (* Blatt gefunden und wieder an Anfang der Liste *)
  373.          (* schreiben                                     *)
  374.         Freq[j] := (Freq[i] + 1) DIV 2;
  375.         Son[j]  := Son[i];
  376.         Inc(j);
  377.       END;
  378.     END;
  379.       (* Teil 2: Knoten aus den Blättern bilden           *)
  380.     i := 0;                          (* "jüngerer" Knoten *)
  381.     FOR j := NChar TO Root DO BEGIN  (* j : freier Knoten *)
  382.       f := Freq[i] + Freq[i+1];      (* Neue Frequenz     *)
  383.                             (* Platz zum Einsetzen suchen *)
  384.       k := j - 1;
  385.       Freq[j] := f;
  386.       WHILE f < Freq[k] DO Dec(k);
  387.       Inc(k);
  388.       l := (j-k) * 2;
  389.       Move(Freq[k], Freq[k+1], l);
  390.       Freq[k] := f;
  391.       Move(Son[k], Son[k+1], l);
  392.       Son[k] := i;
  393.       INC( i, 2);
  394.     END;
  395.       (* Parent-Zweige verbinden *)
  396.     FOR i := 0 TO Root DO BEGIN
  397.       k       := Son[i];
  398.       Prnt[k] := i;
  399.       IF k < NTable THEN
  400.         Prnt[k+1] := i;       (* älterer Bruder, wenn Son *)
  401.                               (* nicht auf Verweis zeigt  *)
  402.     END;
  403.   END;
  404.  
  405.   PROCEDURE Update( c : CARDINAL);
  406.     (* korrigiert Huffman-Tree *)
  407.   VAR
  408.     x, f, y : CARDINAL;
  409.   BEGIN
  410.     IF Freq[Root] = MaxFreq THEN
  411.       Reconstruct;
  412.     c := Prnt[c + NTable];(* c: Zeiger auf unteren Knoten *)
  413.     REPEAT
  414.       Inc(Freq[c]);  f := Freq[c];  x := c + 1;
  415.       IF f > Freq[x] THEN BEGIN     (* Knoten austauschen *)
  416.         REPEAT
  417.          Inc(x);
  418.         UNTIL f <= Freq[x];
  419.         Dec( x);
  420.           (* x zeigt auf das Element, gegen das es        *)
  421.           (* ausgetauscht werden soll                     *)
  422.         Freq[c] := Freq[x];
  423.         Freq[x] := f;
  424.         f       := Son[c];
  425.         y       := Son[x];
  426.         Prnt[f] := x;
  427.         IF (f < NTable) THEN Prnt[f+1] := x;
  428.         Prnt[y] := c;
  429.         IF (y < NTable) THEN Prnt[y+1] := c;
  430.         Son[c] := y;  Son[x] := f;  c := x;
  431.       END;
  432.       c := Prnt[c];
  433.     UNTIL (c = 0);       (* Wurzel erreicht *)
  434.   END;
  435.  
  436.   PROCEDURE EncodeChar( c : CARDINAL);
  437.                  (* Verschlüsselt Buchstaben nach Huffman *)
  438.   VAR
  439.     bits, len, node : CARDINAL;
  440.   BEGIN
  441.     bits := 0;  len := 0;
  442.     node := Prnt[c+NTable];
  443.                      (* Der Code wird rückwärts aufgebaut *)
  444.     REPEAT
  445.       IF len = 16 THEN BEGIN               (* Puffer voll *)
  446.         PutCode(bits, 16);
  447.         bits := 0;  len := 0;
  448.       END;
  449.       bits := bits SHR 1;
  450.       IF ODD(node) THEN
  451.                      (* älterer Sohn - dann 1 abspeichern *)
  452.         bits := bits + $8000;
  453.       Inc(len);
  454.       node := Prnt[node];
  455.     UNTIL node = Root;
  456.     PutCode(bits, len);  Update(c);
  457.   END;
  458.  
  459.   PROCEDURE EncodePosition(c : CARDINAL);
  460.   VAR
  461.     i : CARDINAL;
  462.   BEGIN
  463.                     (* Obere 6 Bit durch Tabelle codieren *)
  464.     i := c SHR 6;
  465.     PutCode(c_code[i], c_len[i]);
  466.       (* untere 6 Bit normal ... *)
  467.     PutCode(c SHL 10, 6);
  468.   END;
  469.  
  470.   PROCEDURE EncodeEnd;
  471.   BEGIN
  472.     FlushCode;
  473.   END;
  474.  
  475.   FUNCTION DecodeChar : CARDINAL;
  476.   VAR
  477.     c : CARDINAL;
  478.   BEGIN
  479.        (* Suche des Zeichens im Baum von der Wurzel aus.  *)
  480.        (* Wird 0 gelesen, ist der "jüngere" Sohn gemeint. *)
  481.     c := Son[Root];
  482.     WHILE c < NTable DO c := Son[c+GetBit];
  483.       (* c steht auf dem gemeinten Zeichen *)
  484.     Dec(c, NTable);
  485.     Update(c);
  486.     DecodeChar := c;
  487.   END;
  488.  
  489.   FUNCTION DecodePosition : CARDINAL;
  490.   VAR
  491.     c, i, len : CARDINAL;
  492.   BEGIN
  493.       (* Bits aus Tabelle suchen *)
  494.     i := GetByte;  c := d_code[i];  len := d_len[i];
  495.       (* restliche untere Bits holen *)
  496.     Dec(len, 2);
  497.     WHILE len > 0 DO BEGIN
  498.       i := i SHL 1 + GetBit;
  499.       Dec(len);
  500.     END;
  501.     DecodePosition := c OR (i AND $3F);
  502.   END;
  503.  
  504.   PROCEDURE Encode;
  505.   VAR
  506.     i            : CARDINAL; (* Laufvariable              *)
  507.     c            : BYTE;     (* Zeichen, das gelesen wird *)
  508.     TextSize     : LONGINT;
  509.           (* Anzahl der Zeichen, die verarbeitet wurden   *)
  510.     Len          : CARDINAL;
  511.           (* Anzahl der unverarbeiteten Zeichen im Puffer *)
  512.     R            : CARDINAL;
  513.           (* Position, von der geschrieben wird           *)
  514.     S            : CARDINAL;
  515.           (* Position, in die Zeichen gelesen werden      *)
  516.     LastMatchLen : CARDINAL;
  517.           (* Anzahl der Zeichen bei Schreiben von LZSS    *)
  518.     PrintCount   : LONGINT;  (* Zähler für Hilfsausgabe   *)
  519.     OldSize      : LONGINT;
  520.   BEGIN
  521.     PrintCount := 0;
  522.     TextSize   := FileSize(InFile);
  523.     OldSize    := TextSize;
  524.     BlockWrite(OutFile, TextSize, SizeOf(TextSize));
  525.     InitHuff;  InitTree;
  526.     R := BufMax - LookAhead;  S := 0;
  527.                    (* Puffer mit Leerzeichen füllen       *)
  528.     FillChar(TextBuf, R, ' ');
  529.                    (* erste Zeichen einlesen              *)
  530.     BlockRead(InFile, TextBuf[R], LookAhead, Len);
  531.     TextSize := Len;
  532.     FOR i := R - 1 DOWNTO R - LookAhead DO
  533.       InsertNode(i);
  534.                    (* Zeiger im Leerzeichenbereich setzen *)
  535.     InsertNode(R);             (* ersten Zeiger setzen... *)
  536.     REPEAT
  537.       IF MatchLen > Len THEN MatchLen := Len;
  538.       IF MatchLen <= ThresHold THEN BEGIN
  539.           (* Zeichen verschlüsseln *)
  540.         MatchLen := 1;
  541.         EncodeChar(TextBuf[R]);
  542.       END ELSE BEGIN
  543.           (* LZSS verschlüsseln *)
  544.         EncodeChar(255 + MatchLen - ThresHold);
  545.         EncodePosition(MatchPos);
  546.       END;
  547.       LastMatchLen := MatchLen;
  548.                       (* Anzahl der geschriebenen Zeichen *)
  549.       i := 0;
  550.       WHILE (i < LastMatchLen) AND
  551.             (TextSize < OldSize) DO BEGIN
  552.                                  (* Neue Zeichen einlesen *)
  553.         BlockRead(InFile, c, 1);
  554.         (* c := BufRead; *)
  555.         DeleteNode(S);
  556.         TextBuf[S] := c;
  557.         IF (S < LookAhead - 1) THEN
  558.           TextBuf[BufMax+S] := c;  (* Zum Stringvergleich *)
  559.         S := (S + 1) AND (BufMax - 1);
  560.         R := (R + 1) AND (BufMax - 1);
  561.         InsertNode(R);
  562.                (* Zeichen wird in Zeigerliste aufgenommen *)
  563.         Inc(i);
  564.         Inc(TextSize);
  565.       END;
  566.       IF TextSize >= PrintCount THEN BEGIN
  567.         Write('.');
  568.         Inc(PrintCount, 1024);
  569.       END;
  570.        (* Diese Schleife wird aufgerufen, wenn nicht alle *)
  571.        (* Zeichen gelesen werden konnten (Ende der Datei) *)
  572.       WHILE i < LastMatchLen DO BEGIN
  573.         DeleteNode( S);
  574.         S := (S + 1) AND (BufMax - 1);
  575.         R := (R + 1) AND (BufMax - 1);
  576.         IF Len > 0 THEN BEGIN
  577.           InsertNode(R);
  578.                (* Wenn noch Zeichen im Puffer stehen, die *)
  579.           Dec(Len);             (* nicht verarbeitet sind *)
  580.         END;
  581.         Inc(i);
  582.       END;
  583.     UNTIL (Len = 0);
  584.     EncodeEnd;
  585.   END;
  586.  
  587.   PROCEDURE Decode;
  588.   VAR
  589.     S, R, c           : CARDINAL;
  590.     TextSize, count,
  591.     PrintCount        : LONGINT;
  592.     newpos, newlen, k : CARDINAL;
  593.   BEGIN
  594.       (* Filelänge lesen *)
  595.     BlockRead(InFile, TextSize, SizeOf(TextSize), S);
  596.     IF S <> SizeOf(TextSize) THEN Exit;
  597.     R := BufMax - LookAhead;
  598.     S := 0;
  599.     PrintCount := 0;
  600.     InitHuff;
  601.     FillChar(TextBuf, R, ' ');
  602.     Count := 0;
  603.     WHILE Count < TextSize DO BEGIN
  604.       c := DecodeChar;
  605.       IF c < 256 THEN BEGIN
  606.         BufWrite(c);
  607.         TextBuf[R] := c;
  608.         R := (R + 1) AND (BufMax - 1);
  609.         Inc(Count);
  610.       END ELSE BEGIN
  611.         newpos := (R - DecodePosition - 1) AND (BufMax - 1);
  612.         newlen := c + ThresHold - 255;
  613.         FOR k := 0 TO newlen - 1 DO BEGIN
  614.           c := TextBuf[(newpos + k) AND (BufMax - 1)];
  615.           BufWrite(c);
  616.           TextBuf[R] := c;
  617.           R := (R + 1) AND (BufMax - 1);
  618.           Inc(Count);
  619.         END;
  620.       END;
  621.       IF Count > PrintCount THEN BEGIN
  622.         Write('.');
  623.         Inc(PrintCount, 1024);
  624.       END;
  625.     END;
  626.     BufFlush;
  627.   END;
  628.  
  629. VAR
  630.   p : STRING;
  631.  
  632. BEGIN
  633.   WritePtr := 0;  ReadPtr := 0;  ReadMax := 0;
  634.   MakeTable;
  635.   FillChar(OutBuffer, SizeOf(OutBuffer), #0);
  636.   OutBufP := 0;  InBufP := 0;
  637.   OutBitP := 0;  InBitP := 0;
  638.   MaxIn   := -1;
  639.   p       := ParamStr(1);  p[1] := UpCase(p[1]);
  640.   IF (ParamCount <> 3) OR (Length(p) <> 1) OR
  641.      (p[1] < 'D') OR (p[1] > 'E') THEN BEGIN
  642.     WriteLn('"LZHUF e file1 file2"',
  643.             '   komprimiert file1 in file2');
  644.     WriteLn('"LZHUF d file1 file2"',
  645.             ' dekomprimiert file1 in file2');
  646.     Halt;
  647.   END;
  648.   Assign(InFile,  ParamStr(2));
  649.   Assign(OutFile, ParamStr(3));
  650.   (*$I-*)
  651.   Rewrite(OutFile, 1);  Reset(InFile, 1);
  652.   (*$I+*)
  653.   IF IOResult <> 0 THEN BEGIN
  654.     WriteLn(' Files konnten nicht geöffnet werden...');
  655.     Halt;
  656.   END;
  657.   IF p[1] = 'E' THEN Encode ELSE Decode;
  658.   Close(InFile);  Close(OutFile);
  659. END.
  660. (* ------------------------------------------------------ *)
  661. (*                 Ende von LZHUF.PAS                     *)
  662.