En enkel rutine for å komprimere strenger
bidragsyter. SWAG SUPPORT TEAM product: {Du vil ikke få den slags komprimering fra mine rutiner, men her er de uansett. Når du skal teste, vil du få best mulig kompresjon hvis du bruker engelsk og langstrakte strenger. } Unit Rimer;
Interface
Const CompressedStringArraySize = 500; {Feile på siden av generøsitet}
Type tCompressedStringArray = Array [1..CompressedStringArraySize] av Byte;
Funksjon GetCompressedString (Arr: tCompressedStringArray): String;
Prosedyre CompressString (st: String; Var Arr: tCompressedStringArray; Var len: Integer); {Regner st i en tCompressedStringArray av lengde len}
Implementering
Const FreqChar: Array [4..14] av Char = 'etaonirshdl'; {Kan ikke være i [0..3] fordi to tomme biter betegne en plass}
Funksjon GetCompressedString (Arr: tCompressedStringArray): String; Var Shift: Byte; i: Integer; ch: Char; st: String; b: Byte;
Funksjon GetHalfNibble: Byte; begynne GetHalfNibble: = (Arr [i] SHR Shift) og 3; hvis Shift = 0 da begynne Shift: = 6; inc (i); ende annet desember (Shift, 2); enden,
begynne st: = ''; i: = 1; Shift: = 6; Gjenta b: = GetHalfNibble; hvis b = 0, så ch: = '' annet begynne b: = (b SHL 2) eller GetHalfNibble; hvis b = $ F deretter begynne b: = GetHalfNibble SHL 6; b: = b eller GetHalfNibble SHL 4; b: = b eller GetHalfNibble SHL 2; b: = b eller GetHalfNibble; ch: = Char (b); ende annet ch: = FreqChar [b]; ende; hvis ch < > # 0 da st: = st + ch; Inntil lm = # 0; GetCompressedString: = st; enden,
Prosedyre CompressString (st: String; Var Arr: tCompressedStringArray; Var len: Integer); {Regner st i en tCompressedStringArray av lengde len} Var i: Integer; Shift: Byte;
Prosedyre OutHalfNibble (b: Byte); begynne Arr [len]: = Arr [len] eller (b SHL Shift); hvis Shift = 0 da begynne Shift: = 6; inc (len); ende annet desember (Shift, 2); enden,
Prosedyre OutChar (ch: Char); Var i: Byte; bych: Byte Absolute ch; begynne hvis lm = '' da OutHalfNibble (0) ellers begynner jeg: = 4; Mens (i < 15) og (FreqChar [i] < > ch) gjør økes (i); OutHalfNibble (i SHR 2); OutHalfNibble (i og 3); hvis jeg = $ F deretter begynne OutHalfNibble (bych SHR 6); OutHalfNibble ((bych SHR 4) og 3); OutHalfNibble ((bych SHR 2) og 3); OutHalfNibble (bych og 3); ende; ende; enden,
begynne len: = 1; Shift: = 6; fillChar (Arr, sizeof (Arr), 0); For i: = 1 til lengde (m) gjør OutChar (st [i]); OutChar (# 0); {Slutten av komprimert String signalisert av # 0} hvis Shift = 6 deretter felles (len); enden,
slutten
.