| Код |
uses crt;
type
TStrArr=array[1..30] of string;
var
arr: TStrArr;
str: string;
size: integer;
function split(var s: string): boolean;
var
i, start, num: integer;
space: boolean;
point: boolean;
succ: boolean;
begin
space:=false;
point:=false;
succ:=true;
num:=1;
start:=1;
for i:=1 to length(s) do
begin
if s[i]=' ' then
begin
if space=false then
begin
if length(arr[num])<2 then
begin
writeln('Error: string "',arr[num],'" too short');
succ:=false;
end;
delete(arr[num], length(arr[num]), 1);
inc (num);
if num>30 then
begin
writeln('Error: number of strings too large');
succ:=false;
break;
end;
end;
space:=true;
end
else if s[i] in ['A'..'z'] then
begin
space:=false;
arr[num]:=arr[num]+s[i];
if length(arr[num])>10 then
begin
writeln('Error: string "',arr[num],'" too large');
succ:=false;
end;
end
else if s[i]='.' then
begin
if length(arr[num])<2 then
begin
writeln('Error: string "',arr[num],'" too short');
succ:=false;
end;
delete(arr[num], length(arr[num]), 1);
point:=true;
break;
end
else
begin
writeln('Error: unresolved symbol "',s[i],'"');
succ:=false;
{break;}
end;
end;
if not point then
begin
writeln('Error: "." expected');
succ:=false;
end;
if num<2 then
begin
writeln('Error: number of words too short');
succ:=false
end;
size:=num;
split:=succ;
end;
procedure writeall;
var i: integer;
begin
for i:=1 to size do
begin
writeln(arr[i]);
end;
end;
procedure writenotequlast;
var
i: integer;
str: string;
begin
str:=arr[size];
for i:=1 to size-1 do
begin
if arr[i]<>str then
writeln(arr[i]);
end;
end;
begin
clrscr;
readln(str);
if split(str) then
begin
writeln;
writeln('All words:');
writeall;
writeln;
writeln('Words <> last:');
writenotequlast;
end;
readkey;
end.
|
|