Курсовая: Архиватор

РЕФЕРАТ
Обетом проектирования данной курсовой работы является У Сжатие данных по
методу Хаффмана Ф, целью которого  является сжатия различных файлов.
Программа создана на языке высокого уровня Турбо-Паскаль фирмы Borland.
Входными данными к программе является дынные который неоходимо сжать.
Техническими требованиями для использования данной системы это: ЭВМ IBM PC
совместимый, с ЦП не менее 180286 с объёмом ОП не менее 1МБ.
Загрузку системы можно производить с системной дискеты.
Все требования к программному продукту, которые были указаны в техническом
задании, были полностью выполнены.
                                СОДЕРЖАНИЕ                                
Задание на курсовой проект ....................
Реферат...............................
Введиние.............................
1 Техническое задание .......................
2 Описание применения ......................
3 Описание программы .......................
4 Руководство программиста ......................
5 Руководство системного программиста ................
6 Руководство пользователя ....................
Заключение ...........................
Список использованной литературы .................
Приложение А ...........................
Приложение Б ..........................
Приложение С ..........................
Приложение Д ..........................
                                 ВЕДЕНИЕ                                 
Главной причиной разработки программы У Сжатие данных по методу Хаффмана Ф
явилось  то что сжатие сокращает объем пространства, требуемого для хранения
файлов в ЭВМ.
Существует много всяких причин выделять ресурсы Эвм в расчете на сжатое
представление, т.к. более быстрая передача данных и сокращение пространства
для их хранения позволяют сберечь значительные средства и за частую улучшить
показатели ЭВМ.
Сжатие вероятно будет оставаться в сфере внимания из-за все возрастающих
объемов хранимых и передаваемых данных в ЭВМ , кроме того можно использовать
для преодоления некоторых физических ограничений, таких как, например,
сравнительно низкая ширина пропускания телефонных каналов.
                          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 <Filename>                             
      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 <Filename>');
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.