Сократить обыкновенные дроби и найти наименьшую из них.

uses crt;
type
Natur = 1..high(longInt);{натуральные числа типа longint}
Frac = record
       p:integer; {Числитель дроби}
       q:Natur {Знаменатель дроби}
       end;
mass=array[1..100] of Frac;
{создание масива дробей}
procedure Vvod(var m:mass; var n:integer);
var i:integer;
begin
write('Введите размер массива - ');
readln(n);
writeln('Исходный массив:');
for i:=1 to n do
 begin
  m[i].p:=random(9)+1;
  m[i].q:=random(9)+1;
  write(m[i].p,'/',m[i].q,'  ');
 end;
writeln;
end;
{нахождение НОД}
function Nod(a,b:integer):integer;
begin
while a<>b do
if a>b then a:=a-b else b:=b-a;
Nod:=a
End;
{сокращение дробей}
procedure Sokr(var a:frac);
var d:Natur;
begin
d:=Nod(a.p,abs(a.q));
a.p:=a.p div d;
a.q:=a.q div d;
end;
{сравнение дробей по величине}
function Menshe(a,b:Frac):boolean;
begin
 Menshe:=a.p*b.q < a.q*b.p
end;
{вывод массива дробей после сокращения на экран}
procedure Vyvod(var m:mass;n:integer);
var i:integer;
begin
writeln('Массив после сокращения:');
for i:=1 to n do
 begin
  Sokr(m[i]);
  write(m[i].p,'/',m[i].q,'  ');
 end;
writeln;
end;
{нахождение наименьшей дроби}
procedure Min(m:mass;n:integer;var mn:frac);
var i:integer;
begin
mn:=m[1];
for i:=1 to n do
if Menshe(m[i],mn) then mn:=m[i];
end;
var a:mass;
    n:integer;
    mn:frac;
begin
clrscr;
randomize;
Vvod(a,n);
Vyvod(a,n);
Min(a,n,mn);
write('Наименьшая дробь= ',mn.p,'/',mn.q);
readln
end.

program xX;
var i:integer;c:char;s:string;
begin
writeln('vvedite simvol')
readln(c)
writeln('vvedite stroky')
readln(s)
while i<length(s) do
S[1]=C;=>cr:=cr+1
if cr>1 then delete(S,i,1):else i:=i+1
end

uses crt;
var s:string;
    a:array[byte] of byte;{массив встречаемости символов в строке}
    i,j,n:byte;
    c:char;
begin
clrscr;
writeln('Vvedite text:');
readln(s);
n:=length(s);
for i:=1 to 255 do a[i]:=0;{обнулим исходный массив}
for i:=1 to 255 do
for j:=1 to n do
if chr(i)=s[j] then a[i]:=a[i]+1;{если символ, соответствующий коду
ячейки массива есть в строке, в эту ячейку добавляем 1}
writeln('Встречаемость символов:');
j:=0;
for i:=1 to 255 do
if a[i]>0 then{если ячейка не пустая}
 begin
  writeln(chr(i),' - ',a[i]);{выводим символ и количество его вхождений}
  j:=j+1;
  if j mod 22=0 then readln;{если не входят на экран, то после 22 задержка}
 end;
{удаление повторов}
i:=1;
while i<=length(s) do
 begin
  c:=s[i];{запомнили символ}
  for j:=length(s) downto i+1 do {идем с конца строки не доходя до него}
  if s[j]=c then delete(s,j,1);{если совпал, удаляем}
  i:=i+1;{следующий символ2}
 end;
writeln('Строка без повторов:');
write(s);
readln
end.

program xX;
var cr:intiger;i:integer;c:char;s:string;
begin
writeln('vvedite simvol')
readln(c)
writeln('vvedite stroky')
readln(s)
i:=1;
cr:=0:
while i<length(s) do
begin
if S[1]=C then cr:=cr+1;
if cr>1 then delete(S,i,1)else i:=i+1;
end;

uses crt;
const zn=[' ',':',',','!','?','-',';'];//знаки, которые будем считать разделителями
var s,s1,s2:string;
    i,j,k,p:byte;
begin
clrscr;
writeln('Строка:');
readln(s);
s:=s+' ';//добавим в конец пробел
for i:=1 to length(s) do
if s[i] in zn then s[i]:=' ';//заменим все разделители на пробел
while pos('  ',s)>0 do//удалим повторяющиеся пробелы, если 2 пробела рядом(в апостровах обязательно 2 пробела))
delete(s,pos('  ',s),1);//один удаляем
if s[1]=' ' then delete(s,1,1);{/если первый символ пробел, его тоже удаляем, получили строку вида 
слово пробел слово пробел}
s1:=copy(s,1,pos(' ',s)-1);//копируем первое слово до пробела
delete(s,1,pos(' ',s));//удаляем его
k:=0;//фиксатор несовпадения слов
while pos(' ',s)>0 do//пока в строке есть пробелы
 begin
  s2:=copy(s,1,pos(' ',s)-1);//копируем первое слово
  if s2<>s1 then//если не совпало с первым
   begin
    k:=1;//фиксируем
    break;//выходим из цикла
   end;
  delete(s,1,pos(' ',s));//удаляем просмотренное слово, следующее первое
 end;
if k=1 then write('Не все слова одинаковые')
else write('Все слова одинаковые');
readln
end.

program xX;
var cr:intiger;i:integer;c:char;s:string;
begin
writeln('vvedite simvol')
readln(c)
writeln('vvedite stroky')
readln(s)
i:=1;
cr:=0:
while i<length(s) do
begin
if S[1]=C then cr:=cr+1;
if cr>1 then delete(S,i,1)else i:=i+1;
end;

program xX;
uses crt;
var s:string;
    c:char;
    i,j,k:byte;
begin
clrscr;
writeln('vvedite stroky');
readln(s);
for i:=1 to length(s) do
 begin
  c:=s[i];
  k:=0;
  for j:=length(s) downto i+1 do
  if s[j]=c then
   begin
    k:=k+1;
    delete(s,j,1);
   end;
  writeln(s[i],'-',k);
 end;
writeln;
write(s);
readln
end.

uses crt;
type
Natur = 1..high(longInt);{натуральные числа типа longint}
Frac = record
       p:integer; {Числитель дроби}
       q:Natur {Знаменатель дроби}
       end;
{ввод дробей}
procedure Vvod(var a,b:frac);
var i:integer;
begin
writeln('Введите числители и знаменатели двух дробей ');
writeln(' Первая дробь:');
write('  числитель=');readln(a.p);
write('  знаменатель=');readln(a.q);
writeln(' Вторая дробь:');
write('  числитель=');readln(b.p);
write('  знаменатель=');readln(b.q);
clrscr;
write(a.p,'/',a.q,'  ',b.p,'/',b.q);
writeln;
end;
{нахождение НОД}
function Nod(a,b:integer):integer;
begin
while a<>b do
if a>b then a:=a-b else b:=b-a;
Nod:=a
End;
{сокращение дробей}
procedure Sokr(var a:frac);
var d:Natur;
begin
d:=Nod(a.p,abs(a.q));
a.p:=a.p div d;
a.q:=a.q div d;
end;
{сравнение дробей по величине}
function Menshe(a,b:Frac):boolean;
begin
 Menshe:=a.p*b.q < a.q*b.p
end;
{вывод дробей и результата после сокращения на экран}
procedure Vyvod(var a,b:frac);
begin
writeln('Дроби после сокращения:');
Sokr(a);
Sokr(b);
writeln(a.p,'/',a.q,'  ',b.p,'/',b.q);
if Menshe(a,b)then write('меньше дробь ',a.p,'/',a.q)
else if Menshe(b,a) then write('меньше дробь ',b.p,'/',b.q)
else write('дроби равны');
end;
var  a,b:frac;
     c:char;
begin
clrscr;
randomize;
writeln('Вводите пары дробей, окончание ввода Esc');
repeat
clrscr;
Vvod(a,b);
Vyvod(a,b);
readln;
writeln('Введите следующую дробь или Esc для выхода');
c:=readkey;
until c=#27;
end.