Function sizeofile(t:file of byte):integer;//размер файла
var s:byte;
s1:string;
begin
Reset(t);
while not eof(t) do //пока не дошли до конца файла
begin
read(t,s);//считываем 
s1:=s1+inttostr(s);//переводим в строку
end;
result:=length(s1);//длина символов
end;
function encode:string;
var
s:byte;
i:integer;
j:integer;
k:string;
s1:string;
size1,size2:integer;
index:integer;
inputfile:file of byte;
 outfile:TextFile;
 resultfile:file of byte;
 res:TextFile;
begin
assignFile(inputfile,'1.bmp');//связываем переменную с файлом
assignFile(outfile,'oufile.txt');
assignfile(resultfile,'result.bmp');
assignfile(res,'res.txt');
rewrite(res);//создаем если нет и перезаписываем файл
size1:=sizeofile(inputfile);//размер файла
Reset(inputfile);//открываем файл для чтения
Rewrite(outfile);
Rewrite(resultfile);
i:=1;
k:='';
 i := 1;
 k:='';
 while not Eof(inputfile)do
 begin
 inc(index);
 read(inputfile,s);
 s1:=s1+inttostr(s);
 end;
 writeln('Исходная цепочка байтов: ',s1);
 s1:=s1+' ';
 if eof(inputfile)then
 while (i <=length(s1)-1) do
 begin
 j := 1; //количество одинаковых символов, идущих подряд
 while (s1[i+1]=s1[i]) do
 begin
 inc(j);
 inc(i)
 end;
 if (j=1) then
 begin
 k:=k+'['+s1[i];// если символ повторяется один раз,то выводим его
 write(resultfile,strtoint(s1[i]));//записываем в файл
 end
 else
 begin
 k:=k+char(j+48)+s1[i];
 write(resultfile,strtoint(s1[i]));
 end;
 inc(i);
 end;
 writeln(outfile,k);
 size2:=sizeofile(resultfile);
   writeln(res,s1);
CloseFile(resultfile);//закрываем файлы
CloseFile(outfile);
CloseFile(inputfile);
writeln('После архивации:',k);
writeln('До-',size1,' байт После-',size2,' байт');
end;
Function Decode:string;
var j,i:integer;
 s:string;
 k:string;
 outfile:file of byte;
help:TextFile;
mas:array[1..1000] of byte;
index:integer;
s1:string;
size1,size2:integer;
begin 
assignFile(help,'oufile.txt');
assignFile(outfile,'result.bmp');
size1:=sizeofile(outfile);
Reset(help);
index:=1;
 rewrite(outfile);
while not eof(help) do
begin
readln(help,s);
writeln('До разархивации:',s);
end;
if eof(help)then
begin
 k:='';
 i:=1;
while i<=length(s) do
begin
if s[i]='['then
begin
k:=k+s[i+1];
i:=i+1;
end
else
begin
for j := 1 to ord(s[i])-48 do
 k:=k+s[i+1];
 inc(i);
end;
inc(i);
end;
writeln('После разархивации:',k);
for i:=1 to length(k) do
begin
mas[i]:=strtoint(k[i]);
inc(index);
end;
for i:=1 to index-1 do
write(outfile,(mas[index]));
size2:=sizeofile(outfile);
closeFile(outfile);
closeFile(help);
writeln('До-',size1,' байт После-',size2,' байт');
end;
 end; 
begin
Encode;
writeln('_______________________________________________________________________________________________________________________________________________________________________________________________________________________________________________');
Decode;
end.