Program One;
var ...
begin
for i:=1 to n do
b[i]:=0;
for i:=1 to n do
if A[i]>0 then k:=k+1 else begin
b[i]:=k;
k:=0;
end;
max:=B[1];
for i:=1 to n do
if B[i]>max then max:=B[i];

var
s:string;
i:byte;
o,z:byte;
begin
writeln('введите строку');
readln(s);
for i:=1 to ORD(s[0]) do
begin
  If s[i]='(' then inc(o);
  If s[i]=')' then inc(z)
end;
If o>z then writeln('открывающихся больше');
If o<z then writeln('закрывающихся больше');
If z=o then writeln('скобки расставленны правильно');
end.

Program odin;
var a:array[1..n] of integer;
fl:bolean;
i,max,kol:integer;
begin
for i:=1 to n do
read(a[i]);
max:=0;
for i:=1 to n do
begin   if a[i]>0 then
    kol:=kol+1; fl:=true
  else if fl=true and a[i]<0 then
  begin  
    fl:=false;
  if kol>max then
   max:=kol;
  kol:=0;
end;
end;
write(max)
end.

program chetyre;
var a:array[1,n] of integer;
begin
i:=2;
min:=a[2,1];
while j<>m do
begin
for i:=1 to n do
begin
if a[j,i]<min then
min:=a[j,i]
end;
j:=j+2;
write(min);
min:=a[j,1];
end;
end.

program dva;
var s,kol,k:integer;
fl:boolean;
begin
kol:=0;
while s div 10 <>0 do
begin
k:=s mod 10;
if k<>0 and fl=false then
fl:=true
else if k=0 and fl=true then
kol:=kol+1;
s:=s div 10;
end;
write(kol);
end.

uses crt;
var
i:integer; {ўў®¤Ё¬®Ґ зЁб«®}
ip:boolean; {Ўл«® -«Ё ЇаҐ¤л¤г饥 зЁ«® Ї®«®¦Ёв.}
ke:integer; {бзҐвзЁЄ, ­г¦Ґ­ ¤«п Ї®¤бзҐв  Ї®б«Ґ¤®ў.}
max:integer; {ЁбЄ®¬®Ґ зЁб«®}
{Ёв®Ј® 7 Ў ©в Ї ¬пвЁ ­  ЇҐаҐ¬Ґ­­лҐ :-) -¬ иЁ­  ­Ґ ўл¤Ґа¦Ёв!}
begin
{®зЁй Ґ¬ нЄа ­}
clrscr;
repeat
  {ўў®¤Ё¬ зЁб«®}
  read(i);
  { Ґб«Ё ЇаҐ¤л¤г饥 зЁб«® Ї®«®¦ЁвҐ«м­®Ґ, ⮠㢥«ЁзЁў Ґ¬ бзҐвзЁЄ}
  if ip=true then inc(ke);
  {Ґб«Ё ўўҐ¤Ґ­®Ґ зЁб«® Ї®«®¦ЁвҐ«м­®, в® ip:=true }
  If i>0 then ip:=true;
  {Ґб«Ё ўўҐ¤Ґ­® зЁб«® ®ваЁж.   ЇаҐ¤. Ўл«® Ї®«®¦ЁвҐ«м­®, в®...}
  If (i<=0) and (ip=true) then
  begin
   {Ґб«Ё бзҐвзЁЄ Ў®«миҐ ¬ Єб. бзҐвзЁЄ , в® ®Ў­®ў«пҐ¬ ¬ Єб.}
   if ke>max then max:=ke;
   {бЎа®б бзҐвзЁЄ }
   ke:=0;
   {Ґб«Ё нв® 0, ⮠㬥­миЁвм ¬ Єб. в.Є. Ї®б«Ґ¤­ҐҐ зЁб«® ­Ґ бзЁв Ґвбп Ї®б«Ґ¤®ў.}
   If i=0 then dec(max);
  end
until i=0;
writeln('max=',max);
readln;
end.
P.S.
в®з­®  ­Ґ §­ о, з⮠ᤥ« вм ¤® repeat ,­ҐЇа ўЁ«м­л© Ї®¤бзҐв Ё¤Ґв, Ґб«Ё
б ¬ п ¤«Ё­­ п Ї®б«Ґ¤®ў вҐм­®бвм Џ…ђ‚Ђџ, ­ ЇаЁбҐа 1 2 3 -4 3 4
в®Ј¤  ®вўҐв ­  1 ¬Ґ­миҐ, в.Є. ў ­ з «Ґ ip = false!
P.S.2
Ї®б«Ґ END. ¬®¦­® ЇЁб вм ‚‘…, —’Ћ “ѓЋ„ЌЋ, Є®¬ЇЁ«пв®а ­Ґ зЁв Ґв ¤ «миҐ,
  в Є зв® ­Ґ ЇгЈ ©вҐбм :-)

program dva;
var s,kol,k:real;
fl:boolean;
begin
write('vvedyte: ');
read(s);
kol:=0;
while (trunc(s) div 10)<>0 do
begin
k:=trunc(s) mod 10;
if (k<>0) and (fl=false) then
fl:=true
else if (k=0) and (fl=true) then
kol:=kol+1;
s:=trunc(s) div 10;
end;
write(kol:5:0);
end.

var m,n,sum :longint;
    a,b,c,i,t,zero,tmp,tmp2,tmp3: byte;

function Stepen(p,q:byte):longint;
var i:byte;
    st:longint;
begin
st:=p;
if q=0 then st:=1 else for i:=1 to q-1 do st:=st*p;
Stepen:=st;
end;

begin
readln(a,b,c);
readln(n);
zero:=ord((a=0)or(b=0)or(c=0));
t:=0;
sum:=0;
tmp2:=1;
m:=n;
repeat  m:=m div 10; inc(t); until m=0;
for i:=t-1 downto 0 do
    begin
    tmp:=(n div stepen(10,i))mod 10;
    tmp3:=(ord(a<tmp)+ord(b<tmp)+ord(c<tmp)-ord(i=t-1)*zero);
    if not((a=tmp)or(b=tmp)or(c=tmp)) then
       begin
       sum:=sum+tmp2*tmp3*stepen(3,i);
       break;
       end;
    tmp2:=tmp2*(tmp3+1);
    if i=0 then sum:=sum+tmp2;
    end;
for i:=3 to t-1 do sum:=sum+stepen(3,i);
writeln(sum);
readln;
end.

program tri;
var
a,s,s2,k,k2,i,sum,sum2,n:integer;
begin
write('vvedyte A: ');
read(a);
write('vvedyte n: ');
read(n);
for i:=2 to n do
begin
s:=i;
s2:=i;
while s<>0 do
begin
k:=s mod 10;
sum:=sum+k;
s:=s div 10;
end;
s2:=s2*a;
while s2<>0 do
begin
k2:=s2 mod 10;
sum2:=sum2+k2;
s2:=s2 div 10;
end;
if sum=sum2 then
write(i,'_');
sum:=0;
sum2:=0;
end;
end.

program one(input,output);
var i,y,max : integer;
begin
  i := 0; max := 0;
  while not eof do
  begin
    read(y);
    if (y>0) then i := i + 1
    else
    begin
      if (i>max) then max := i;
      i := 0;
    end;
  end;
  writeln(max);
end.

program four(input,output);
var A : array[1..M,1..N] of integer;
  i,j,min : integer;
begin
  for i := 1 to M div 2 do
  begin
    min := A[2*i,1];
    for j := 1 to N do
      if (A[2*i,j]<min) then min := A[2*i,j];
    writeln('Минимальный элемент в ',2*i,'- ой строке равен ',min);
  end;
end.

function FromDec(n, radix:longint):string;
{перевод числа n из radix c/c в 10-ую}
var
s: String;
const
digit: string[16]='0123456789ABCDEF';
begin
s:='';
repeat
s:=digit[(n mod radix)+1]+s;
n:=n div radix;
until n=0;
FromDec:=s;
end;

function ToDec(n:string; radix:longint):longint; {перевод числа n из
10-ной с/с в radix}
var
m, i: longint;
const
digit: string[16]='0123456789ABCDEF';
begin
m:=0;
while n[1]='0' do delete(n,1,1);
for i:=1 to length(n) do m:=m*radix+pos(n[i],digit)-1;
ToDec:=m;
end;

var
i:integer;
begin
readln(i);
while i>10 do  i:=i div 10;
writeln(i);
end.

var
i,j,k:integer;
begin
readln(i);
repeat
J:=i mod 10;
I:= i DIV 10;
If j mod 2=0 then inc(k);
until i<10;
writeln(k);
end.

const MaxN=100;
var
a:array[1..MaxN] of integer;
i,ke,max,min,mn:integer;
begin
repeat
  write('dlinna massiva:');
  readln(ke)
until ke<MaxN;
for i:=1 to ke do begin
write('a[',i,']='); readln(a[i]) end;
for i:=1 to ke do if max<a[i] then max:=a[i]; min:=max;
for i:=1 to ke do if min>a[i] then begin min:=a[i]; mn:=i end;
write('minimal element=',min);
write('nomer=',mn);
end;

const MaxN=100;
var
a:array[1..MaxN] of integer;
i,ke,SUMM:integer;
begin
repeat
write('dlinna massiva:');
readln(ke)
until ke<MaxN;
for i:=1 to ke do begin
write('a[',i,']='); readln(a[i]) end;
for i:=1 to ke do If a[i]>0 then SUMM:=SUMM+a[i];
writeln(summ);
end.

const MaxN=100;
var
a:array[1..MaxN] of integer;
i,ke:integer;
begin
repeat write('dlinna massiva:'); readln(ke) until ke<MaxN;
for i:=1 to ke do begin  write('a[',i,']='); readln(a[i]) end;
for i:=1 to ke do If (a[i]>0) and (a[i+1]>0) and (a[i+2]<=0)  then  
writeln(i,' and ',i+1)
end.

const
Nmax=20;
Mmax=20;
var
a:array[1..N,1..M] of integer;
i,j,n,m,chet,nechet:integer;
begin
write('n='); readln(n);
write('m='); readln(m);
{vvod matrizi}
for i:=1 to n do
for j:=1 to m do
begin
write('a[',i,',',j,]='); readln(a[i,j]) end;
{------}
for i:=1 to n do
for j:=1 to m do If a[i,j] mod 2=0 then inc(chet) else inc(nechet);
writeln('chetnie=',chet);
writeln('nechet=',nechet);
writeln('press ENTER ...');
readln
end.

var
s:string;
c:char;
i:byte;
NEWs;
begin
writeln('Vvdedite TEXT');
readln(s);
wrieln('kakyu bykvy YDVOIT:');
readln©;
for i:=1 to ORD(s[0]) do
begin
  NEWs:=NEWs+s[i];
  If s[i]=c then NEWs:=NEWs+c
end;
{for i:=1 to (ord(s[0])+1) do NEWs:=NEWs+NEWs[i]; } {раскоментировать, если не будет работать}
writeln(NEWs);
end.

Var
s,ns:string;
i:byte;
sr,sr1:byte;
begin
writeln('BBEDITE CTPOKY:');
readln(s);
If Ord(s[0]) mod 2 =0 then
begin
  sr:=Ord(s[0]) div 2;
  sr1:=sr+1;
  for i:=1 to ord(s[0]) do If (i<>sr) and (i<>sr1) then NS:=NS+s[i]
end else
begin
  sr:=(ORD(s[0]) div 2)+1;
  for i:=1 to ord(s[0]) do If i<>sr then NS:=NS+s[i]
end; {IF}
writeln(NS)
end.

const
n=15; m=15;
{ так выглядит матрица:
1,2,3,...n
2
3...
m
}
type
atype= array[1..n] of array[1..m] of integer;

var
ar:array[1..m] of integer;
a:atype;
nmax,mmax,i,j:integer;
{------------------}

procedure sort(var x:array of integer; left,rig:integer);
var l,r,a:integer;
begin
l:=left; r:=rig; a:=x[l];
repeat
  while (x[r]>=a) and (l<r) do r:=r-1;
  x[l]:=x[r];
  while (x[l]<=a) and (l<r) do l:=l+1;
  x[r]:=x[l]
until r=l;
x[l]:=a;
if left<l-1 then sort(x,left,l-1);
if r+1<rig then sort(x,r+1,rig)
end;
Procedure PRINT(a:atype; nmax,mmax:integer);
var i,j:integer;
begin
for i:=1 to nmax do
  begin
  for j:=1 to mmax do write(a[i,j]);
  writeln;
  end;
end;
{--------}
var k:integer;
Begin
write('K-BO CTPOK='); readln(mmax);
write('K-BO CTOLBZOB='); readln(nmax);
Writeln('POSTROCHNO VVEDITE MATRIZY');
for i:=1 to mmax do
for j:=1 to nmax do
begin
  write('a[',i,',',j,']=');
  readln(a[i,j])
end;
{------}
writeln;
print(a,mmax,nmax);
writeln;
{---------}
for i:=1 to nmax do
begin
  for j:=1 to mmax do ar[j]:=a[j,i];
  sort(ar,0,mmax-1);
  for j:=1 to mmax do a[j,i]:=ar[j];
end;
{--------}
writeln;
print(a,mmax,nmax);
readln
end.