Перевод в различные системы счисления

PROGRAM maxkur;
Const
a:string[36]='0123456789ABCDEFGHIJKLMNJPQRSTUVWXYZ';
Function StrToInt(const s:String): Integer;
var
Result, code:integer;
begin
 val(s,Result,code);
 if (code<>0)
 then
  Result:=0;
 StrToInt:=Result;
end;
function ToDec(var Result:string;cc:byte):integer;
var
i,n,sum:integer;
begin
sum:=0;
n:=length(Result);
for i:=1 to n do
 begin
 dec(n);
 sum:=sum+round((pos(Result[i],a)-1)*exp(ln(cc)*n));
 end;
 ToDec:=sum;
 end;
function Convert(numb:integer; const c: byte):string;
var
Result:string;
begin
Result:='';
repeat
 Result:=a[numb mod c +1]+Result;
 numb:=numb div c;
until (numb=0);
Convert:=Result;
end;
function ShowMenu():Byte;
var
Result:byte;
begin
repeat
writeln('В какую систему счисления переводить? ');
readln(Result);
until (Result in [2..16]);
ShowMenu:=Result;
end;
var
f:File of Char;
s:string;
temp:byte;
c:char;
begin
assign(f,'f.txt');
reset(f);
s:='';
while not (eof(f)) do
begin
read(f,c);
if (c in ['0'..'Z'])
then
temp:=ToDec;
s:=s+c
else
if (c=',')
then
begin
temp:=ShowMenu();
writeln(s,'=',Convert(StrToInt(s), temp));
s:='';
case temp of
7:writeln('Перевод в троичную систему счисления');
0:writeln('Перевод с обратным кодом');
1:writeln('Первод с дополнительным кодом');
end;
if (temp<>7)and(temp<>1)and(temp<>0) then
begin
Writeln('Операция не осуществлена');
halt;
end;
end
end;
temp:=ShowMenu();
writeln(s,'=',Convert(StrToInt(s),temp));
close(f);
end.

program maxkur;
const
a:string[17]='0123456789ABCDEF-';
function StrToInt(const s:String):longint;
var
Result:longint;
code:integer;
begin
val(s,Result,code);
if (code<>0)
then
Result:=0;
StrToInt:=Result;
end;
function IntToStr(const i:longint):String;
var
Result:string;
begin
Str(i,Result);
IntToStr:=Result;
end;
function AnyToDec(s:string; const base:byte):longint;
var
Result:longint;
i,n:byte;
flag:boolean;
begin
flag:=(s[1]='-');
if (flag)
then
delete(s,1,1);
Result:=0;
n:=length(s);
for i:=1 to n do
begin
dec(n);
inc(Result,Round((Pos(s[i],a)-1)*exp(ln(base)*n)));
end;
if(flag)
then
Result:=-Result;
AnyToDec:=Result;
end;
function DecToAny(numb:longint; const base:byte):string;
var
Result:string;
flag:boolean;
begin
flag:=(numb<0);
if(flag)
then
numb:=abs(numb);
Result:='';
repeat
Result:=a[numb mod base +1]+Result;
numb:=numb div base;
until(numb=0);
if(flag)
then
Result:='-'+Result;
DecToAny:=Result;
end;
procedure FullLength(var s:string);
begin
while(length(s)<7) do
s:='0'+s;
end;
function Direct(const s:string):string;
var
Result:string;
begin
Result:=s;
if(s[1]='-')
then
delete(Result,1,1);
FullLength(Result);
if(s[1]='-')
then
Result:='1'+Result
else
Result:='0'+Result;
Direct:=Result;
end;
function Reverse(const s:string; const base:byte):string;
var
Result:string;
i:byte;
begin
Result:=s;
if(s[1]='-')
then
delete(Result,1,1);
FullLength(Result);
Result:='0'+Result;
if(s[1]='-')
then
for i:=1 to length(Result) do
Result[i]:=IntToStr(base-1-StrToInt(Result[i]))[1];
Reverse:=Result;
end;
function Additional(const s:String; const base:byte):string;
var
Result:string;
begin
Result:=Reverse(s,base);
if(s[1]='-')
then
Result:=DecToAny(1+AnyToDec(Result,base),base);
Additional:=Result;
end;
 
var
f:file of char;
b:text;
s,ans,nas,z:string;
m,k,numb:integer;
c:char;
base:byte;
begin
 Write('Ќ*з*«м*®Ґ §**зҐ*ЁҐ ¤Ё*Ї*§®** m=');
 ReadLn(m);
    repeat
        Write('Љ®*Ґз*®Ґ §**票Ґ ¤Ё*Ї*§®** k (>=', m, ')=');
        ReadLn(k);
    until (k >= m);
    repeat
    writeln('‚ Є*Єго бЁб⥬г бзЁб«Ґ*Ёп *Ґ®Ўе®¤Ё¬® Їа®Ё§ўҐбвЁ ЇҐаҐў®¤?');
        WriteLn('1. ЏҐаҐў®¤ ў ᥬҐаЁз*го бЁб⥬г бзЁб«Ґ*Ёп');
        WriteLn('2. ‡*ЇЁбм зЁб«* ў ¤®Ї®«*ЁвҐ«м*®¬ Є®¤Ґ');
        WriteLn('3. ‡*ЇЁбм зЁб«* ў ®Ўа*в*®¬ Є®¤Ґ ');
        Writeln('4. ‚л室 Ё§ Їа®Ја*¬¬л');
        ReadLn(base);
    until (base in [1..4]);
    if base=4 then
    begin
    writeln('Џа®Ја*¬¬* §*ўҐаиҐ**. ‘Ї*бЁЎ® §* ў*Ё¬**ЁҐ!');
    Halt;
    end;
    ans:=DecToAny(AnyToDec(s,16),7);
    case base of
       1:z:=Direct(ans);
       2:z:=Reverse(ans,16);
       3:z:=Additional(ans,16);
    end;
    Assign(f, 'f.txt');
    assign(b, 'b.txt');
    ReSet(f);
    rewrite(b);
    s := '';
    while Not (EoF(f)) do
    begin
    read(f,c);
        if(Pos(c,a)>0)
        then
        begin
        if((c='-')and(length(s)=0))or(c<>'-')
        then
        s:=s+c;
        end
        else
            if (c = ',')
            then
            begin
                numb := StrToInt(s);
                if ((numb >= m) And (numb <= k))
                then
                begin
                write(b,numb);
                write(b,'=');
                writeln(s,'=',z);
                write(b,z);
                write(b,' ');
                end;
 
                s := '';
            end
            else
            if (c in ['G'..'Z']) or (c='.') then
            begin
                WriteLn('ЋиЁЎЄ*! ‚бваҐзҐ* §*ЇаҐйҐ**л© бЁ¬ў®«');
                s := '';
 
            end;
            if m>k then
            begin
            writeln('„Ё*Ї*§®* §*¤** *ҐЄ®а४в*®! Џ®Їа®Ўг©вҐ б*®ў*.');
            Halt;
            end;
    end;
    Close(f);
    close(b);
 
end.

program ReadIntFromFile;
 
const
  Delimiter = ' ';
var
  CurrentChar: char;
  s: string;
  Value: integer;
begin
  Assign(input, 'f.txt');
  reset(input);
  while not EOF(input) do
  begin
    {пропускаем разделители в начале}
    while not EOLn(input) do
    begin
      Read(CurrentChar);
      if CurrentChar <> Delimiter then
        break;
    end;
    {если после пропуска разделителей конец строки
     то s:='', а если из предыдущего цикла вышли считав
     первый символ слова, то s:=CurrentChar}
    if CurrentChar <> Delimiter then
      s := CurrentChar
    else
      s := '';
    {считываем оставшиеся символы слова}
    while not EOLn(input) do
    begin
      Read(CurrentChar);
      if CurrentChar = Delimiter then
        break;
      s := s + CurrentChar;
    end;
    {если строка закончилась, но в файле есть ещё строки}
    if EOLn(input) and not EOF(input) then
      readln;
 
    {обработка строки}
    writeln(s);
 
  end;
  Close(input);
end.