,, lzh gennemførelse i pascal, bidragyder: douglas webb, enhed lzh;,   {$a + b - d - e - f - jeg + -, l -, n - o - r - s -, v -) (*   * lzhuf. c engelsk version 1.0,   * baseret på japanske udgave 29-nov-1988,   * lzss kodet af haruhiko okumura,   * adaptive huffman kodning kodet af haruyasu yoshizaki,   * udarbejdet og oversat til engelsk af kenji rikitake,   * oversat fra c - turbo pascal af douglas webb 2 /18 /91,   * ajourføre og insekt korrektion af tp version 4 /29 /91 (ked af det!!),   *) {,       denne enhed gør det muligt for brugeren at commpress data ved hjælp af en kombination af     lzss motorer og adaptive huffman kodning, eller omvendt at slappe af,     data, der tidligere blev presset af denne enhed.       er der en række valgmuligheder med hensyn til, hvor data er komprimeret /,     decompressed kommer fra /til.      faktisk kræver det, at du passerer " lzhpack " procedure 2 proceduremæssige,    parameter af typen ' getproctype ' og ' putproctype ' (angivet nedenfor), som    vil acceptere 3 parametre og loven på enhver måde som en ' blockread ' /' blockwrite ',    - procedure.din ' getproctype ' proceduren skal tilbagelevere de data,    til komprimeret, og din ' putproctype ' procedure bør gøre noget ved,    komprimeret data (dvs. at, sætte det i en fil).hvis du har brug for at vide, og    gør du hvis du vil slappe af disse data igen) antal bytes i,    komprimeret data (ikke komprimeret størrelse) er vendt tilbage i ' bytes_written '.,    getbytesproc = procedure (var dta; nbytes: ord; var bytes_got: ord),    dta - er starten på et sted, hvor de oplysninger tilbage, bør huske,   .nbytes er antal bytes, anmodede om.det faktiske antal bytes,    tilbage, skal vedtages i bytes_got (hvis der ikke er flere data og 0,    skal returneres).    putbytesproc = procedure (var dta; nbytes: ord, var bytes_got: ord),    som ovenfor bortset fra, i stedet for at bede om oplysninger den procedure, er dumping,    komprimeret data, gør noget ved det.      " lzhunpack ", er stort set den samme i bakgear.det kræver,    proceduremæssige parametre af typen ' putproctype ' /' getproctype ', som    vil fungere som ovenfor.' getproctype ' skal hente data komprimeret med,    " lzhpack " (ovenfor), og giv den til udpakningen rutine, som der anmodes om.    ' putproctype ' skal acceptere decompressed data og gøre noget,    med det.du skal også bestå i den oprindelige størrelse af decompressed data,    undlader at gøre dette, vil have negative resultater.       er ', ikke glemme, at proceduremæssige parametre, og' getproctype ' /' putproctype ',    procedurer skal være udarbejdet i ' f + ' medlemsstat for at undgå en katastrofe.} {nb: alle de store data strukturer for disse serier er tildelt ved,    nødvendig fra bunken, og deallocated når du er færdig.så, når den ikke er i brug,    hukommelse krav er minimal.men denne enhed bruges om 34k,    bunke rum, og 400 bytes i stak, når de er i brug.}, grænseflade, type,    putbytesproc = procedure (var dta; nbytes: ord, var bytes_put: ord),    getbytesproc = procedure (var dta; nbytes: ord, var bytes_got: ord), procedure lzhpack (var - bytes_written: longint;,                        getbytes: getbytesproc;,                        putbytes: putbytesproc);, procedure lzhunpack (textsize: longint;,                      getbytes: getbytesproc;,                      putbytes: putbytesproc), gennemførelse, konstant,    exit_ok = 0,    exit_failed = 1,    {lzss parametre),    n = 40; (størrelse af snor buffer),    f = 60; (størrelseof look-ahead buffer },   THRESHOLD = 2;,   NUL = N; { end of tree's node },   { Huffman coding parameters },   N_Char = (256 - THRESHOLD + F);,   { Character code (:= 0..N_Char-1) },   T = (N_Char * 2 - 1); { Size of table },   R = (T - 1); { root position },   { update when cumulative frequency },   { reaches to this value },   MAX_FREQ = $8000;, {,  * Tables For encoding/decoding upper 6 bits of,  * sliding dictionary Pointer,  },   { encoder table },   p_len : Array[0..63] of Byte =,   ($03, $04, $04, $04, $05, $05, $05, $05,,    $05, $05, $05, $05, $06, $06, $06, $06,,    $06, $06, $06, $06, $06, $06, $06, $06,,    $07, $07, $07, $07, $07, $07, $07, $07,,    $07, $07, $07, $07, $07, $07, $07, $07,,    $07, $07, $07, $07, $07, $07, $07, $07,,    $08, $08, $08, $08, $08, $08, $08, $08,,    $08, $08, $08, $08, $08, $08, $08, $08);,   p_code : Array[0..63] of Byte =,   ($00, $20, $30, $40, $50, $58, $60, $68,,    $70, $78, $80, $88, $90, $94, $98, $9C,,    $A0, $A4, $A8, $AC, $B0, $B4, $B8, $BC,,    $C0, $C2, $C4, $C6, $C8, $CA, $CC, $CE,,    $D0, $D2, $D4, $D6, $D8, $DA, $DC, $DE,,    $E0, $E2, $E4, $E6, $E8, $EA, $EC, $EE,,    $F0, $F1, $F2, $F3, $F4, $F5, $F6, $F7,,    $F8, $F9, $FA, $FB, $FC, $FD, $FE, $FF);,   { decoder table },   d_code : Array[0..255] of Byte =,   ($00, $00, $00, $00, $00, $00, $00, $00,,    $00, $00, $00, $00, $00, $00, $00, $00,,    $00, $00, $00, $00, $00, $00, $00, $00,,    $00, $00, $00, $00, $00, $00, $00, $00,,    $01, $01, $01, $01, $01, $01, $01, $01,,    $01, $01, $01, $01, $01, $01, $01, $01,,    $02, $02, $02, $02, $02, $02, $02, $02,,    $02, $02, $02, $02, $02, $02, $02, $02,,    $03, $03, $03, $03, $03, $03, $03, $03,,    $03, $03, $03, $03, $03, $03, $03, $03,,    $04, $04, $04, $04, $04, $04, $04, $04,,    $05, $05, $05, $05, $05, $05, $05, $05,,    $06, $06, $06, $06, $06, $06, $06, $06,,    $07, $07, $07, $07, $07, $07, $07, $07,,    $08, $08, $08, $08, $08, $08, $08, $08,,    $09, $09, $09, $09, $09, $09, $09, $09,,    $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A,,    $0B, $0B, $0B, $0B, $0B, $0B, $0B, $0B,,    $0C, $0C, $0C, $0C, $0D, $0D, $0D, $0D,,    $0E, $0E, $0E, $0E, $0F, $0F, $0F, $0F,,    $10, $10, $10, $10, $11, $11, $11, $11,,    $12, $12, $12, $12, $13, $13, $13, $13,,    $14, $14, $14, $14, $15, $15, $15, $15,,    $16, $16, $16, $16, $17, $17, $17, $17,,    $18, $18, $19, $19, $1A, $1A, $1B, $1B,,    $1C, $1C, $1D, $1D, $1E, $1E, $1F, $1F,,    $20, $20, $21, $21, $22, $22, $23, $23,,    $24, $24, $25, $25, $26, $26, $27, $27,,    $28, $28, $29, $29, $2A, $2A, $2B, $2B,,    $2C, $2C, $2D, $2D, $2E, $2E, $2F, $2F,,    $30, $31, $32, $33, $34, $35, $36, $37,,    $38, $39, $3A, $3B, $3C, $3D, $3E, $3F);,   d_len : Array[0..255] of Byte =,   ($03, $03, $03, $03, $03, $03, $03, $03,,    $03, $03, $03, $03, $03, $03, $03, $03,,    $03, $03, $03, $03, $03, $03, $03, $03,,    $03, $03, $03, $03, $03, $03, $03, $03,,    $04, $04, $04, $04, $04, $04, $04, $04,,    $04, $04, $04, $04, $04, $04, $04, $04,,    $04, $04, $04, $04, $04, $04, $04, $04,,    $04, $04, $04, $04, $04, $04, $04, $04,,    $04, $04, $04, $04, $04, $04, $04, $04,,    $04, $04, $04, $04, $04, $04, $04, $04,,    $05, $05, $05, $05, $05, $05, $05, $05,,    $05, $05, $05, $05, $05, $05, $05, $05,,    $05, $05, $05, $05, $05, $05, $05, $05,,    $05, $05, $05, $05, $05, $05, $05, $05,,    $05, $05, $05, $05, $05, $05, $05, $05,,    $05, $05, $05, $05, $05, $05, $05, $05,,    $05, $05, $05, $05, $05, $05, $05, $05,,    $05, $05, $05, $05, $05, $05, $05, $05,,    $06, $06, $06, $06, $06, $06, $06, $06,,    $06, $06, $06, $06, $06, $06, $06, $06,,    $06, $06, $06, $06, $06, $06, $06, $06,,    $06, $06, $06, $06, $06, $06, $06, $06,,    $06, $06, $06, $06, $06, $06, $06, $06,,    $06, $06, $06, $06, $06, $06, $06, $06,,    $07, $07, $07, $07, $07, $07, $07, $07,,    $07, $07, $07, $07, $07, $07, $07, $07,,    $07, $07, $07, $07, $07, $07, $07, $07,,    $07, $07, $07, $07, $07, $07, $07, $07,,    $07, $07, $07, $07, $07, $07, $07, $07,,    $07, $07, $07, $07, $07, $07, $07, $07,,    $08, $08, $08, $08, $08, $08, $08, $08,,    $08, $08, $08, $08, $08, $08, $08, $08);,   getbuf : Word = 0;,   getlen : Byte = 0;,   putlen : Byte = 0;,   putbuf : Word = 0;,   TextSize : LongInt = 0;,   codesize : LongInt = 0;,   printcount : LongInt = 0;,   match_position : Integer = 0;,   match_length : Integer = 0;, Type,   FreqType = Array[0..T] of Word;,   FreqPtr = ^FreqType;,   PntrType = Array[0..pred(T + N_Char)] of Integer;,   pntrPtr = ^PntrType;,   SonType = Array[0..pred(T)] of Integer;,   SonPtr = ^SonType;,   TextBufType = Array[0..N + F - 2] of Byte;,   TBufPtr = ^TextBufType;,   WordRay = Array[0..N] of Integer;,   WordRayPtr = ^WordRay;,   BWordRay = Array[0..N + 256] of Integer;,   BWordRayPtr = ^BWordRay;, Var,   Text_buf : TBufPtr;,   lson, dad : WordRayPtr;,   rson : BWordRayPtr;,   freq : FreqPtr; { cumulative freq table }, {,  * pointing parent nodes.,  * area [T..(T + N_Char - 1)] are Pointers For leaves,  },   prnt : pntrPtr;,   { pointing children nodes (son[], son[] + 1)},   son : SonPtr;,   Procedure InitTree; { Initializing tree },   Var,     i : Integer;,   begin,     For i := N + 1 to N + 256 do,       rson^[i] := NUL; { root },     For i := 0 to N do,       dad^[i] := NUL; { node },   end;,   Procedure InsertNode(R : Integer); { Inserting node to the tree },   Var,     tmp, i, p, cmp : Integer;,     key : TBufPtr;,     c : Word;,   begin,     cmp: = 1;,      nøgle: = @ text_buf ^ [r],      p: = succ (n) + centrale ^ [0],      rson ^ [r]: = nul;,      lson ^ [r]: = nul;,      match_length: = 0,     , mens match_length < f,        begynder,          hvis (cmp > = 0),            begynder,              hvis (rson ^ [p] < > nul),                p: = rson ^ [p],              andet,                begynder,                  rson. [p]: = r,                  far ^ [r]: = p,                  udpassage,               ;,           ,          andet,            begynder,              hvis (lson ^ [p] < > nul),                p: = lson ^ [p],              andet,                begynder,                  lson ^ [p]: = r,                  far ^ [r]: = p,                  udpassage,               ;,           ;,          jeg: = 0,          cmp: = 0.,         , mens (< f) og (cmp = 0),            begynder,              inc. (i),              cmp: = centrale ^ [i] - text_buf » [p + jeg],           ;,         , hvis jeg > tærskel),            begynde,              tmp: = fremherskende ((r - p) og fremherskende (n),             , hvis jeg > match_length),                begynder,                  match_position: = tmp;,                  match_length: = i,               ;,              hvis (match_length < f) og (i = match_length),                begynder,                  c: = tmp;,                  hvis c < match_position),                    match_position: = c               ;,;,           ;,       ; (mens rigtigt gøre},      far ^ [r]: = far ^ [p],      lson ^ [r]: = lson ^ [p],      rson ^ [r]: = rson ^ [p],      far) [lson ^ [p]]: = r,      far) [rson ^ [p]]: = r,      hvis (rson ^ ^ [p] - [far] = p) then,       rson^[dad^[p]] := R,     else,       lson^[dad^[p]] := R;,     dad^[p] := NUL; { remove p },   end;,   Procedure DeleteNode(p : Integer); { Deleting node from the tree },   Var,     q : Integer;,   begin,     if (dad^[p] = NUL) then,       Exit; { unregistered },     if (rson^[p] = NUL) then,       q := lson^[p],     else if (lson^[p] = NUL) then,       q := rson^[p],     else,       begin,         q := lson^[p];,         if (rson^[q] <> NUL) then,           begin,             Repeat,               q := rson^[q];,             Until (rson^[q] = NUL);,             rson^[dad^[q]] := lson^[q];,             dad^[lson^[q]] := dad^[q];,             lson^[q] := lson^[p];,             dad^[lson^[p]] := q;,           end;,         rson^[q] := rson^[p];,         dad^[rson^[p]] := q;,       end;,     dad^[q] := dad^[p]; , ,     if (rson^[dad^[p]] = p) then,       rson^[dad^[p]] := q,     else,       lson^[dad^[p]] := q;,     dad^[p] := NUL;,   end;,   { Huffman coding parameters },   Function GetBit(GetBytes : GetBytesProc) : Integer; { get one bit },   Var,     i : Byte;,     i2 : Integer;,     result : Word;,   begin,     , mens (getlen < = 8),        begynder,          getbytes (i, 1, resultat),         , hvis resultat = 1,            i2 - = jeg,          andet i2 - = 0,          getbuf: = getbuf eller (i2 sømhaj shb (8 - getlen),          inc (getlen, 8),       ;,      i2 - = getbuf;,      getbuf: = getbuf sømhaj shb 1,      dec (getlen),      getbit: = heltal ((2 < 0),   ;,    funktion getbyte (getbytes: getbytesproc): heltal (en byte},    var,      j: byte;,      jeg, resultat: ord;,    begynder,     , mens (getlen < = 8),        begynder,          getbytes j, 1, resultat),         , hvis resultat = 1,            jeg: = j,          else,           i := 0;,         getbuf := getbuf or (i shl (8 - getlen));,         inc(getlen, 8);,       end;,     i := getbuf;,     getbuf := getbuf shl 8;,     dec(getlen, 8);,     GetByte := Integer(i shr 8);,   end;,   Procedure Putcode(l : Integer; c : Word;,                     PutBytes : PutBytesProc); { output c bits },   Var,     Temp : Byte;,     Got : Word;,   begin,     putbuf := putbuf or (c shr putlen);,     inc(putlen, l);,     if (putlen >= 8) then,       begin,         Temp := putbuf shr 8;,         PutBytes(Temp, 1, Got);,         dec(putlen, 8);,         if (putlen >= 8) then,            begynder,              temperatur: = lo (putbuf),              putbytes (temperatur, 1, har),              inc (codesize, 2),              dec (putlen, 8),              putbuf: = c sømhaj shb (l - putlen),           ,          andet,            begynder,              putbuf: = putbuf sømhaj shb 8,              inc (codesize),           ;,       ;,   ;,    {påbegynd nf træ),    procedure starthuff;,    var,      i, j.: heltal,    begynder, for jeg     : = 0 (n_char fremherskende),        begynder,          nf) [i]: = 1,          søn ^ [i]: = jeg + t,          prnt ^ [i + t]: = i,        end;,     i := 0;,     j := N_Char;,     While (j <= R) do,       begin,         freq^[j] := freq^[i] + freq^[i + 1];,         son^[j] := i;,         prnt^[i] := j;,         prnt^[i + 1] := j;,         inc(i, 2);,         inc(j);,       end;,     freq^[T] := $ffff;,     prnt^[R] := 0;,   end;,   { reConstruct freq tree },   Procedure reConst;,   Var,     i, j, k, tmp : Integer;,     F, l : Word;,   begin,     { halven cumulative freq For leaf nodes },     j := 0;,     For i := 0 to pred(T) do,       begin,         if (son^[i] >= T) then,           begin,             freq^[j] := succ(freq^[i]) div 2; {@@ Bug Fix MOD -> div @@},             son^[j] := son^[i];,             inc(j);,           end;,       end;,     { make a tree : first, connect children nodes },     i := 0;,     j := N_Char;,     While (j < T) do,       begin,         k := succ(i);,         F := freq^[i] + freq^[k];,         freq^[j] := F;,         k := pred(j);,         While F < freq^[k] do,           dec(k);,         inc(k);,         l := (j - k) shl 1;,         tmp := succ(k);,         move(freq^[k], freq^[tmp], l);,         freq^[k] := F;,         move(son^[k], son^[tmp], l);,          søn » [k]: = i,          inc (1, 2),          inc. (j),       ;,      {forbinde forælder knudepunkter}, for jeg     : = 0 til fremherskende (t),        begynder,          k = søn ^ [i];,          hvis k > = t),            begynder,              prnt » [k]: = i,           ,          andet,            begynder,              prnt » [k]: = i,              prnt) [succ (k)]: = i,           ;,       ;,   ;,    {ajourføre nf træ),    procedure ajourføring (c: heltal),    var,      i, j, k, l: heltal,    begynder,      hvis (nf) [r] = max_freq),        begynder,          rekonst.       ,    ; c := prnt^[c + T];,     Repeat,       inc(freq^[c]);,       k := freq^[c];,       { swap nodes to keep the tree freq-ordered },       l := succ(c);,       if (k > freq^[l]) then,         begin,           While (k > freq^[l]) do,             inc(l);,           dec(l);,           freq^[c] := freq^[l];,           freq^[l] := k;,           i := son^[c];,           prnt^[i] := l;,           if (i < T) then prnt^[succ(i)] := l;,           j := son^[l];,           son^[l] := i;,           prnt^[j] := c;,           if (j < T) then prnt^[succ(j)] := c;,           son^[c] := j;,           c := l;,         end;,       c := prnt^[c];,     Until (c = 0); { Repeat it Until reaching the root },   end;, Var,   code, len : Word;,   Procedure EncodeChar(c : Word; PutBytes : PutBytesProc);,   Var,     i : Word;,     j, k : Integer;,   begin,     i := 0;,     j := 0;,     k := prnt^[c + T];,     { search connections from leaf node to the root },     Repeat,       i := i shr 1;,  {,         if node's address is odd, output 1,         else output 0,         },       if Boolean(k and 1) then inc(i, $8000);,       inc(j);,       k := prnt^[k];,     Until (k = R);,     Putcode(j, i, PutBytes);,     code := i;,     len := j;,     update(c);,   end;,   Procedure EncodePosition(c : Word; PutBytes : PutBytesProc);,   Var,     i, j : Word;,   begin,     { output upper 6 bits With encoding },     i := c shr 6;,     j := p_code[i];,     Putcode(p_len[i], j shl 8, PutBytes);,     { output lower 6 bits directly },     Putcode(6, (c and $3f) shl 10, PutBytes);,   end;,   Procedure Encodeend(PutBytes : PutBytesProc);,   Var,     Temp : Byte;,     Got : Word;,   begin,     if Boolean(putlen) then,       begin,         Temp := lo(putbuf shr 8);,         PutBytes(Temp, 1, Got);,         inc(codesize);,       end;,   end;,   Function DecodeChar(GetBytes : GetBytesProc) : Integer;,   Var,     c : Word;,   begin,     c := son^[R];,     {,      * start searching tree from the root to leaves.,      * choose node #(son[]) if input bit = 0,      * else choose #(son[]+1) (input bit = 1),     },     While (c < T) do,       begin,         c := c + GetBit(GetBytes);,         c := son^[c];,       end;,     c := c - T;,     update(c);,     DecodeChar := Integer(c);,   end;,   Function DecodePosition(GetBytes : GetBytesProc) : Word;,   Var,     i, j, c : Word;,   begin,     { decode upper 6 bits from given table },     i := GetByte(GetBytes);,     c := Word(d_code[i] shl 6);,     j := d_len[i];,     { input lower 6 bits directly },     dec(j, 2);,     While j <> 0 do,       begin,         i := (i shl 1) + GetBit(GetBytes);,         dec(j);,       end;,     DecodePosition := c or i and $3f;,   end;,   { Compression },   Procedure InitLZH;,   begin,     getbuf := 0;,     getlen := 0;,     putlen := 0;,     putbuf := 0;,     TextSize := 0;,     codesize := 0;,     printcount := 0;,     match_position := 0;,     match_length := 0;,     new(lson);,     new(dad);,     new(rson);,     new(Text_buf);,     new(freq);,     new(prnt);,     new(son);,   end;,   Procedure endlzh;,    begynder,      bortskaffelse (søn),      bortskaffelse (prnt),      bortskaffelse (nf),      bortskaffelse (text_buf),      bortskaffelse (rson),      bortskaffelse (far),      bortskaffelse (lson),   ;,    procedure lzhpack (var bytes_written: longint;,                          getbytes: getbytesproc;,                          putbytes: putbytesproc),    var,      ct: byte;,      jeg, len, r, s, last_match_length: heltal,      har: ord;,    begynder,      initlzh;,      textsize: = 0 (spole tilbage og planlægger},      starthuff;,      inittree;,     : = 0,      r = n - f,      fillchar (text_buf ([0] r ' '),      len: = 0,     har: = 1,     , mens (len < f) og har < > 0),        begynder,          getbytes (ct, 1, har),          hvis har < > 0,            begynder,              text_buf ^ [r + len]: = e;,              inc (len),           ;,       ;,      textsize: = len;, for jeg     : = 1 - f,        insertnode (r - jeg),      insertnode (r),      gentager,        hvis (match_length > len),          match_length: = len;,        hvis (match_length < = tærskel),          begynder,            match_length: = 1,            encodechar (text_buf ^ [r], putbytes),         ,        andet,          begynder,            encodechar (255 - tærskel + match_length, putbytes),            encodeposition (match_position, putbytes),         ;,        last_match_length: = match_length;,        jeg: = 0,        har: = 1,       , mens (< last_match_length) og har < > 0),          begynder,            getbytes (ct, 1, har),            hvis har < > 0,              begynder,                deletenode (s),                text_buf » [s]: = e;,                hvis (< fremherskende (f)),                  text_buf » [s + n]: = e;,               : = succ (er) og fremherskende (n),                r = succ (r) og fremherskende (n),                insertnode (r),                inc. (i),             ;,         ;,        inc (textsize, jeg),       , mens (< last_match_length),          begynder,            inc -),            deletenode (s),           : = succ (er) og fremherskende (n),            r = succ (r) og fremherskende (n),            dec (len),            hvis boolean (len), så insertnode (r),         ;,      indtil (len < = 0),      encodeend (putbytes),      endlzh;,      bytes_written: = textsize;,   ;,    procedure lzhunpack (textsize: longint,              ;          getbytes: getbytesproc;,                        putbytes: putbytesproc),    var,      c, i, j, k, r: heltal,      c2, en: byte;,      tæller: longint;,      sætte: ord;,    begynder,      initlzh;,      starthuff;,      r: = n - f,      fillchar (text_buf ([0] r ' '),      tæller: = 0,      og tælle < textsize,        begynder,          c: = decodechar (getbytes),          hvis c < 256),            begynder,              c2: = lo (c),              putbytes (c2, 1, tag),              text_buf ^ [r]: = c,              inc (r),              r = r og fremherskende (n),              inc (tæller),           ,          andet,            begynder,              jeg: = (r - succ (decodeposition (getbytes)) og fremherskende (n),              j = c - 255 + tærskel,              for k = 0 fremherskende (j),                begynde,                  c: = text_buf ^ [(i + k) og fremherskende (n)],                  c2: = lo (c),                  putbytes (c2, 1, tag),                  text_buf ^ [r]: = c,                  inc (r),                  r = r og fremherskende (n),                  inc (tæller),               ;,           ,     ;  ;,      endlzh;,   ;,.,