Windows XP / 7 .

uses crt;
type mas=array[1..6,1..6] of integer;
matr=array[1..6,1..6] of integer;
procedure Vvod(var mt:matr;x:byte;c:char);
var i,j:byte;
begin
writeln('Iao?eoa ',c);
for i:=1 to 6 do
begin
for j:=1 to 6 do
begin
mt[i,j]:=random(20)-5;
write(mt[i,j]:5);
end;
writeln;
end;
end;
function Summ(v:mas;x:byte):integer;
var i,j:integer;
s:integer;
begin
s:=0;
for i:=1 to 6 do
for j:=1 to 6 do

if v[i,j]>0 then s:=s+v[i,j];
Summ:=s;
end;
procedure Vektor(mt:mas;x:real;var v:mas;c:string);
var i,j:byte;
begin
writeln('Aaeoi? ',c);
for i:=1 to 6 do
begin
v[i,j]:=Summ(mt,6);
write(v[i,j],' ');
end;
writeln;
writeln;
end;
var a,b:matr;
va,vb:mas;
begin
clrscr;
randomize;
Vvod(a,6,'A');
Vektor(a,6,va,'Va');
Vvod(b,5,'B');
Vektor(b,5,vb,'Vb');
readln
end.

program zadacha_18;
   var a:array[1..100,1..100] of integer;
     i,j,n:integer;
begin write('Введите количество строк и столбцов');
       readln(n);
       for i:=1 to n div 2 do
           for j:=i to n do
               begin a[i,j]:=0;
                     if ((j>=i) and (j<=(n-i+1))) and (i<=(n div 2)+1)
                        then begin a[i,j]:=1;
                    a[n-i+1,j]:=1;
                             end;
               end;
       if n mod 2=1 then a[n div 2+1,j div 2+1]:=1;
       for i:=1 to n do
           begin for j:=1 to n do write(a[i,j]:2);
                 writeln
           end;
       readln
end.

program zadacha_3;
  uses crt;
  var
   a:array [1..50] of integer;
   b:array [1..50] of integer;
  k,i,m,j,n,r,l:integer;
  begin
   clrscr;
   write('Введите количество строк');
    readln(n);
     write('Введите количество столбцов');
      readln(m);
    for i:=1 to n do
    for j:=1 to m do
   begin
    write('a[',i,']={b[',j,']=}');
     readln(a[i]);
      end;
        for i:=1 to n-1 do
        for k:=i+1 to n do
        {for j:=1 to m do}
       if a[k]>a[i]  then
     begin
       r:=a[i];
       a[i]:=a[k];
       a[k]:=r;
        end;
         writeln('Отсортированый массив:');
       for i:=1 to n do
        writeln(a[i]:4);
       readln;
  end.

uses crt;{модуль для работы с клавиатурой и экраном, возможно В Free называется не так}
type Tabonent=record
               fam:string[20];
               god:word;
               nom:string[10];
               end;
var f:file of Tabonent;
     ab:Tabonent;
     fm:string[20];
     gd:word;
     i,k,b:integer;
     c:char;
begin
clrscr;
assign(f,'abonent');
rewrite(f);
writeln('Введите данные об абонентах, окончание ввода Esc:');
i:=0;
repeat
i:=i+1;
writeln('Абонент ',i);
write(' Введите фамилию: ');readln(ab.fam);
repeat
write(' Введите год установки телефона (1950-2009):');readln(ab.god);{интервал годов можете изменить}
until (ab.god>=1950)and(ab.god<=2009);
write(' Введите номер телефона: ');readln(ab.nom);
write(f,ab);{заносим запись в файл}
c:=readkey;{ждем нажатия клавиши}
until c=#27;{если Esc, заканчиваем ввод записей}
clrscr;
write('Введите фамилию для поиска:');
readln(fm);
b:=0;
reset(f);
while not eof(f) do
  begin
   read(f,ab);
   if ab.fam=fm then
    begin
     b:=1;
     writeln(ab.nom);
    end;
  end;
if b=0 then writeln('Такой фамилии нет!');
close(f);
reset(f);
repeat
write('Введите искомый год начала установок телефонов(1950-2009):');
readln(gd);
until (gd>=1950)and(gd<=2009);
k:=0;
b:=0;
while not eof(f) do
  begin
   read(f,ab);
   if ab.god>=gd then
    begin
     k:=k+1;
     b:=1;
    end;
  end;
if b=0 then writeln('После ',gd,' года телефоны не устанавливались')
else writeln('Количество телефонов, установленных с ',gd,' года=',k);
readln
end.

uses crt;
const nmax=20;
var a:array[1..nmax,1..nmax] of real;
     n,m,i,j,l,k:byte;
     mn,b:real;
begin
clrscr;
randomize;
repeat
write('Количество строк от 1 до ',nmax,' m=');
readln(m);
until m in [1..nmax];
repeat
write('Количество столбцов от 1 до ',nmax,' n=');
readln(n);
until n in [1..nmax];
writeln('Введите элементы матрицы:');
for i:=1 to m do
for j:=1 to n do
  begin
   write('a[',i,',',j,']=');
   readln(a[i,j]);
  end;
clrscr;
{нахождение минимальных в строках и запись их в дополнительный столбец}
for i:=1 to m do
  begin
   mn:=a[i,1];
   for j:=1 to n do
   if a[i,j]<mn then mn:=a[i,j];
   a[i,n+1]:=mn;
  end;
writeln('Исходный массив:');
writeln('Мин.':(m*5+9));
for i:=1 to m do
  begin
   for j:=1 to n+1 do
   if j=n+1 then write(a[i,j]:8:1)
   else write(a[i,j]:5:1);
   writeln;
  end;
{перестановка строк по неубыванию минимальных элементов(по последнему столбцу)}
for i:=1 to m-1 do
for l:=i+1 to m do
if a[i,n+1]>a[l,n+1] then
for j:=1 to n+1 do
  begin
   b:=a[i,j];
   a[i,j]:=a[l,j];
   a[l,j]:=b;
  end;
writeln('Строки по неубыванию минимальных элементов:');
writeln('Мин.':(m*5+9));
for i:=1 to m do
  begin
   for j:=1 to n+1 do
   if j=n+1 then write(a[i,j]:8:1)
   else write(a[i,j]:5:1);
   writeln;
  end;
readln
end.

program zadacha_19;
uses crt;  
var  
a:array[1..100,1..100] of integer; {исходная матрица}  
b:array[1..100,1..100] of single; {конечная матрица}
i:integer; {номер строки}  
j:integer; {номер столбца}
n:integer; {количество строк}
m:integer; {количество столбцов}
max:integer; {наибольший по модулю элемент}
begin
clrscr;
writeln ('Количество строк');  
readln(n);  
writeln ('Количество столбцов');  
readln(m);  
for i:=1 to n do {ввод элементов исходной матрицы}  
for j:=1 to m do  
begin  
write('a[',i,',',j,']=');  
readln(a[i,j]);  
end;  
writeln ('Исходная матрица:');  
for i:=1 to n do {вывод элементов матрицы}  
begin  
for j:=1 to m do  
begin  
write(a[i,j]);  
end;  
writeln;  
end;  
max:=abs(a[1,1]); {нахождение наиб. элемента по модулю}  
for i:=1 to n do  
for j:=1 to m do  
begin  
if abs(a[i,j])>max then  
max:=abs(a[i,j]);  
end;  
writeln ('Наибольший по модулю элемент: ',max);
for i:=1 to n do {деление каждого эл. нового массива на max}
for j:=1 to m do  
begin  
b[i,j]:=a[i,j]/max;  
end;  
writeln(('Конечная матрица:');  
for i:=1 to n do {вывод элементов конечной матрицы}
begin  
for j:=1 to m do  
begin  
write(b[i,j]);  
end;  
writeln;  
end;  
readln;  
end.

uses crt;
   
const n=5;
       m=10;
        
var a:array[1..n,1..m] of integer;
     i,j,min,max,imin,jmin,imax,jmax:integer;
      
begin
   min:=0;
   max:=0;
   randomize;
   clrscr;
   writeln('Матрица 5x10 - ');
   for i:=1 to n do
   begin
     for j:=1 to m do
     begin
       a[i,j]:=random(10)-5;
       write(a[i,j]:2,' ');
     end;
     writeln;
   end;
    
   for i:=1 to n do
   begin
     for j:=1 to m do
     begin
       if a[i,j]<min then
       begin
         min:=a[i,j];
         imin:=i;
         jmin:=j;
       end;
       if a[i,j]>max then
       begin
         max:=a[i,j];
         imax:=i;
         jmax:=j;
       end;
     end;
     a[imin,jmin]:=max;
     a[imax,jmax]:=min;
     min:=0;
     max:=0;
     writeln;
   end;
    
   writeln('Преобразованная матрица 5х10 -  ');
   for i:=1 to n do
   begin
     for j:=1 to m do
     begin
       write(a[i,j]:2,' ');
     end;
     writeln;
   end;
    
end.

program procedure;  
usec crt;  
const n=40;  
type mas =array[1..n] of real;  
var i,n : byte;  
s : real;  
x ,y : mas;  
function vec(x,y:mas; n,kx:integer):real;  
var j : integer;  
r,rm : real;  
begin  
rm := -1e20;  
for j := 1 to n do begin  
r := sqrt(sgr(x[i])+sgr(y[i]));  
if (kx*r>=kx*rm) then rm := r;  
end;  
vec := rm  
end;  
{ исполняемая часть главной программы }  
begin  
textattr:=27;clrscr;  
gotoxy(30,2);writeln(`');  
write('Введите кол-во координат верхней полуплоскости. ');  
readln(n);  
writeln('Введите координаты');  
for i :=1 to n do begin  
read(x[i]); write(` `);readln(y[i]);  
end;  
writeln(`Ближайшая точка удалена на расстояние =', s:=vec(x,y,n,-1);  
write('Введите кол-во координат нижней полуплоскости. ');  
readln(n);  
writeln('Введите координаты');  
for i :=1 to n do begin  
read(x[i]); write(` `);readln(y[i]);  
end;  
writeln(`Наиболее удаленная точка находится на расстояни =', s:=vec(x,y,n,1);  
end.

program file_int;  
var f : file of integer;  
a, b, k : integer;  
begin  
assign (f, 'integer.dat');  
reset (f);  
k:=0;  
read (f, a);  
while not eof(f) do begin  
read (f, b);  
if b <> a then begin  
a:=b; k:=k+1  
end  
end;  
write (p);  
close (f)  
end.

var
   f1,f2:text;
   s,s1:string;
begin
   readln(s);
   assign(f1,'input.txt');
   assign(f2,'output.txt');
   reset(f1);
   rewrite(f2);
   writeln(f2,s);
   while not EOF(f1) do
   begin
     readln(f1,s1);
     writeln(f2,s1)
   end;
   writeln(f2,s);
   close(f1);
   close(f2)
end.

program prog1;
uses crt;
var
  F: Text;
  namefile: string[50];
  tmp: string[100];
  len: integer;
  countstr, countch: integer;
begin
  clrscr;
  write('Imya faila: ');
  readln(namefile);
  assign(F, namefile);
  reset(F);
  countstr:=0;
  countch:=0;
  while not Eof(F) do
   begin
    readln(F, tmp);
    countstr:=countstr+1;
    countch:=countch+length(tmp);
   end;
  close(F);
  writeln('Kol-vo strok v faile: ', countstr);
  writeln('Kol-vo simvolov: '  , countch);
  readln;
end.

type
   Toy=record
     nazva: string[40];
     age: integer;
     kol: integer;
     vozrast1: integer;
     vozrast2: integer;
        end;
var
   f : file of Toy;
   Toys : array[1..N] of Toy;

    L:=1; R:=N;  
  Mid:=(L+R) div 2;  
  while (Mas[Mid]<>A) and (L'<'R) do
  begin
   if Mas[Mid]'<'A then L:=Mid+1
                   else R:=Mid-1;  
   Mid:=(L+R) div 2
  end;  
  if Mas[Mid]=A then ShowMessage('Found at position '+ IntToStr(Mid))  
                else ShowMessage('Not found');

1    for i:=2 to N do
2    for j:=N downto 1 do
3       if Mas[j-1]>Mas[j] then
4       begin
5        Tmp:=Mas[j];  
6        Mas[j]:=Mas[j-1];  
7        Mas[j-1]:=Tmpl  
8       end;