строки на слова Опции

[arhimag]

program WordsToArray;
uses crt;
type TArray=array[1..128]of string;

var s:string;
mas:TArray;i:integer;

procedure GetWords(s:string; var mas:TArray);
var i,j:shortint;
begin
while pos('  ',s)<>0 do delete(s,pos('  ',s),1);
if s[1]=' ' then delete(s,1,1);
if s[length(s)]=' ' then delete(s,length(s),1);
i:=1;
for j:=1 to length(s) do
if s[j]<>' ' then mas[i]:=mas[i]+s[j] else if i<>high(mas) then inc(i);
end;

procedure EnterElement(s:string; i:integer; arr:TArray);
var j: integer;
begin
for j:= 255 downto i do Arr[j+1]:=Arr[j];
Arr[i]:=s;
end;

procedure Filter(arr:TArray);
var i:integer;
    s: string;
begin
for I:= 1 to 128 do
    case Arr[i,length(Arr[i])] of
    ',': begin s:=','; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas) end;
    '.': begin s:='.'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    '"': begin s:='"'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    '!': begin s:='!'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    '(': begin s:='('; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    ')': begin s:=')'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    ':': begin s:=':'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    ';': begin s:=';'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    '?': begin s:='?'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    end;
end;

begin
clrscr;
write('> ');
readln(s);
GetWords(s,mas);
filter(mas);
for i:=1 to high(mas) do if mas[i]<>'' then writeln(i,' - ',mas[i]);
end. 

пачему выводит стек оверфло?

[arhimag]

спс

все равно

Код

program WordsToArray;
uses crt;
type TArray=array[1..128]of string;

var s:string;
mas:TArray;i:integer;

procedure GetWords(s:string; var mas:TArray);
var i,j:shortint;
begin
while pos('  ',s)<>0 do delete(s,pos('  ',s),1);
if s[1]=' ' then delete(s,1,1);
if s[length(s)]=' ' then delete(s,length(s),1);
i:=1;
for j:=1 to length(s) do
if s[j]<>' ' then mas[i]:=mas[i]+s[j] else if i<>high(mas) then inc(i);
end;

procedure EnterElement(s:string; i:integer; arr:TArray);
var j: integer;
begin
for j:= 127 downto i do Arr[j+1]:=Arr[j];
Arr[i]:=s;
end;

procedure Filter(arr:TArray);
var i:integer;
    s: string;
begin
for I:= 1 to 127 do
    case Arr[i,length(Arr[i])] of
    ',': begin s:=','; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas) end;
    '.': begin s:='.'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    '"': begin s:='"'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    '!': begin s:='!'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    '(': begin s:='('; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    ')': begin s:=')'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    ':': begin s:=':'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    ';': begin s:=';'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    '?': begin s:='?'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    end;
end;

begin
clrscr;
write('> ');
readln(s);
GetWords(s,mas);
filter(mas);
for i:=1 to high(mas) do if mas[i]<>'' then writeln(i,' - ',mas[i]);
end.