function DownCase(symb : char):char;
begin
  if symb in ['A'..'Z'] then
    DownCase := CHR(ORD(symb)+32)
  else
    DownCase := symb;
end;

var
  str : string;
  i: integer;

begin
 
  write('Input string: ');
  readln(str);
  i:=1;
  while (str[i]<>'!') do
  begin
    write(DownCase(str[i]));
    inc(i);
  end;
  readln;
end.

var
  i, counter, max : integer;
  str : string;

begin
  write('Input string: ');
  readln(str);
  i:=1;
  counter := 0;
  max := 0;
  while i <= Length(str) do
  begin
    if str[i]<>' ' then
      inc(counter)
    else
    begin
      if counter > max then
        max := counter;
      counter := 0;
    end;
    inc(i);
  end;
  write('Max word length is ', max);
  readln;
end.

function Ch2Int(ch: char): integer;
begin
  if ch in ['0'..'9'] then
     Ch2Int := ORD(ch) - 48
  else
     Ch2Int := -1;
end;

var
  str : string;
  numarr : array [0..9] of integer;
  i, maxind : integer;

begin
  write('Input string: ');
  readln(str);
  for i:=0 to 9 do
    numarr[i]:=0;
  i:=1;
  while str[i] <> '.' do
  begin
    maxind := Ch2Int(str[i]);
    if maxind <> -1 then
       inc(numarr[maxind]);
    inc(i);
  end;

  maxind := 0;
  for i:=0 to 9 do
    if numarr[i]>numarr[maxind] then
       maxind := i;

  writeln('Most frequent number is ',maxind);     

  readln;
end.

var
  str : string;
  i : integer;
  ch : char;
  flag : boolean;

begin
  write('Input string: ');
  readln(str);
  ch := str[1];
  i:=2;
  flag := true;
  while (str[i] <> '.') do
  begin
    inc(ch);
    if (str[i] <> ch) then
    begin
      flag := false;
      break;
    end;
    inc(i); 
  end;

  if flag then
    write('Text is regulate')
  else
    write('Text is not regulate');

  readln; 
end.

unit TextUnit;
interface
   const n = 1000;
   type new  = array [1..n] of char;
        fail = file of char;

   procedure CLEAR_BUF;
   {procedura ochistki byfera klaviatury}
   procedure VVOD_TEKSTA (var i : integer; var A : new);
      {procedura vvoda teksta s klaviatury}
   procedure VVOD_ADRESA (var i : integer; var A : new; var datfile : fail);
      {procedura schityvanija teksta iz faila}
   procedure SOHRANENIE (i : integer; A : new; var datfile : fail);
      {procedura sohranenija teksta, esli on byl vveden s klaviatyry}
   procedure PEREZAPIS (i : integer; A : new; var datfile : fail);
      {procedura sohranenija teksta, esli on byl schitan iz faila}

implementation
   uses Crt;

   procedure CLEAR_BUF;
   var ch : char;
   begin while keypressed do ch:=readkey; end;

   procedure VVOD_TEKSTA;
   begin
        ClrScr;
   write ('Vvedite tekst ');
   writeln ('(Okonchanie teksta - tochka)  :');
   i:=0;
   repeat
      i:=i+1;
      A[i]:=readkey;
                CLEAR_BUF;
                if A[i]='.' then break;
                A[i]:=UpCase (A[i]);
                write (A[i]);
   until A[i]='.';
        writeln;
   end;

   procedure VVOD_ADRESA;
   var soderzhimoe : char;
       name        : string;
   begin
        ClrScr;
        writeln('Vvedite adres faila s tekstom  (!! POLNOSTIU !!)');
        writeln('Esli ranee soxranjalsja cherez Paskal, to DAT-file');
        Read (name);
        i:=0;
        Assign (datfile, name);
        Reset (datfile);
        repeat
           inc(i);
           read (datfile, soderzhimoe);
           A[i]:=UpCase (soderzhimoe);
        until A[i] = '.';
        Close (datfile);
   end;

   procedure SOHRANENIE;
   var name : string;
       q    : integer;
   begin
        ClrScr;
        writeln ('Vvedite adres DAT-faila (!! POLNOSTIU !!) dla sohranenia');
        Read (name);
        Assign (datfile, name);
        Rewrite (datfile);
        for q:=1 to i do write (datfile, A[q]);
        Close (datfile);
   end;

   procedure PEREZAPIS;
   var q, l : integer;
   begin
        ClrScr;
        l:=0;
        Reset (datfile);
        Rewrite (datfile);
        Seek (datfile, l);
        for q:=1 to i do write (datfile, A[q]);
        Close (datfile);
   end;
END.

Uses Crt;
const n=6;
      m=6;
type Mas = array [1..n, 1..m] of integer;
var A1, Kras1 : Mas;

Procedure VVOD(var A : Mas);
var i, j : integer;
begin
     TextColor(White);
     for i:=1 to n do
        for j:=1 to m do A[i,j]:=random(2);
end;

Procedure SORT(var A : Mas);
var i, j, k, B : integer;
begin
     for i:=1 to n do
        for j:=1 to m do
        begin
           if (j mod 3 = 0) then
           if (A[i,j]=1) then
           begin
              for k:=j+1 to n do
              if A[i,k]=0 then
              begin
                 B:=A[i,j];
                 A[i,j]:=A[i,k];
                 A[i,k]:=B;
              end;
              continue;
           end
           else continue;

           if A[i,j]=0 then
           begin
              for k:=j+1 to m do
              if A[i,k]=1 then
              begin
                 B:=A[i,j];
                 A[i,j]:=A[i,k];
                 A[i,k]:=B;
              end;
           end;
        end;
end;



Procedure VYDELENIE_KRASNYM(A : Mas; var Kras : Mas);
var i, j, M : integer;
begin
     for i:=1 to (n-1) do
        for j:=1 to (m-1) do
        begin
           M:=A[i,j]+A[i,j+1]+A[i+1,j]+A[i+1,j+1];
           if M=4 then
           begin
              Kras[i,j]:=2; Kras[i,j+1]:=2;
              Kras[i+1,j]:=2; Kras[i+1,j+1]:=2;
           end;
           if A[i,j]=1 then
              if Kras[i,j]<>2 then Kras[i,j]:=1;
           if A[i,j+1]=1 then
              if Kras[i,j+1]<>2 then Kras[i,j+1]:=1;
           if A[i+1,j]=1 then
              if Kras[i+1,j]<>2 then Kras[i+1,j]:=1;
           if A[i+1,j+1]=1 then
              if Kras[i+1,j+1]<>2 then Kras[i+1,j+1]:=1;
        end;
end;

Procedure VYVOD_Kras(A, Kras : Mas);
var i, j : integer;
begin
     writeln;
     for i:=1 to n do
     begin
        for j:=1 to m do
          if Kras[i,j]=1 then
          begin TextColor(Red); write(A[i,j],' '); TextColor(White); end
          else write (A[i,j],' ');
     writeln;
     end;
end;

Procedure VYVOD(A : Mas);
var i, j : integer;
begin
     writeln;
     for i:=1 to n do
     begin
        for j:=1 to m do write(A[i,j],' ');
        writeln;
     end;
end;

BEGIN
     ClrScr; Randomize;
     VVOD(A1);
     VYVOD(A1);
     SORT(A1);
     VYDELENIE_KRASNYM(A1, Kras1);
     VYVOD_Kras(A1, Kras1);
     repeat until keypressed;
END.

Uses Crt;
const n=10;
type Mas = array [1..n] of integer;
var A1 : Mas;

procedure VVOD(var A : Mas);
var i : integer;
begin
     for i:=1 to n do
     begin A[i]:=i; write(A[i],' '); end;
     writeln;
end;

procedure VYVOD(A : Mas);
var i : integer;
begin
     writeln('Chetnye indeksy :');
     for i:=1 to n do
        if (i mod 2 = 0) then write(A[i],' ');
     writeln;
     writeln('Nechetnye indeksy :');
     for i:=1 to n do
        if (i mod 2 = 1) then write(A[i],' ');
end;

BEGIN
     ClrScr;
     VVOD(A1); VYVOD(A1);
     readln;
END.

       repeat
        flag:=true;
         for i:=1 to (e-1) do
          with cpus[i] do
           if (cpus[i].Frequency)>(cpus[i+1].Frequency) then
            Begin
             tmp[i]:=cpus[i];
             cpus[i]:=cpus[i+1];
             cpus[i+1]:=tmp[i];
             flag:=false;
            end;
       until flag;

with cpus[i] do

Uses Crt;
const n = 50;
type Mas = array [1..n] of byte;
var a1, i, j : integer;
    sis1     : byte;
    B1       : Mas;

procedure VVOD(var a : integer; var sis : byte);
begin
   write('Vvedite chislo v desjatichnoi sist. ischislenija: '); readln(a);
   write('V kakyu sist. ischislenija perevodit: '); readln(sis);
   while sis < 2 do
   begin
      writeln('Dolzhno byt >= 2, vvedite eche raz!');
      write('V kakyu sist. ischislenija perevodit: '); readln(sis);
   end;
end;

procedure PEREVOD(a : integer; var B : Mas; sis : byte);
var X : Mas;
begin
   i:=0;
   while (a <> 0) do
   begin inc(i);
      X[i]:=(a mod sis);
      a:=(a div sis);
   end;
   for j:=1 to i do B[j]:=X[i-j+1];
end;

procedure VYVOD(a : integer; B : Mas; sis : byte);
begin
     write('Chislo ',a ,' v ',sis,'-chnoi sist. ischislenija: ');
     for j:=1 to i do write(B[j]);
     readln;
end;

BEGIN
   ClrScr;
   VVOD(a1, sis1);
   PEREVOD(a1, B1, sis1);
   VYVOD(a1, B1, sis1);
END.

Uses Crt;
type node_ptr = ^node;
     node = record
          ch   : char;
          next : node_ptr;
     end;
var a1   : integer;
    sis1 : byte;
    B    : node_ptr;

procedure VVOD(var a : integer; var sis : byte);
begin
   write('Vvedite chislo v desjatichnoi sist. ischislenija: '); readln(a);
   write('V kakyu sist. ischislenija perevodit: '); readln(sis);
   while sis < 2 do
   begin
      writeln('Dolzhno byt >= 2, vvedite eche raz!');
      write('V kakyu sist. ischislenija perevodit: '); readln(sis);
   end;
end;

procedure PEREVOD(a : integer; sis : byte);
var temp  : node_ptr;
    i , k : integer;
begin
   i:=0; B:=nil;
   while (a <> 0) do
   begin inc(i);
      temp:=B;
      new(B);
      k:=(a mod sis);
      if (0 <= k) and (k <= 9) then  inc(k, 48)
         else
         begin
            k:=k+55;
         end;
      B^.ch:=chr(k);
      a:=(a div sis);
      B^.next:=temp;
   end;
end;

procedure VYVOD(a : integer; sis : byte);
var temp : node_ptr;
begin
   write('Chislo ',a ,' v ',sis,'-chnoi sist. ischislenija: ');
   while B <> nil do
   begin
      write(B^.ch);
      temp:=B^.next;
      Dispose(B);
      B:=temp;
   end;
   readln;
end;


BEGIN
   ClrScr;
   VVOD(a1, sis1);
   PEREVOD(a1, sis1);
   VYVOD(a1, sis1);
END.

procedure CreateIntFile(FileName : string; count : integer);
var
  num, sign, i : integer;
  fl : file of integer;
begin
  Assign(fl,FileName);
  Rewrite(fl);
  sign := 1;
  randomize();
  for i:=1 to count do
  begin
    num := sign*random(1000);
    write(fl,num);
    if i mod 10 = 0 then sign:=-sign;
  end;
  Close(fl);
end;

var
  fIn, fOut : file of integer;
  block1, block2 : array [1..5] of integer;
  FilenName : string;
  i, num, count : integer;

begin
  count := 100;
  FilenName := 'C:\tst.int';
  CreateIntFile(FilenName, count);
  Assign(fIn, FilenName);
  Reset(fIn);
  Assign(fOut, 'C:\fOut.int');
  Rewrite(fOut);
  while FilePos(fIn) <= (count - 20) do
  begin
    for i:=1 to 5 do
    begin
      read(fIn,num);
      write(fOut,num);
    end;

    for i:=1 to 5 do
      read(fIn,block1[i]);

    for i:=1 to 5 do
      read(fIn,block2[i]);

    for i:=1 to 5 do
      write(fOut,block2[i]);

    for i:=1 to 5 do
      write(fOut,block1[i]);

    for i:=1 to 5 do
    begin
      read(fIn,num);
      write(fOut,num);
    end;
  end;
  Close(fOut);
  Close(fIn);

  { Test }

  Assign(fIn, FilenName);
  Reset(fIn); 

  while not eof(fIn) do
  begin
    read(fIn,num);
    write(num:4,' ');
    if FilePos(fIn) mod 10 = 0 then
      writeln;
  end;

  writeln;
  writeln;

  Assign(fOut, 'C:\fOut.int');
  Reset(fOut);
  while not eof(fOut) do
  begin
    read(fOut,num);
    write(num:4,' ');
    if FilePos(fOut) mod 10 = 0 then
      writeln;
  end;

  readln;

end.