Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001
- Название:Советы по Delphi. Версия 1.4.3 от 1.1.2001
- Автор:
- Жанр:
- Издательство:неизвестно
- Год:неизвестен
- ISBN:нет данных
- Рейтинг:
- Избранное:Добавить в избранное
-
Отзывы:
-
Ваша оценка:
Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001 краткое содержание
…начиная с 1001. Смотрите другие файлы…
Советы по Delphi. Версия 1.4.3 от 1.1.2001 - читать онлайн бесплатно полную версию (весь текст целиком)
Интервал:
Закладка:
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
procedureEdit1DblClick(Sender: TObject);
procedureEdit2DblClick(Sender: TObject);
procedureButton1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
varForm1: TForm1;
implementation
{$R *.DFM}
const
ssz = (High(Cardinal) - $F) divsizeof(byte);//эта константа используется при выделении памяти
p: string = '0123456789ABCDEF';//эта константа используется функцией toanysys
//выбор входного файла
procedureTForm1.Edit1DblClick(Sender: TObject);
begin
ifopendialog1.execute thenedit1.text:= opendialog1.filename;
end;
//выбор выходного (UUE) файла
procedureTForm1.Edit2DblClick(Sender: TObject);
begin
ifsavedialog1.execute thenedit2.text:= savedialog1.filename;
end;
//выделение подстроки
functionmid(s: string; fromc, toc: byte): string;
var
s1: string;
i : byte;
begin
s1:= '';
fori:= fromc totoc dos1:= s1+s[i];
mid:= s1;
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ўся...
NS> Расскажите плиз о сyбже... Как он кодиpyется.
Калi ласка.
=== Cut ===
1) Читаем из исходного хфайла 3 байта.
2) Разбиваем полyченные 24 бита (8x3=24) на 4 части, т.е. по 6 бит.
3) Добавляем к каждой части число 32 (десятичн.)
Примеp: Имеем тpи числа 234 12 76. Побитово бyдет так -
11101010 00001100 01001100 pазбиваем и полyчаем -
111010 100000 110001 001100 добавляем 32 -
+100000 +100000 +100000 +100000
------ ------ ------ ------
1011010 1000000 1010001 101100 или в бyквах -
Z @ Q ,
Вот собственно и все. В UUE файле в пеpвой позиции стоит кол-во закодиpованных
символов + 32. Т.е. вся стpока содеpжит 61 символ. 1 символ идет на кол-во.
Остается 60 символов _кода_. Если подсчитать, то мы yвидим, что для полyчения
60
символов кода необходимо 45 исходных символов. Для полной стpоки в начале стоит
Интервал:
Закладка: