Реферат Delphi. Трохи щодо методів упаковки даних

м ущільнення даних за методом *}

{* Хафмана. *} p> {********************************************** ********}

Program Hafman;

Uses Crt, Dos, Printer;

Type PCodElement = ^ CodElement;

CodElement = record

NewLeft, NewRight,

P0, P1: PCodElement; {елемент входить одночасно}

LengthBiteChain: byte; {в масив, чергу і дерево}

BiteChain: word;

CounterEnter: word;

Key: boolean;

Index: byte;

end;

TCodeTable = array [0 .. 255] of PCodElement;

Var CurPoint, HelpPoint,

LeftRange, RightRange: PCodElement;

CodeTable: TCodeTable;

Root: PCodElement;

InputF, OutputF, InterF: file;

TimeUnPakFile: longint;

AttrUnPakFile: word;

NumRead, NumWritten: Word;

InBuf: array [0 .. 10239] of byte;

OutBuf: array [0 .. 10239] of byte;

BiteChain: word;

CRC,

CounterBite: byte;

OutCounter: word;

InCounter: word;

OutWord: word;

St: string;

LengthOutFile, LengthArcFile: longint;

Create: boolean;

NormalWork: boolean;

ErrorByte: byte;

DeleteFile: boolean;

{---------------------------------------------- ---}

procedure ErrorMessage;

{--- висновок повідомлення про помилку ---}

begin

If ErrorByte 0 then

begin

Case ErrorByte of

2: Writeln ('File not found ...');

3: Writeln ('Path not found ...');

5: Writeln ('Access denied ...');

6: Writeln ('Invalid handle ...');

8: Writeln ('Not enough memory ... '); p> 10: Writeln ('Invalid environment ... '); p> 11: Writeln ('Invalid format ...');

18: Writeln ('No more files ...');

else Writeln ('Error #', ErrorByte, ' ... '); p> end;

NormalWork: = False;

ErrorByte: = 0;

end;

end;

procedure ResetFile;

{--- відкриття файлу для архівації ---}

Var St: string;

begin

Assign (InputF, ParamStr (3));

Reset (InputF, 1);

ErrorByte: = IOResult;

ErrorMessage;

If NormalWork then Writeln ('Pak file : ', ParamStr (3),' ... ');

end;

procedure ResetArchiv;

{ --- Відкриття файлу архіву, або його створення ---}

begin

St: = ParamStr (2);

If Pos ('.', St) 0 then Delete (St, Pos ('.', St), 4);

St: = St + '. vsg';

Assign (OutputF, St);

Reset (OutPutF, 1);

Create: = False;

If IOResult = 2 then

begin

Rewrite (OutputF, 1);

Create: = True;

end;

If NormalWork then

If Create then Writeln ('Create archiv: ', St,' ... ')

else Writeln...