LZH implementering i Pascal
bidragsyter: DOUGLAS WEBB
Unit LZH, product: {$ A +, B-, D-, E-, F-, I +, L-, N-, O-, R-, S-, V-} product: (* * LZHUF.C engelsk versjon 1.0 * Basert på japansk versjon 29-november-1988 * LZSS kodet av Haruhiko Okumura * Adaptive Huffman-koding kodet av Haruyasu Yoshizaki * redigert og oversatt til engelsk av Kenji RIKITAKE * Oversatt fra C til Turbo Pascal av Douglas Webb 2/18/91 * Update og bug korrigering av TP versjon 4/29/91 (Sorry !!) *) product: {Denne enheten tillater brukeren å commpress data ved hjelp av en kombinasjon av LZSS Kompresjon og adaptiv Huffman koding, eller omvendt å dekomprimere data som tidligere ble komprimert ved denne enheten.
Det finnes en rekke alternativer til hvor dataene blir komprimert /dekomprimert kommer fra /skal til.
faktisk krever det at du passerer " LZHPack " Prosedyre 2 prosessuelle parameter av type 'GetProcType' og 'PutProcType' (erklært nedenfor) som vil akseptere 3 parametre og handle på alle måter som en "BlockRead '/' BlockWrite 'prosedyre samtale. Din 'GetProcType' Prosedyre skal returnere dataene som skal Komprimert og din "PutProcType 'Prosedyre bør gjøre noe med komprimerte data (ie., Legg den i en fil). I tilfelle du trenger å vite (og du kan gjøre hvis du ønsker å dekomprimere disse dataene igjen) antall byte i komprimerte data (original, ikke Komprimert størrelse) er tilbake i 'Bytes_Written'.
GetBytesProc = Prosedyre (Var DTA; NBytes: Word, Var Bytes_Got: Word);
DTA er starten på en minneplassering der informasjonen returneres skal være. NBytes er antall Bytes etterspør. Det faktiske antallet Bytes returnert må være bestått Bytes_Got (hvis det ikke er mer data stillingen 0 bør returneres)
PutBytesProc = Prosedyre (Var DTA, NBytes: Word, Var Bytes_Got: Word),.
Som ovenfor bortsett fra i stedet for å be om data prosedyren dumping ut komprimerte data, gjøre somthing med det
". LZHUnPack " er i utgangspunktet det samme i revers. Det krever prosedyre parameter av typen 'PutProcType' /'GetProcType "som vil fungere som ovenfor. 'GetProcType' må hente data komprimert med " LZHPack " (Ovenfor) og mate den til utpakking rutine som forespurt. 'PutProcType' må godta dekomprimeres data og gjøre noe withit. Du må også bestå i den opprinnelige størrelsen på dekomprimeres data, unnlatelse av å gjøre dette vil ha negative resultater.
Ikke glem at så prosessuelle parametre 'GetProcType' /'PutProcType' Prosedyrer skal utarbeides i 'F +' staten for å unngå en katastrofe
} product: {note. Alle de store datastrukturer for disse rutinene blir tildelt ved behov fra haugen, og deallocated når du er ferdig. Så når den ikke er i bruk minnekrav er minimal. Men bruker du denne enheten på 34K av heap plass, og 400 Bytes av stabelen under bruk. }
Interface
Type
PutBytesProc = Prosedyre (Var DTA, NBytes: Word, Var Bytes_Put: Word); GetBytesProc = Prosedyre (Var DTA, NBytes: Word, Var Bytes_Got: Word);
Prosedyre LZHPack (Var Bytes_Written: LongInt; GetBytes: GetBytesProc; PutBytes: PutBytesProc);
Prosedyre LZHUnpack (Tekststørrelse: LongInt; GetBytes: GetBytesProc; PutBytes: PutBytesProc);
Gjennomføring
Const Exit_OK = 0; Exit_FAILED = 1;
{LZSS Parametere} N = 4096; {Størrelse på String buffer} F = 60; {Størrelse på utseende-ahead buffer} GRENSE = 2; NUL = N; {Slutten av treet node} product: {Huffman koding parametere} N_Char = (256 - GRENSEN + F), product: {Tegnkode (: = 0..N_Char-1)} T = (N_Char * 2-1); {Størrelse på bordet} R = (T - 1); {Root posisjon} product: {oppdatering når kumulativ frekvens} {kommer til denne verdien} MAX_FREQ = $ 8000;
{* tabeller for koding /dekoding øvre 6 biter av * skyve ordboken Pointer}
{encoder tabellen} p_len : Array [0..63] av 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. 0,63] av 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); product: {dekoder bord} d_code: Array [0..255 ] av 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] av 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; Tekststørrelse: LongInt = 0; codesize: LongInt = 0; printcount: LongInt = 0; match_position: Integer = 0; match_length: Integer = 0;
Type FreqType = Array [0..T] av Word; FreqPtr = ^ FreqType; PntrType = Array [0..pred (T + N_Char)] av Integer; pntrPtr = ^ PntrType; SonType = Array [0..pred (T)] av Integer; SonPtr = ^ SonType; TextBufType = Array [0..n + F - 2] av Byte; TBufPtr = ^ TextBufType; WordRay = Array [0..n] av Integer; WordRayPtr = ^ WordRay; BWordRay = Array [0..n + 256] av Integer; BWordRayPtr = ^ BWordRay;
Var Text_buf: TBufPtr; lson, pappa: WordRayPtr; rson: BWordRayPtr; freq: FreqPtr; {Kumulativ frekvens tabellen} product: {* peker ordnede noder. * Området [T .. (T + N_Char - 1)] er Pekere For blader} PRNT: pntrPtr; product: {peker barn noder (sønn [], sønn [] + 1)} sønn: SonPtr;
Prosedyre InitTree; {Initial treet} Var i: Integer; begynne For jeg: = N + 1 til N + 256 gjøre rson ^ [i]: = NUL; {Root} For jeg: = 0 til N gjøre pappa ^ [i]: = NUL; {Node} end;
Prosedyre InsertNode (R: Integer); {Sette node til treet} Var tmp, i, p, cmp: Integer; nøkkel: TBufPtr; c: Word; begynne CMP: = 1; key: = @ Text_buf ^ [R]; p: = succ (N) + nøkkel ^ [0]; rson ^ [R]: = NUL; lson ^ [R]: = NUL; match_length: = 0; Mens match_length < F gjør begynne if (CMP > = 0), og start if (rson ^ [p] < > NUL) deretter p: = rson ^ [p] ellers begynne rson ^ [p]: = R; pappa ^ [R]: = p; exit; ende; ende annet begynne if (lson ^ [p] < > NUL) deretter p: = lson ^ [p] ellers begynne lson ^ [p]: = R; pappa ^ [R]: = p; exit; ende; ende; i: = 0; CMP: = 0; Mens (i < F) og (CMP = 0) gjør begynne økes (i); CMP: = nøkkelen ^ [i] - Text_buf ^ [p + i]; ende; if (i > GRENSE), og start tmp: = pred ((R - p) og pred (N)); if (i > match_length), og start match_position: = tmp; match_length: = i; ende; if (match_length < F) og (i = match_length), og start c: = tmp; if (c < match_position) så match_position: = c; ende; ende; ende; {Mens Sann gjøre} pappa ^ [R]: = pappa ^ [p]; lson ^ [R]: = lson ^ [p]; rson ^ [R]: = rson ^ [p]; pappa ^ [lson ^ [p]]: = R; pappa ^ [rson ^ [p]]: = R; if (rson ^ [pappa ^ [p]] = p) så rson ^ [pappa ^ [p]]: = R annet lson ^ [pappa ^ [p]]: = R; pappa ^ [p]: = NUL; {Fjerne p} end;
Prosedyre DeleteNode (p: Integer); {Slette node fra treet} Var q: Integer; begynne if (pappa ^ [p] = NUL) deretter Avslutt; {Uregistrert} if (rson ^ [p] = NUL) deretter q: = lson ^ [p] else if (lson ^ [p] = NUL) deretter q: = rson ^ [p] ellers begynner q: = lson ^ [ ,,,0],p]; if (rson ^ [q] < > NUL), og start Gjenta q: = rson ^ [q]; Inntil (rson ^ [q] = NUL); rson ^ [pappa ^ [q]]: = lson ^ [q]; pappa ^ [lson ^ [q]]: = pappa ^ [q]; lson ^ [q]: = lson ^ [p]; pappa ^ [lson ^ [p]]: = q; ende; rson ^ [q]: = rson ^ [p]; pappa ^ [rson ^ [p]]: = q; ende; pappa ^ [q]: = pappa ^ [p]; if (rson ^ [pappa ^ [p]] = p) så rson ^ [pappa ^ [p]]: = q annet lson ^ [pappa ^ [p]]: = q; pappa ^ [p]: = NUL; enden, product: {Huffman koding parametere}
Funksjon GetBit (GetBytes: GetBytesProc): integer; {Få en bit} Var i: Byte; i2: Integer; Resultatet: Word; begynne Mens (getlen < = 8) trenger begynne GetBytes (i, 1, resultat); hvis resultatet = 1 da i2: = i andre i2: = 0; getbuf: = getbuf eller (i2 SHL (8 - getlen)); inc (getlen, 8); ende; i2: = getbuf; getbuf: = getbuf SHL 1; desember (getlen); GetBit: = Integer ((i2 < 0)); ende;
Funksjon GetByte (GetBytes: GetBytesProc): Integer; {Få en Byte} Var j: Byte; Jeg, resultat: Word; begynne Mens (getlen < = 8) trenger begynne GetBytes (j, 1, resultat); hvis resultatet = 1 så jeg: = j annet jeg: = 0; getbuf: = getbuf eller (i SHL (8 - getlen)); inc (getlen, 8); ende; I: = getbuf; getbuf: = getbuf SHL 8; desember (getlen, 8); GetByte: = Integer (i SHR 8); enden,
Prosedyre Putcode (l: Integer; c: Word, PutBytes: PutBytesProc); {utgangs c biter} Var Temp: Byte; Fikk: Word; begynne putbuf: = putbuf eller (c SHR putlen); inc (putlen, l); if (putlen > = 8), og start Temp: = putbuf shr 8; PutBytes (Temp, 1, Got); desember (putlen, 8); if (putlen > = 8), og start Temp: = lo (putbuf); PutBytes (Temp, 1, Got); inc (codesize, 2); desember (putlen, 8); putbuf: = c SHL (l - putlen); ende ellers begynner putbuf: = putbuf SHL 8; inc (codesize); ende; ende; enden, product: {initial freq treet}
Prosedyre StartHuff; Var i, j: Integer; begynne For i: = 0 til pred (N_Char) gjør begynne freq ^ [i]: = 1; sønn ^ [i]: = i + T; PRNT ^ [i + T]: = i; ende; i: = 0; j: = N_Char; Mens (j < = R) gjør begynne freq ^ [j]: = freq ^ [i] + freq ^ [i + 1]; sønn ^ [j]: = i; PRNT ^ [i]: = j; PRNT ^ [i + 1]: = j; inc (i, 2); inc (j); ende; freq ^ [T]: = $ ffff; PRNT ^ [R]: = 0; enden, product: {rekonstruere freq treet}
Prosedyre reConst; Var i, j, k, tmp: Integer; F, L: Word; begin {halven kumulativ frekvens For løvnodene} j: = 0; For i: = 0 til pred (T) ikke begynne if (sønn ^ [i] > = T), og start freq ^ [j]: = succ (freq ^ [i]) div 2; {@@Bug Fix MOD - > div@@} sønn ^ [j]: = sønn ^ [i]; inc (j); ende; ende; {Lage et tre: Først koble barn noder} i: = 0; j: = N_Char; Mens (j < T) gjør begynne k: = succ (i); F: = freq ^ [i] + freq ^ [k]; freq ^ [j]: = F; k: = pred (j); Mens F < freq ^ [k] gjøre desember (k); inc (k); l: = (j - k) SHL 1; tmp: = succ (k); flytte (freq ^ [k], freq ^ [tmp], l); freq ^ [k]: = F; flytte (sønn ^ [k], sønn ^ [tmp], l); sønn ^ [k]: = i; inc (i, 2); inc (j); ende; {Koble foreldrenodene} For jeg: = 0 til pred (T) ikke begynne k: = sønn ^ [i]; if (k > = T), og start PRNT ^ [k]: = i; ende annet begynne PRNT ^ [k]: = i; PRNT ^ [succ (k)]: = i; ende; ende; enden, product: {oppdatering freq treet}
Prosedyre oppdatering (c: Integer); Var i, j, k, l: Integer; begynne if (freq ^ [R] = MAX_FREQ) da begynne reConst; ende; c: = PRNT ^ [c + T]; Gjenta økningen (freq ^ [c]); k: = freq ^ [c]; {Swap noder å holde treet freq bestilt} l: = succ (c); if (k > freq ^ [l]), og start Mens (k > freq ^ [l]) gjør inc (l); desember (l); freq ^ [c]: = freq ^ [l]; freq ^ [l]: = k; I: = sønn ^ [c]; PRNT ^ [i]: = l; if (I < T) så PRNT ^ [succ (i)]: = l; j: = sønn ^ [l]; sønn ^ [l]: = i; PRNT ^ [j]: = c; if (j < T) så PRNT ^ [succ (j)]: = c; sønn ^ [c]: = j; c: = l; ende; c: = PRNT ^ [c]; Inntil (c = 0); {Gjenta det Inntil nå roten} enden,
Var kode, len: Word,
Prosedyre EncodeChar (c: Word, PutBytes: PutBytesProc); Var i: Word; j, k: Integer; begynner i: = 0; j: = 0; k: = PRNT ^ [c + T]; {søke tilkoblinger fra bladnoden til roten} jeg gjentar: = i SHR 1; {If node adresse er merkelig, utgang en annen utgang 0} hvis boolsk (k og 1) og deretter økes (i, $ 8000); inc (j); k: = PRNT ^ [k]; Inntil (k = R); Putcode (j, i, PutBytes); Kode: = i; len: = j; oppdatering (c); enden,
Prosedyre EncodePosition (c: Word, PutBytes: PutBytesProc); Var i, j: Word; begynne {utgangs øvre 6 biter med kode} i: = c shr 6; j: = p_code [i]; Putcode (p_len [i], j SHL 8, PutBytes); {utgangs lavere 6 biter direkte} Putcode (6, (c og $ 3f) SHL 10, PutBytes); enden,
Prosedyre Encodeend (PutBytes: PutBytesProc); Var Temp: Byte; Fikk: Word; begynne hvis boolsk (putlen), og start Temp: = lo (putbuf SHR 8); PutBytes (Temp, 1, Got); inc (codesize); ende; enden,
Funksjon DecodeChar (GetBytes: GetBytesProc): integer; Var c: Word; begynne c: = sønn ^ [R]; {* Begynne å søke treet fra roten til bladene. * Velge node # (sønn []) hvis inngang bit = 0 * andre velger # (sønn [] + 1) (input bit = 1)} Mens (c < T) ikke begynne c: = c + GetBit (GetBytes); c: = sønn ^ [c]; ende; c: = c - T; oppdatering (c); DecodeChar: = Heltall (c); enden,
Funksjon DecodePosition (GetBytes: GetBytesProc): Word; Var i, j, c: Word; begynne {dekode øvre 6 biter fra gitt tabell} i: = GetByte (GetBytes); c: = Word (d_code [i] SHL 6); j: = d_len [i]; {inngangs lavere 6 biter direkte} desember (j, 2); Mens j < > 0 skal jeg begynne: = (i SHL 1) + GetBit (GetBytes); desember (j); ende; DecodePosition: = c eller jeg og $ 3f; enden, product: {Compression}
Prosedyre InitLZH; begynne getbuf: = 0; getlen: = 0; putlen: = 0; putbuf: = 0; Skrift: = 0; codesize: = 0; printcount: = 0; match_position: = 0; match_length: = 0; nye (lson); nye (pappa); nye (rson); nye (Text_buf); nye (freq); nye (PRNT); ny (sønn); enden,
Prosedyre endLZH; begynne kast (sønn); kast (PRNT); kast (freq); kast (Text_buf); kast (rson); kast (pappa); kast (lson); enden,
Prosedyre LZHPack (Var Bytes_Written: LongInt; GetBytes: GetBytesProc; PutBytes: PutBytesProc); Var ct: Byte; Jeg, len, R, s, last_match_length: Integer; Fikk: Word; begynne InitLZH; Skrift: = 0; {Spole tilbake og skanne} StartHuff; InitTree; s: = 0; R: = N - F; fillChar (Text_buf ^ [0], R, ''); len: = 0; Fikk: = 1; Mens (len < F) og (Got < > 0) gjør begynne GetBytes (ct, 1, Got); hvis Got < > 0 da begynne Text_buf ^ [R + len]: = ct; inc (len); ende; ende; Tekststørrelse: = len; For i: = 1 til F gjøre InsertNode (R - i); InsertNode (R); Gjenta om (match_length > len) så match_length: = len; if (match_length < = terskel) og deretter begynne match_length: = 1; EncodeChar (Text_buf ^ [R], PutBytes); ende annet begynne EncodeChar (255 - TERSKEL + match_length, PutBytes); EncodePosition (match_position, PutBytes); ende; last_match_length: = match_length; i: = 0; Fikk: = 1; Mens (i < last_match_length) og (Got < > 0) gjør begynne GetBytes (ct, 1, Got); hvis Got < > 0 da begynne DeleteNode (s); Text_buf ^ [s]: = ct; if (s < pred (F)) så Text_buf ^ [s + N]: = ct; s: = succ (e) og pred (N); R: = succ (R) og pred (N); InsertNode (R); inc (i); ende; ende; inc (skrift, i); Mens (i < last_match_length) gjør begynne økes (i); DeleteNode (s); s: = succ (e) og pred (N); R: = succ (R) og pred (N); desember (len); hvis boolsk (LEN) så InsertNode (R); ende; Inntil (len < = 0); Encodeend (PutBytes); endLZH; Bytes_Written: = skrift; enden,
Prosedyre LZHUnpack (Tekststørrelse: LongInt; GetBytes: GetBytesProc; PutBytes: PutBytesProc); Var c, i, j, k, R: Integer; c2, en: Byte; teller: LongInt; Sett: Word; begynne InitLZH; StartHuff; R: = N - F; fillChar (Text_buf ^ [0], R, ''); count: = 0; Mens count < Tekststørrelse gjør begynne c: = DecodeChar (GetBytes); if (c < 256), og start c2: = lo (c); PutBytes (c2, 1, Put); Text_buf ^ [R]: = c; inc (R); R: = R og pred (N); inc (teller); ende ellers begynner jeg: = (R - succ (DecodePosition (GetBytes))) og pred (N); j: = c - 255 + terskel, For k: = 0 til pred (j) ikke begynne c: = Text_buf ^ [(i + k) og pred (N)]; c2: = lo (c); PutBytes (c2, 1, Put); Text_buf ^ [R]: = c; inc (R); R: = R og pred (N); inc (teller); ende; ende; ende; endLZH; ende; enden.