Строка: Проверка на корректную расстановку скобок

program lab7;
uses crt;
var
S,P:string;
r:integer;
i:integer; 
begin
Write('Введите строку: ');
readln(S);
r:=0;    
P:='';
for i:=1 to length(S) do 
begin
 
if S[i]='(' then
P:=P+'('; 
if (S[i]=')')then
begin
if (P[length(P)]='(') then
delete(P,length(P),1) 
else
begin
r:=i;
break;
end;
end;
 
if S[i]='{' then
P:=P+'{'; 
if (S[i]='}')then
begin
if (P[length(P)]='{') then
delete(P,length(P),1) 
else
begin
r:=i;
break;
end;
end;
 
if S[i]='[' then
P:=P+'[';
if (S[i]=']')then
begin
if (P[length(P)]='[') then
delete(P,length(P),1) 
else
begin
r:=i;
break;
end;
end;
end;
 
if (length(P) > 0)and(i=length(S)) then
r:=-1; 
Writeln('Ответ: ',r);
end.

Program P16;
 
Var Arr : Array[1..1000] of char;
Var Ptr : integer;
 
Procedure Init;
var i : integer;
Begin
    for i:=1 to 1000 Do Arr[i]:=' ';
    Ptr:=0;
End;
 
Procedure Push(c : char);
Begin
    inc(Ptr);
    Arr[ptr]:=c;
End;
 
Function Pop : char;
Begin
    Pop:=Arr[Ptr];
    Ptr:=Ptr-1;
End;
 
Procedure CheckPar( Stri : String);
Var i,j,k : Integer;
Var s,a   : char;
Var Ope   : String;
Var Clo   : String;
Begin
     Init();
     Ope:='([{';
     Clo:=')]}';
     for i:=1 to length(Stri) Do Begin
         s:=Stri[i];
         if pos(s,Ope) > 0 then Push(s);
         k:=pos(s,Clo);
         if k > 0 then Begin
            if Ptr=0 then Begin
               writeln(i);
               break;
            end
            else Begin
               a:=Pop();
               if a <> Ope[k] Then Begin
                  writeln(i);
                  break;
               end;
            End;
         End;
     End;
     if Ptr <> 0 then
        Writeln(-Ptr)
     else
        writeln('OK');
        
End;
 
Var S : String;
 
Begin
 
    write('Enter string: ');
    readln(S);
    CheckPar(S);
    
End.

program task;
const
    open = [ '{', '[', '(' ];
    close = [ '}', ']', ')' ];
    n = 10;
type
    str = packed array[ 1..n ] of char;
    stack = ^chain;
    chain = record
        item: char;
        next: stack
    end;
var
    st: str;
    s: stack;
    ok: boolean;
    i: integer;
    c, c1: char;
    
procedure clearstack( var s: stack );
begin
    if s <> nil then begin
        clearstack( s^.next );
        dispose( s );
        s := nil;
    end;
end;
 
function isempty( s: stack ): boolean;
begin
    isempty := s = nil;
end;
 
procedure pop( var s: stack; var c: char );
var
    q: stack;
begin
    c := s^.item;
    q := s;
    s := s^.next;
    dispose( q );
end;
 
procedure push( var s: stack; c: char );
var
    q: stack;
begin
    q := s;
    new( s );
    s^.item := c;
    s^.next := q;
end;
 
procedure readstr( var st: str );
var
    i: integer;
begin
    for i := 1 to n do read( st[ i ] );
end;
 
begin
s := nil;
ok := true;
i := 1;
readstr( st );
while ok and ( i < n + 1 ) do begin
    c := st[ i ];
    if c in open then push( s, c ) 
    else
        if c in close then 
            if isempty( s ) then begin
                ok := false;
                writeln( i );
            end
            else begin
                pop( s, c1 );
                ok := ( c1 = '(' ) and ( c = ')' ) or
                    ( c1 = '{' ) and ( c = '}' ) or ( c1 = '[' ) and ( c = ']' );
                if not ok then writeln( i );
            end;    
    i := i + 1;         
end;
if ok then
    if not isempty( s ) then writeln( -1 )
    else writeln( 0 );
clearstack( s );
end.

var i, a, b, c, d: integer;
    s: string;
begin
  a := 0;
  b := 0;
  c := 0;
  writeln('Введите строку:');
  readln(s);
  for i := 1 to length(s) do
    begin
      case s[i] of
        '(': inc(a);
        ')': dec(a);
        '[': inc(b);
        ']': dec(b);
        '{': inc(c);
        '}': dec(c)
      end;
      d := a or b or c;
      if d < 0
        then begin
          writeln(i);
          break
        end
    end;
  if d > 0
    then writeln(-1)
    else if d = 0
      then writeln(0)
end.

      d := a or b or c;

       if (a < 0) or (b < 0) or (c < 0) then d := -1 else d := a + b + c;

const
  tabScob: array[0..1,1..3]of char =
    (('{', '[', '('),
     ('}', ']', ')'));
var
  i,j,l,f: integer;
  s, ss: string;
begin
  { ввод строки }
  writeln('Введите строку: ');
  readln(s);
  { анализ строки }
  j:=0;
  f:=0;
  for i := 1 to length(s) do
  begin
      for l:=1 to 3 do
        if s[i] = tabScob[0,l] then
        begin
          Inc(j);
          ss[j]:=s[i];
        end
        else
        if s[i] = tabScob[1,l] then
          if j=0 then
            f:=-1
          else
            if ss[j] = tabScob[0,l] then
              Dec(j)
            else
              f:=1;
      if f<>0 then
        break;
  end;
  { вывод сообщение об результате анализа строки }
  case f of
    1: writeln('Ошибка. Позиция в строке - ', i);
    0: if j=0 then
         writeln(0)
       else
         writeln(-1);
    -1: writeln(-1);
  end;
end.