unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
PPhrase=^TPhrase;
TPhrase=array of char;

type
PLZWTABLE=^TLZWTABLE;
TLZWTABLE=array [0..4095] of TPhrase;

var
  Form1: TForm1;
  lzw_table: TLZWTable;
  tablecurrentlimit: dword=256;
  msg: string='TOBEORNOTTOBETOBEORNOTTOBE';
  cur: dword=0;
  phrase, tempphrase: TPhrase;
  outmsg: array [0..4095] of char;
  currbite: dword=0;
  currbyte: byte=0;
  halfflag: bool=false;
  Data: byte;
  bitcount: dword=0;

implementation

{$R *.dfm}

function GetMaxBit(Value: dword): dword; assembler;
asm
 push ECX
 push EDX
 mov EAX, Value
 mov ECX, 32
 xor EDX, EDX
 @testbit:
  shl EAX, 1
  jnc @NextBit
   mov ECX, 1
  @NextBit:
 inc EDX
 dec ECX
 jnz @testbit
 mov EAX, EDX
 mov EDX, 32
 sub EDX, EAX
 mov EAX, EDX
 inc EAX
 pop EDX
 pop ECX
end;

function GetChar(): char;
begin
 result:=msg[cur+1];
 inc(cur);
end;

procedure InitLZWTable(lzw_table: PLZWTABLE);
var i: dword;
begin
 for i:=0 to 255 do
 begin
  SetLength(lzw_table[i], 1);
  lzw_table[i][0]:=char(i);
 end;
end;

function IsPhraseExistsInTable(phrase: PPhrase; lzw_table: PLZWTable): dword;
var lt, lp, i, c: dword; cmpf: bool;
begin
 result:=dword(-1);
 lp:=length(phrase^);
 if (lp=0) then exit;
 for i:=0 to 4095 do // перебор цепочек в таблице
 begin
  lt:=length(lzw_table[i]);
  if (lt=lp) then  // посимвольное сравнение при условии совпадения длин
  begin
   cmpf:=true;
   for c:=0 to lt-1 do
   begin
    if phrase^[c]<>lzw_table[i][c] then
    begin
     cmpf:=false;
     break;
    end;
   end;
   if cmpf then
   begin
    result:=i;
    break;
   end;
  end;
 end;
end;

procedure AddSymToPhrase(buf: PPhrase; sym: char);
var l: dword;
begin
 l:=length(buf^);
 inc(l);
 SetLength(buf^, l);
 buf^[l-1]:=sym;
end;

procedure PutCode2Out(Code: dword; NBits: dword);
var b, i: dword;
begin
 data:=0;
 for i:=0 to nbits-1 do
 begin
  b:=(code shr nbits-currbite) and 1;
  data:=(data shl 1) or b;
  inc(currbite);
  if currbite=8 then
  begin
   outmsg[currbyte]:=char(data);
   inc(currbyte);
   data:=0;
   currbite:=0;
  end;
 end;
end;

procedure SkipPhrase(Phrase: PPhrase);
var l: dword;
begin
 l:=length(Phrase^);
 Phrase^[0]:=Phrase^[l-1];
 SetLength(Phrase^, 1);
end;

procedure AddPhrase2Table(lzw_table: PLZWTable; Phrase: PPhrase);
var l, i: dword;
begin
 if tablecurrentlimit=4095 then
 begin
  // table overload
 end;
 inc(tablecurrentlimit);
 l:=length(Phrase^);
 SetLength(lzw_table^[tablecurrentlimit-1], l);
 for i:=0 to l-1 do lzw_table^[tablecurrentlimit-1][i]:=Phrase^[i];
end;

procedure TForm1.Button1Click(Sender: TObject);
var i, l, Code, LastCode: dword; sym: char;
begin
 InitLZWTable(@lzw_table);  // начальная инициализация таблицы цепочек 8 битными цепочками
 l:=length(msg);
 for i:=0 to l do
 begin
  sym:=GetChar();
  AddSymToPhrase(@phrase, sym); // добавляем K к [.c.]
  if IsPhraseExistsInTable(@phrase, @lzw_table)=dword(-1) then // проверка водит ли [.c.]K в таблицу цепочек
  begin
   tempphrase:=phrase;
   SetLength(tempphrase, length(tempphrase)-1); // обрезаем последний символ (оставить только [.c]!!!)
   Code:=IsPhraseExistsInTable(@tempphrase, @lzw_table); // получить код цепочки (без последнего символа) в таблице, так как [.c.] заведомо входит в теблицу
   PutCode2Out(Code, GetMaxBit(tablecurrentlimit)); // определение длинны кода и вывод кода произвольной длинны в буффер
   AddPhrase2Table(@lzw_table, @phrase); // добавить цепочку в таблицу цепочек
   SkipPhrase(@phrase); // оставить в цепочке последний символ
  end;
 end;
end;

end.