Listing 17

//das Beispiel zeigt die Kompression nach dem LZ77 Algorhithmus

unit LZ77;

interface

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

type
  TCompress = record //Struktur des Kompressionszeigers
     Pos: Word;
     Len: Byte;
     Car: Char;
  end;
  
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Button3: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure LZ77Compress(ofn, sfn: string);
var fo, fs: file;
    fsize: Integer;
    cv, vv, po, posps: Word;
    s, p: string;
    buf: array[1..High(Word)] of Char;
    Temp: TCompress;

begin

AssignFile(fo, ofn);
{$I-}
Reset(fo, 1);
{$I+}

AssignFile(fs, sfn);
{$I-}
Rewrite(fs, 1);
{$I+}

if IOResult = 0 then
begin
//Achtung: das Beispiel kann nur Dateigrößen <= High(Word) bearbeiten !!!
fsize:=FileSize(fo);
BlockRead(fo, buf, fsize);

s:=buf;

vv:=0; po:=0;
for cv:=1 to fsize do
begin
   p:=Copy(s, vv+1, cv-vv);
   posps:=Pos(p, s);
   if (cv<fsize) and (Length(p)<256) and (posps>0) and (posps<=(vv+1)-Length(p)) then
      po:=posps
   else
   begin
      Temp.Pos:=po;
      Temp.Len:=Length(p)-1;
      Temp.Car:=s[cv];
      BlockWrite(fs, Temp, sizeof(TCompress));
      vv:=cv; po:=0;
   end;
end;

end;

CloseFile(fo);
CloseFile(fs); 
end;

procedure LZ77DeCompress(ofn, sfn: string);
var fo, fs: file;
    fsize: Integer;
    cv, vv: Word;
    s, p: string;
    buf: array[1..High(Word)] of Char;
    Temp: TCompress;

begin

AssignFile(fo, ofn);
{$I-}
Reset(fo, 1);
{$I+}

AssignFile(fs, sfn);
{$I-}
Rewrite(fs, 1);
{$I+}

if IOResult = 0 then
begin
fsize:=FileSize(fo) div sizeof(TCompress);

s:='';

for cv:=1 to fsize do
begin
   BlockRead(fo, Temp, sizeof(TCompress));

   p:='';
   if (Temp.Pos>0) and (Temp.Len>0) then p:=Copy(s, Temp.Pos, Temp.Len);
   p:=p+Temp.Car;

   s:=s+p;
end;

BlockWrite(fs, s[1], Length(s));
end;

CloseFile(fo);
CloseFile(fs);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
caption:='Kompression ...';
LZ77Compress(Edit1.Text, ChangeFileExt(Edit1.Text, '.cmp'));
caption:='OK';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
caption:='Dekompression ...';
LZ77DeCompress(ChangeFileExt(Edit1.Text, '.cmp'), ChangeFileExt(Edit1.Text, 'Kopie'+ExtractFileExt(Edit1.Text)));
caption:='OK';
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
if OpenDialog1.execute then
   Edit1.Text:=OpenDialog1.FileName;
end;

end.