Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

end;

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

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

functiontoanysys(a, r: byte): string;

var

s, k : string;

n,m,i : byte;

begin

s:='';

m:= 1;

whilem<>0 do begin

m:= a divr;

n:= a-m*r+1;

k:= p[n];

s:= k+s;

a:= m;

end;

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

fori:=1 to8-length(s) dos:='0'+s;

toanysys:= s;

end;

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

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

functionfrombin(s: string): byte;

vari, e, b: byte;

begin

b:= 0;

fori:=1 to6 do begin

e:= 1 shl(6-i);

ifs[i]='1' thenb:= b+e;

end;

frombin:= b;

end;

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

typetcoola = array[1..1] ofbyte;

pcoola = ^tcoola;

procedureTForm1.Button1Click(Sender: TObject);

var

inf: file ofbyte;

ouf: textfile;

uue: pcoola;

b : array[1..4] ofbyte;

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) div6; //

ifszf*8-szh*6 = 0 thenszl:= 0

elseszl:= 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) div60; //число строк в UUE файле

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

//заголовок UUE-файла

writeln(ouf, 'begin 644 '+extractfilename(edit1.text));

//записываем строки в файл

fori:=1 tosxh do begin

write(ouf, 'M');

// 'M' значит, что в строке 60 символов

forj:= 1 to60 do begin

write(ouf, chr(uue[oum]));

oum:= oum+1;

end;

writeln(ouf);

end;

//записываем последнюю строку, которая//обычно короче 60 символов

sxh:= (sxl*6) div8;

write(ouf, chr(sxh+32));

fori:= 1 tosxl do begin

write(ouf, chr(uue[oum]));

oum:= oum+1;

end;

// "добиваем" строку незначащими символами

fori:= sxl+1 to60 dowrite(ouf, '`');

//записываем последние строки файла

writeln(ouf);

writeln(ouf, '`');

writeln(ouf, 'end');

closefile(ouf);

freemem(uue, szh+szl);

//освобождаем память

showmessage('DONE.'); //Готово. Забирайте!

end;

end.

- New auto-created HomeNet area (555:172/89.2) ------------- HOME.PROGRAMMERS -

Msg : 34 of 35

From : Philip Bondarovich 555:172/445.43 Пнд 17 Янв 00 02:51

To : Denis Guravski Втp 18 Янв 00 22:21

Subj : UUE

-------------------------------------------------------------------------------

Wednesday January 12 2000 22:56, Denis Guravski писал All:

DG> Люди , сpочно нyжно описание сабжа .

=== Begin uuecode ===

- INT.PROGRAMMERS (256:172/43) ------------------------------ INT.PROGRAMMERS -

Msg : 38 of 38 -36 Scn

From : Monk 256:172/10 15 Jan 00 18:24:30

To : Nikolay Severikov 16 Jan 00 03:47:50

Subj : UU-code

-------------------------------------------------------------------------------

Жывi сабе памаленькy, /_*Nikolay*_/!

У чацьвэp Стyдзеня 13 2000 y 23:25, цёмнай ночкаю, Nikolay Severikov тайна пiсаў All, i я ўцягнyўся...