Рефераты. Коллекция рефератов


  Пример: Управление бизнесом
Я ищу:


Реферат: Архиватор. Метод Хаффмана

ВЕДЕНИЕ

Главной причиной разработки программы " Сжатие данных по методу Хаффмана " явилось то что сжатие сокращает объем пространства, требуемого для хранения файлов в ЭВМ.

Существует много всяких причин выделять ресурсы Эвм в расчете на сжатое представление, т.к. более быстрая передача данных и сокращение пространства для их хранения позволяют сберечь значительные средства и за частую улучшить показатели ЭВМ.

Сжатие вероятно будет оставаться в сфере внимания из-за все возрастающих объемов хранимых и передаваемых данных в ЭВМ , кроме того можно использовать для преодоления некоторых физических ограничений, таких как, например, сравнительно низкая ширина пропускания телефонных каналов.

1 ТЕХНИЧЕСКОЕ ЗАДАНИЕ

1.1 Цель и назначение разработки

Целью данного курсового проекта является создание программного продукта, который носит название " Сжатие данных по методу Хаффмана".

1.2 Основные теоретические посылки и обоснование разработки

Существует большое количество архиваторов.

Но для работы с современными подобными программами устанавливаются высокие требования к аппаратным и техническим средствам. Поэтому возникла проблема в написании программы на компьютеры с микропроцессором 8086, 286, 386 с объемом оперативной памяти менее 4Мб и отсутствия такой операционной системы (ОС) как Windows.

Решением стало создание программы как Vitter.exe

1.3 Назначение программы

Программный продукт Vitter.exe предназначен для архивирования данных.

1.4 Основные требования к программе, исходным данным и результатам

Программа должна выполнять следующие функции:

- Запрос на архивирование файлов или на разархивацию файлов;

1.5 Аппаратно-технические средства, ОС и язык программирования, необходимые для разработки программного продукта

Для работы программы необходимо иметь следующие аппаратно-технические средства:

- ОП не менее 1Мб;

- Не менее 15 Кб свободного дискового пространства;

Для использования Vitter.exe нет необходимости в наличии ОС как Windows 3.x (95/NT), достаточно иметь OC MS-DOS.

Для написания программы планируется использовать такие языки программирования как Turbo Pascal.

1.6 Требования к маркировке и упаковке

Общими требованиями к маркировке и упаковке программного продукта являются:

- программный продукт должен поставляться на дискетах (3,5 дюйма) емкостью 1.44 МБайта с соответствующими обозначениями:

- производителя данного программного продукта;

- полным названием программного продукта;

- исполнимый файл Vitter.exe;

2 ОПИСАНИЕ ПРИМЕНЕНИЯ

2.1 Назначение программы

Программный продукт «Программа генерации произвольных форм выходных документов» предназначен для создания форм в интерфейсе текстового редактора, возможностью сохранять их в данном формате с дальнейшим заполнением и распечаткой форм.

Программный продукт создает файлы в данном формате *.mff, а также предоставляе возможность отредактировать созданую рание форму, заполнить ее и в конце вывести готовую форму на печать.

3.2 Условия применения

Программный продукт может эксплуатироваться на компьютерах IBM или совместимых с ЦП Intel-80486 с объемом оперативной памяти не менее 1 МБайт и свободным дисковым пространством не менее 15 КБайт.

Программа функционирует под управлением ОС MS-DOS версии 6.22, Windows 3.x/95/98/NT.

Входная информация для программы представляется задание пользователем имени файла который нужно сжать.

Выходная информация - файлы (с расширением *.vit).

Программа может работать на компьютерах, технические характеристики которых согласуются с выше указанными аппаратно-техническими требованиями.

3.3 Входные и выходные данные

Входными данными для программного продукта является имя файла который необходимо сжать.

Выходными данными является файл (с расширением *.vit).

4 ОПИСАНИЕ ПРОГРАММЫ

4.1 Общие сведения

Программный продукт имеет название «Программа генерации произвольных форм выходных документов». Программа реализована в программной среде Borland Pascal 7.0 с использованием вставок на языке Ассемблера и функционирует под управлением ОС MS-DOS версии 6.22, Windows 3.x/95/98/NT.

4.2 Описание процедур и функций

Процедура initialize- процедура строит начальное дерево.

Функция findchild(J,Parity: Integer): integer - функция возвращает номер узла.

Процедура Update (k:char) - изменяет динамическое дерево Хаффмана.

Процедура SlideAndincrement - это процедура корректирует указатели.

Процедура Transmit - для передачи данных.

Процедура EncodeAndTranmit- для декодирования и передачи данных.

Процедура DumpSyntax - для вывода информации.

5 РУКОВОДСТВО ПРОГРАМИСТА

5.1 Назначение и условия применения программы

Программный продукт «Сжатие данных по методу Хаффмана» предназначен для архивации текстовых и исполнимых файлов

Для того чтобы программа нормально функционировала необходимо соблюдать следующие требования к аппаратным и програмным средствам:

- компьютер типа IBM PC или совместимый с ЦП не мение 8086 и оперативной памятью 1 Мб;

- операционныя система MS-DOS не рание версии 3.2;

- накопитель на ГМД или ЖМД

5.2 Обращение к программе

Обращения к программе происходят посредством:

- запуска исполнимого файла form.exe из командной строки DOS путем набора в ней имени архиватора и файла который нужно заархивировать;

- запуска исполнимого файла Vitter.exe с помощью любой программы-оболочки для работы с DOS (Norton Commander, Volcov Commander, Dos Navigator или другие);

- запуска исполнимого файла любыми средства операционной системы Windows, предназначенными для осуществления запуска программ, например через программу программы-оболочки Far-Manager и Windows Commander или любые другие.

6 РУКОВОДСТВО СИСТЕМНОГО ПРОГРАММИСТА

6.1 Общие сведения о программе

Программный продукт имеет название «Сжатие данных по методу Хаффмана». Функционирует программа под управлением ОС MS-DOS версии 6.22, Windows 3.x/95/98/NT.

Функции программы:

- сжатие файла и запись его на диск.

-  персональный компьютер IBM или совместимый с ЦП Intel 80386 и выше;

-  оперативная память не менее 1 Мбайт;

-  свободное пространство на жестком диске (винчестере) не менее 15 Кбайта;

- какая-либо из перечисленных выше ОС.

7 РУКОВОДСТВО ОПЕРАТОРА

Для начала работы с программой необходимо ее загрузить, на диске она сохраняется под именем vitter.exe. После запуска программы на экране появится параметры запуска архиватора:

VITTER.EXE <ИМЯ АРХИВИРУЕМОГО ФАЙЛА>

После тога как пользователь укажет через пробел имя фала который он хочет сжать и запустит программу программы начнет производить архивацию этого файла.

После окончания работы программы на диске появится архивный файл <имя файла. Vit >

СПИСОК ИСПОЛЬЗОВАННОЙ ЛИТЕРАТУРЫ

www.syr.webzone.ru/pp/algorithms/compress/huffman.htm

www. www.syr.webzone.ru/pp/algorithms/compress/tree_with.htm

www.freebsd.org/huffman.htm

Кнут 3 том `Алгоритмы сортировки и поиска данных`

'Программирование на языке Турбо Паскаль' Киев BDJ -1996 г. ЗАКЛЮЧЕНИЕ В процессе выполнения курсового проекта был создан программный продукт, имеющий название «Сжатие данных по методу Хаффмана». Программный продукт был протестирован и на основании его испытания был сделан вывод о том, что программа полностью отвечает техническим требованиям на разработку, которые были поставлены перед программистом, и может применяться пользователями персональных компьютерах для создания и заполнения форм выходных документов. Программа написана на языке высокого уровня Borland Pascal 7.0, который позволяет пользователю хорошо ориентороваться в программе и делает программный продукт легко доступным для понимания.

ПРИЛОЖЕНИЕ А ------------------------ МЕНЮ ПРОГРАММЫ --------------------------- Vitek 1.01

The correct syntax for this program is

Vitek

If the file specified is not a VitekPack file it will be compressed.

Copyright 2000 (c) Denis Belous. S.System Group. All Right Reserved

Приложение Б

Результат работы программы

+------------ C:\ART\temp -------------++------------ C:\ART\temp ---------15:16

¦n Name ¦ Size ¦¦n Name ¦ Size ¦

¦.. ¦< Up >-¦.. ¦< Up >-

¦vitter.exe ¦ 12272_¦vitter.exe ¦ 12272_

¦zd1.pas ¦ 3985_¦zd1.pas ¦ 3985_

¦zd1.vit ¦ 2507_¦zd1.vit ¦ 2507_

¦--------- Evaluation version ---------¦¦--------- Evaluation version ---------¦

¦.. < Up > 01.12.00 15:16¦¦.. < Up > 01.12.00 15:16¦

+----- 18,764 (3) --- 322,830,336 -----++----- 18,764 (3) --- 322,830,336 -----+

C:\ART\temp>

1Left 2Right 3View.. 4Edit.. 5Print 6MkLink 7Find 8Histry 9Video 10Tree

Приложение С

Program Vitek;

{$R-}

uses CRT,DOS;

CONST

CharBufSize = 2048; { I/O Buffer. }

WordBufSize = 1024; { I/O Buffer. }

N = 256; { Alphabet size. 256 chars in ASCII }

TYPE

Vitter_Header_Type = RECORD { 17 bytes in size. }

Name : String[12];

FSize : LongInt;

END;

CharBuffer = Array[0..PRED(CharBufSize)] OF Char;

WordBuffer = Array[0..PRED(WordBufSize)] OF WORD;

CONST

Bytes_Left : BOOLEAN = TRUE;

{ Передача . }

OBufPosn : Word = 0;

WriteWord : Word = 0;

WShifts : WORD = 15;

{ Прием. }

BufRead : Integer = 0;

BufPosn : Integer = 0;

Shifts : WORD = 0;

ReadWord: WORD = 0;

VAR

Header : Vitter_Header_Type;

Alpha : Array[0..N] OF WORD;

Rep : Array[0..N] OF Integer;

Block : Array[1..2*N-1] OF Integer;

Weight : Array[1..2*N-1] OF LongInt;

Parent : Array[1..2*N-1] OF Integer;

Parity : Array[1..2*N-1] OF Integer;

RtChild : Array[1..2*N-1] OF Integer;

First : Array[1..2*N-1] OF Integer;

Last : Array[1..2*N-1] OF Integer;

PrevBlock : Array[1..2*N-1] OF Integer;

NextBlock : Array[1..2*N-1] OF Integer;

Stack : Array[1..2*N-1] OF Integer;

AvailBlock : Integer;

M,E,R,Z : Integer;

CInBuf,COutBuf : ^CharBuffer;

WInBuf,WOutBuf : ^WordBuffer;

VitFile,InFile,OutFile : File;

FileName : String[12];

Dir: DirStr;

Name: NameStr;

Ext: ExtStr;

FoundFile : SearchRec;

Ch : Char;

Procedure Initialize;

{

Эта процедура строит начальное дерево Хаффмана, состоящее из одиночного листа, с 0 вершинами.

Глобальная переменная Z всегда равна 2n-1.

}

VAR

I : Integer;

BEGIN

Bytes_Left := TRUE;

OBufPosn := 0; { Передача переменной }

WriteWord := 0;

WShifts := 15;

BufRead := 0; { Прием переменной }

BufPosn := 0;

Shifts := 0;

ReadWord:= 0;

M := 0;

E := 0;

R := -1;

Z := 2*N -1;

Alpha[0] := 0;

Rep[0] := 0;

FOR I := 1 TO N DO

BEGIN

INC(M);

INC(R);

IF R*2 = M THEN

BEGIN

INC(E);

R := 0;

END;

Alpha[I] := I;

Rep[I] := I;

END;

{ Инициализируйте вершиы N }

Block[N] := 1;

PrevBlock[1] := 1;

NextBlock[1] := 1;

Weight[1] := 0;

First[1] := N;

Last[1] := N;

Parity[1] := 0;

Parent[1] := 0;

{ Инициализация блочного списка }

AvailBlock := 2;

FOR I := AvailBlock to Z-1 DO

NextBlock[I] := I+1;

NextBlock[Z] := 0;

END;

Function FindChild(J,Parity: Integer):Integer;

{

Этот функция возвращает номер узла левого или правильного узла ,

в зависимости от того, является ли параметр четности множеством к 0 или 1.

}

VAR

Delta, Right, Gap : Integer;

BEGIN

Delta := 2*(First[Block[J]] - J) + 1 - parity;

Right := rtChild[Block[J]];

Gap := Right - Last[Block[Right]];

IF Delta <= Gap THEN

FindChild := Right - Delta

ELSE

BEGIN

DEC(Delta,SUCC(Gap));

Right := First[PrevBlock[Block[Right]]];

Gap := Right - Last[Block[Right]];

IF Delta <= Gap THEN

FindChild := Right - Delta

ELSE FindChild := First[PrevBlock[Block[Right]]] - Delta + Gap + 1;

END;

END;

Procedure InterchangeLeaves(E1,E2 : Integer);

VAR

Temp : Integer;

BEGIN

Rep[Alpha[E1]] := E2;

Rep[Alpha[E2]] := E1;

Temp := Alpha[E1];

Alpha[E1] := Alpha[E2];

Alpha[E2] := Temp;

END;

Procedure Update(K : Char);

{

Эта процедура - основной компонент алгоритма.

Они названы 'EncodeAndTransmit' и 'ReceiveAndDecode', чтобы изменить динамическое дерево Хаффмана,

чтобы объяснить только обработанный символ.

}

VAR

Q,LeafToIncrement,Bq,B,OldParent,OldParity,Nbq,Par,Bpar : Integer;

Slide : Boolean;

Procedure FindNode;

{

Эта процедура устанавливает Добротность, чтобы обрабатывать лист.

Если тот лист с 0 вершинаой, который соответствует передаче символа,

который не был передан ранее в сообщении, с 0 вершиной то начинается разбиение,

чтобы сформировать дополнительный лист, если имеется все еще непереданный символ, левый в первичном коде.

Иначе, Q будет обменяна.

}

BEGIN

Q := Rep[Byte(K)];

LeafToIncrement := 0;

IF q <=M THEN { Ноль становится положительным. }

BEGIN

InterchangeLeaves(Q,M);

IF R = 0 THEN

BEGIN

R := M DIV 2;

IF R > 0 THEN

E := E - 1;

END;

M := M-1;

R := R-1;

Q := SUCC(M);

Bq := Block[Q];

IF M > 0 THEN

BEGIN

{

Разбеиение с 0 вершины на внутреннюю вершину с двумя дочерними записями.

Новая М.; старая M+1; новые родительские вершины М. и M+1 - вершина M+N

}

Block[M] := Bq;

Last[Bq] := M;

OldParent := Parent[Bq];

Parent[Bq] := M+N;

Parity[Bq] := 1;

{Создается новый внутренний блок для вершины М. + N }

B := AvailBlock;

AvailBlock := NextBlock[AvailBlock];

PrevBlock[B] := Bq;

NextBlock[B] := NextBlock[Bq];

PrevBlock[NextBlock[Bq]] := B;

NextBlock[Bq] := B;

Parent[B] := OldParent;

Parity[B] := 0;

RtChild[B] := Q;

Block[M+N] := B;

Weight[B] := 0;

First[B] := M + N;

Last[B] := M + N;

LeafToIncrement := Q;

Q := M + N;

END;

END

ELSE {обмена с первой вершиной в блоке q }

BEGIN

InterchangeLeaves(Q,First[Block[Q]]);

Q := First[Block[Q]];

IF (Q= SUCC(M)) AND (M>0) THEN

BEGIN

LeafToIncrement := Q;

Q := Parent[Block[Q]];

END;

END;

END;

Procedure SlideAndIncrement;

{

Эта процедура корректирует древесные указатели, чтобы отразить новую подразумеваемую нумерацию.

Наконец, Q- множество, направляет на вершинуодин уровень выше в дереве, которое нуждается в приращении затем.

}

BEGIN { Q является в настоящее время первой вершиной в ее блоке. }

Bq := Block[Q];

Nbq := nextBlock[Bq];

Par := Parent[Bq];

OldParent := Par;

OldParity := Parity[Bq];

IF ((Q<=N) AND (First[Nbq] > N) AND (Weight[Nbq] = Weight[Bq])) OR

((Q>N) AND (First[Nbq] <= N) AND (Weight[Nbq] = SUCC(Weight[Bq]))) THEN

BEGIN { Скольжение по следующему Блоку }

Slide := TRUE;

OldParent := Parent[Nbq];

OldParity := Parity[Nbq];

{ Корректируется дочерние указатели для следующего верхнего уровня в дереве. }

IF Par > 0 THEN

BEGIN

Bpar := Block[Par];

IF RtChild[BPar] = Q THEN

RtChild[BPar] := Last[Nbq]

ELSE IF RtChild[BPar] = First[Nbq] THEN

RtChild[Bpar] := Q

ELSE RtChild[Bpar] := SUCC(RtChild[Bpar]);

IF Par <> Z THEN

IF Block[SUCC(Par)] <> Bpar THEN

IF RtChild[Block[SUCC(Par)]] = First[Nbq] THEN

RtChild[Block[SUCC(Par)]] := Q

ELSE IF Block[RtChild[Block[SUCC(Par)]]] = Nbq THEN

RtChild[Block[SUCC(Par)]] := SUCC(RtChild[Block[SUCC(Par)]]);

END;

{ Корректируются исходные указатели для блока Nbq }

Parent[Nbq] := Parent[Nbq] -1 + Parity[Nbq];

Parity[Nbq] := 1 - Parity[Nbq];

Nbq := NextBlock[Nbq];

END

ELSE Slide := FALSE;

IF (((Q <= N) AND (First[Nbq] <= N)) OR ((Q>N) AND (First[Nbq] > N))) AND

(Weight[Nbq] = SUCC(Weight[Bq])) THEN

BEGIN { Слияние Q в блок }

Block[Q] := Nbq;

Last[Nbq] := Q;

IF Last[Bq] = Q THEN { Старый блок Q удаляется}

BEGIN

NextBlock[PrevBlock[Bq]] := NextBlock[Bq];

PrevBlock[NextBlock[Bq]] := PrevBlock[Bq];

NextBlock[Bq] := AvailBlock;

AvailBlock := Bq;

END

ELSE

BEGIN

IF Q > N THEN

RtChild[Bq] := FindChild(PRED(Q),1);

IF Parity[Bq] = 0 THEN

DEC(Parent[Bq]);

Parity[Bq] := 1 - Parity[Bq];

First[Bq] := PRED(Q);

END;

END

ELSE IF Last[Bq] = Q THEN

BEGIN

IF Slide THEN { Блок Q двигается вперед в блочном списке}

BEGIN

PrevBlock[NextBlock[Bq]] := PrevBlock[Bq];

NextBlock[PrevBlock[Bq]] := NextBlock[Bq];

PrevBlock[Bq] := PrevBlock[Nbq];

NextBlock[Bq] := Nbq;

PrevBlock[Nbq] := Bq;

NextBlock[PrevBlock[Bq]] := Bq;

Parent[Bq] := OldParent;

Parity[Bq] := OldParity;

END;

INC(Weight[Bq]);

END

ELSE { Создание нового блока для Q. }

BEGIN

B := AvailBlock;

AvailBlock := nextBlock[AvailBlock];

Block[Q] := B;

First[B] := Q;

last[B] := Q;

IF Q > N THEN

BEGIN

RtChild[B] := RtChild[Bq];

RtChild[Bq] := FindChild(Pred(Q),1);

IF RtChild[B] = PRED(Q) THEN

Parent[Bq] := Q

ELSE IF Parity[Bq] = 0 THEN

DEC(Parent[Bq]);

END

ELSE IF Parity[Bq] = 0 THEN

DEC(Parent[Bq]);

First[Bq] := PRED(Q);

Parity[Bq] := 1 - Parity[Bq];

{ Маркируется место для Q в блочном списке }

PrevBlock[B] := PrevBlock[Nbq];

NextBlock[B] := Nbq;

PrevBlock[Nbq] := B;

NextBlock[PrevBlock[B]] := B;

Weight[B] := SUCC(Weight[Bq]);

Parent[B] := OldParent;

Parity[B] := OldParity;

END;

{ Q передвигается на уровень выше в дереве}

IF Q <= N THEN

Q := OldParent

ELSE Q := Par;

END;

BEGIN

FindNode;

WHILE Q > 0 DO

IF LeaftoIncrement <> 0 THEN

BEGIN

Q := LeafToIncrement;

SlideAndIncrement;

END;

END;

Procedure Transmit(I : Integer);

CONST

One = 32768;

BEGIN

IF I = 1 THEN

INC(WriteWord,One);

WriteWord := WriteWord SHR 1;

DEC(WShifts);

IF WSHifts = 0 THEN

BEGIN

WOutBuf^[OBufPosn] := WriteWord;

IF OBufPosn = PRED(WordBufSize) THEN

BEGIN

BlockWrite(OutFile,WOutBuf^,2*WordBufSize,OBufPosn);

Write('-');

OBufPosn := 0;

END

ELSE INC(OBufPosn);

WShifts := 15;

END;

END;

Procedure EncodeAndTransmit(J: Char);

VAR

I,II,Q,T,Root : Integer;

BEGIN

Q := Rep[ORD(J)];

I := 0;

IF Q <= M THEN { Декодирование буквы }

BEGIN

DEC(Q);

IF Q < 2*R THEN

T := SUCC(E)

ELSE

BEGIN

DEC(Q,R);

T := E;

END;

FOR II := 1 to T DO

BEGIN

INC(I);

Stack[I] := Q MOD 2;

Q := Q DIV 2;

END;

Q := M;

END;

IF M = N THEN

Root := N

ELSE Root := Z;

While Q <> Root DO

BEGIN

INC(I);

Stack[I] := (First[Block[Q]]-Q+Parity[BLock[Q]]) MOD 2;

Q := Parent[Block[Q]]-(First[Block[Q]]-Q+1-Parity[Block[Q]]) DIV 2;

END;

FOR II := I DOWNTO 1 DO

Transmit(Stack[II]);

END;

Function Receive: WORD;

BEGIN

IF (BufPosn = BufRead) AND (Shifts = 0) THEN

BEGIN

BlockRead(InFile,WInBuf^,2*WordBufSize,BufRead);

BufRead := BufRead DIV 2;

Write('+');

If BufRead = 0 THEN Bytes_Left := FALSE;

BufPosn := 0;

END;

IF Shifts = 0 THEN

BEGIN

ReadWord := WInBuf^[BufPosn];

INC(BufPosn);

Shifts := 15;

END;

IF BOOLEAN(ReadWord AND 1) THEN

Receive := 1

ELSE Receive := 0;

DEC(Shifts);

ReadWord := ReadWord SHR 1;

END;

Function ReceiveAndDecode: Word;

VAR

I,Q : Integer;

BEGIN

IF M = N THEN

Q:= N

ELSE Q := Z;

WHILE Q > N DO { передвижение в низ по дереву. }

Q := FindChild(Q,Receive);

IF Q = M THEN

BEGIN

Q := 0;

FOR I := 1 to E DO

Q := Q*2+Receive;

IF Q < R THEN

Q := Q*2 + Receive

ELSE INC(Q,R);

INC(Q);

END;

ReceiveAndDecode := Alpha[Q];

END;

Procedure Encode;

CONST

BufRead : Word = 0;

BufPosn : Word = 0;

VAR

X : Word;

BEGIN

Initialize;

BlockRead(InFile,CInBuf^,CharBufSize,BufRead);

If BufRead = 0 THEN Bytes_Left := FALSE;

BufPosn := 0;

WHILE Bytes_Left DO { Продолэженние пока все символы не будут декодированы. }

BEGIN

EncodeAndTransmit(CInBuf^[BufPosn]);

Update(CInBuf^[BufPosn]);

INC(BufPosn);

IF BufPosn = BufRead THEN

BEGIN

BlockRead(InFile,CInBuf^,CharBufSize,BufRead);

If BufRead = 0 THEN Bytes_Left := FALSE;

BufPosn := 0;

END;

END;

FOR X := WShifts DownTO 1 DO

WriteWord := WriteWord SHR 1;

WOutBuf^[OBufPosn] := WriteWord;

INC(OBufPosn);

BlockWrite(OutFile,WOutBuf^,2*OBufPosn,OBufPosn);

END;

Procedure Decode(FSize: LongInt);

Var

BufPosn : Word;

X : LongInt;

BEGIN

Initialize;

BufPosn := 0;

FOR X := PRED(FSize) DOWNTO 0 DO

BEGIN

COutBuf^[BufPosn] := Char(ReceiveAndDecode);

Update(CoutBuf^[BufPosn]);

IF BufPosn = PRED(CharBufSize) THEN

BEGIN

BlockWrite(OutFile,COutBuf^,SUCC(BufPosn),BufPosn);

BufPosn := 0;

END

ELSE INC(BufPosn);

END;

BlockWrite(OutFile,COutBuf^,BufPosn,BufPosn);

END;

Procedure DumpSyntax;

BEGIN

CLRSCR;

GotoXY(5,3); Writeln('Vitek 1.01');

GotoXY(5,5); Writeln('The correct syntax for this program is:');

GotoXY(8,7); Writeln('Vitek ');

GotoXY(5,9); Writeln('If the file specified is not a VitekPack file it will be compressed.');

GotoXY(5,10); Writeln('Copyright 2000 (c) Denis Belous. S.System Group. All Right Reserved .');

END;

BEGIN

IF Paramcount < 1 THEN

BEGIN

DumpSyntax;

HALT;

END;

Filename := ParamStr(1);

FSplit(Filename,Dir,Name,Ext);

FOR Z := 1 TO 4 DO

Ext[Z] := Upcase(Ext[Z]);

IF (Ext <> '.VIT') AND (Ext <> '.') AND(Ext <> '') THEN { Compress. }

BEGIN

New(CInBuf);

New(WOutBuf);

Header.Name := Name + Ext;

Assign(Infile,Filename);

Assign(OutFile,Name + '.Vit');

RESET(InFile,1); { used for compression }

REwrite(OutFile,1);

Header.FSize := FIleSize(InFile);

BlockWrite(OutFile,Header,SizeOf(Header),Z); { Save space for the header. }

Encode;

Close(Infile);

Close(outfile);

Dispose(CInBuf);

Dispose(WOutBuf);

END

ELSE { Decompress. }

BEGIN

New(WInBuf);

New(COutBuf);

Assign(Infile,Name + '.VIT');

Reset(InFile,1);

Blockread(InFile,Header,SizeOf(Header),Z);

FindFirst(Header.Name,$27,Foundfile); { See if the file to be decompressed }

If DOSError = 0 THEN { already exists. }

BEGIN

Writeln(Header.Name,' already exists, decompress anyway ? (Y/N)');

Ch := Readkey;

IF NOT (Ch IN ['y','Y']) THEN HALT;

END;

Assign(OutFile,Header.Name);

ReWrite(OutFile,1); { used for decompression }

Decode(Header.FSize);

Close(Outfile);

Close(Infile);

Dispose(WInBuf);

Dispose(COutBuf);

END;

END.