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

Имена файлов будут вводится либо вручную, либо из диалога (double-click на поле ввода edit), причем в edit1.text должно лежать имя входного файла, в edit2.text — выходного. По нажатии кнопки пойдет процесс, который завершится сообщением "DONE."

Всего хорошего.

P.S. Функция toanysys обнаружена в книге "Для чего нужны и как работают персональные ЭВМ" от 1990 г. Там она присутствует в виде программы на BASIC'e.

P.P.S. Для стимулирования фантазии читателей "Советов…" высылаю так же мессагу из эхи, на основе которой я сваял свое чудо.

Файл Unit1.pas

//UUE кодирование

unit Unit1;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,ExtDlgs, StdCtrls;

type TForm1 = class(TForm)

 Button1: TButton;

 Edit1: TEdit;

 Edit2: TEdit;

 OpenDialog1: TOpenDialog;

 SaveDialog1: TSaveDialog;

 procedure Edit1DblClick(Sender: TObject);

 procedure Edit2DblClick(Sender: TObject);

 procedure Button1Click(Sender: TObject);

private

  { Private declarations }

public

  { Public declarations }

end;

var Form1: TForm1;

implementation

{$R *.DFM}

const

 ssz = (High(Cardinal) - $F) div sizeof(byte);//эта константа используется при выделении памяти

 p: string = '0123456789ABCDEF';//эта константа используется функцией toanysys

//выбор входного файла

procedure TForm1.Edit1DblClick(Sender: TObject);

begin

 if opendialog1.execute then edit1.text:= opendialog1.filename;

end;

//выбор выходного (UUE) файла

procedure TForm1.Edit2DblClick(Sender: TObject);

begin

 if savedialog1.execute then edit2.text:= savedialog1.filename;

end;

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

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"