Помогите разобраться, такая ерунда получается просто жуть.

Uses CRT;

type
 TElem = string;
 TStack = ^TElement;
 TElement = record
             info:TElem;
             Next:TStack
            end;
Procedure StackPush(var S:TStack; E:TElem);
Procedure print;

Procedure StackPush(var S:TStack; E:TElem);
var
z:TStack;
begin
new(z);
z^.next:=s;
Z^.INFO:=E;
s:=z;
end;
Procedure print (p:Tstack);
var i: integer;
begin
 for i:=1 to length(p^.info)  do
    begin
    Write(p^.info[i]);
      end;
      end;

const
 gl: set of char = ['a', 'e', 'i', 'j', 'o', 'u', 'y'];
 sogl: set of char = ['b', 'c', 'd', 'f', 'g', 'h', 'k', 'l', 'm', 'n', 'p', 'g', 'r', 's', 't', 'v', 'w', 'x', 'z'];

 var
 s: string;
 stekgl: Tstack;
 steksogl: Tstack;
 i: byte;
begin
 ClrScr;
 writeln('vvedite tekst: ');
 readln(s);
 for i := 1 to length(s) do
   begin
      if s[i] in gl then begin StackPush(stekgl, s[i]) end
     else
       if s[i] In sogl Then
         begin  StackPush(steksogl, s[i]) end;
   end;
 ClrScr;
 writeln;
 writeln('tekst: ', s);
 writeln;
 writeln('glasnie iz teksta: ');
 print(stekgl);
 writeln('soglasnie iz teksta: ');
 print(steksogl);
 writeln;
 ReadKey
end.

Задание – Последовательность символов, ограниченную точкой, занести в два стека, содержащих гласные и согласные буквы. Вывести текст и элементы из обоих стеков.

Ну почему же жуть? Просто вот так будет правильней...

Uses CRT;

type
  TElem = char; { зачем тут была строка? }
  TStack = ^TElement;
  TElement = record
    info:TElem;
    Next:TStack
  end;

{ заносим данные в стек }
Procedure StackPush(var S:TStack; E:TElem);
var z:TStack;
begin
  new(z);
  z^.next:=s;
  Z^.INFO:=E;
  s:=z;
end;

{ забираем данные из стека }
function StackPop(var s: tstack): TElem;
var p: TStack;
begin
  stackpop := #0; { это на случай если стек пустой }
  if s <> nil then begin
    p := s;
    s := s^.next;
    stackpop := p^.info;
    dispose(p)
  end;
end;

{ Печатаем стек, одновременно забирая из него элементы }
Procedure print(p:Tstack);
var i: integer;
begin
  while p <> nil do
    Writeln(StackPop(p));
end;

const
  gl: set of char = ['a', 'e', 'i', 'j', 'o', 'u', 'y'];
  sogl: set of char = ['b', 'c', 'd', 'f', 'g', 'h', 'k', 'l', 'm', 'n', 'p', 'g', 'r', 's', 't', 'v', 'w', 'x', 'z'];

var
  s: string;
  stekgl: Tstack;
  steksogl: Tstack;
  i: byte;
begin
  ClrScr;
  writeln('vvedite tekst: ');
  readln(s);
  for i := 1 to length(s) do begin
    if s[i] in gl then StackPush(stekgl, s[i])
    else
      if s[i] In sogl Then StackPush(steksogl, s[i])
  end;
  ClrScr;
  writeln;
  writeln('tekst: ', s);
  writeln;
  writeln('glasnie iz teksta: ');
  print(stekgl);
  writeln('soglasnie iz teksta: ');
  print(steksogl);
  writeln;
  ReadKey
end.

Вот и все

Работает!!! Огромное спасибо!

Сама программа:

uses crt,stack,charlist;
var
 G,S:TStack;
 P:Tlist;
 c:char;
 MG,MS:set of char;
begin
 BListinit(P);
 repeat
  c:=readkey;
  write©;
  BListAddLast(P,c);
 until c='.';
 MG:=['a', 'e', 'i', 'j', 'o', 'u', 'y'];
 MS:=['b', 'c', 'd', 'f', 'g', 'h', 'k', 'l', 'm', 'n', 'p', 'g', 'r', 's', 't', 'v', 'w', 'x', 'z'];
 StackInit(G); StackInit(S);
 while P <> nil DO
 begin
  c:=P^.Info;
  if c in MG then stackpush(G,C);
  if c in ms then stackpush(S,C);
  P := P^.Next
 end;
 writeln;
 writeln('согл.');
 while S <> nil DO
 begin
  c:=S^.Info;
  write(c,' ');
  S := S^.Next
 end;
 writeln;
 writeln('гласн.');
 while G <> nil DO
 begin
  c:=G^.Info;
  write(c,' ');
  G := G^.Next
 end;
end.

Модуль stack:Нажмите для просмотра прикрепленного файла
молуль charlist: Нажмите для просмотра прикрепленного файла
и файл list.pas: Нажмите для просмотра прикрепленного файла
volvo быстрее...
p.s. все реализованно по материалам FAQ'a.....
модуль charlist - шаблон для работы с модулем LIST, (в списокмы помещаем символы) а stack - модуль для работы со стеком.

p.s.

writeln('vvedite tekst: ');
  readln(s);

Попробую защититься - учто если последовательность больше 255 символов?