Советы по Delphi. Версия 1.4.3 от 1.1.2001

Озеров Валентин

//выделение подстроки

function mid(s: string; fromc, toc: byte): string;

var

 s1: string;

 i : byte;

begin

 s1:= '';

 for i:= fromc to toc do s1:= s1+s[i];

 mid:= s1;

end;

//перевод

числа (a) из десятичной системы в другую

//с основанием (r)

function toanysys(a, r: byte): string;

var

 s, k : string;

 n,m,i : byte;

begin

 s:='';

 m:= 1;

 while m<>0 do begin

m:= a div r;

n:= a-m*r+1;

k:= p[n];

s:= k+s;

a:= m;

 end;

 //добавляет незначащие нули

 for i:=1 to 8-length(s) do s:='0'+s;

 toanysys:= s;

end;

//перевод 6-разрядного числа из двоичной системы в десятичную

//двоичное число подставляется в виде строки символов

function frombin(s: string): byte;

var i, e, b: byte;

begin

 b:= 0;

 for i:=1 to 6 do begin

e:= 1 shl (6-i);

if s[i]='1' then b:= b+e;

 end;

 frombin:= b;

end;

//непосредственно кодирование

type tcoola = array [1..1] of byte;

pcoola = ^tcoola;

procedure TForm1.Button1Click(Sender: TObject);

var

 inf: file of byte;

 ouf: textfile;

 uue: pcoola;

 b : array[1..4] of byte;

 bin,t : string;

 szf,oum,szl,szh,sxl,sxh,i, j : longint;

begin

 {$I-}

 assignfile(inf, edit1.text); //входной

файл

 reset(inf);

 szf:= filesize(inf); //

 szh:= (szf*8) div 6; //

 if szf*8-szh*6 = 0 then szl:= 0

 else szl:= 1; //

 getmem(uue, szh+szl); //выделение памяти

 oum:= 1;

 while not(eof(inf)) do begin

b[1]:= 0;

b[2]:= 0;

b[3]:= 0;

b[4]:= 0;

//чтение должно быть сделано посложнее,

//дабы избежать "read beyond end of file"

read(inf, b[1], b[2], b[3]);

//читаем 3 байта из входного файла

//и формируем "двоичную" строку

bin:= toanysys(b[1],2)+toanysys(b[2],2)+toanysys(b[3],2);

//разбиваем строку на куски по 6 бит и добавляем 32

t:= mid(bin, 19, 24);

b[4]:= frombin(t)+32;

t:=mid(bin, 13, 18);

b[3]:= frombin(t)+32;

t:= mid(bin, 07, 12);

b[2]:= frombin(t)+32;

t:= mid(bin, 01, 06);

b[1]:= frombin(t)+32;

//запихиваем полученнные байты во временный массив

uue[oum]:= b[1];

oum:= oum+1;

uue[oum]:= b[2];

oum:= oum+1;

uue[oum]:= b[3];

oum:= oum+1;

uue[oum]:= b[4];

oum:= oum+1;

 end;

 //входной файл больше не нужен - закрываем его

 closefile(inf);

 //формируем выходной файл

 assignfile(ouf, edit2.text); //выходной файл

 rewrite(ouf);

 oum:= 1;

 sxh:= (szh+szl) div 60; //число строк в UUE файле

 sxl:= (szh+szl)-sxh*60;