Действия со string

program kkk;
 
const marks: set of char = ['.', '!', '?', '''', '"'];
      inter: set of char = [',', '-'];
 
var ss: array[1..10] of string;
    s, s1, s2, t: string;
    i, k, m, n,j: integer;
    begin
  m := 0;
  writeln('Enter strings, blank string to interrupt.');
  repeat
    readln(s);
    s := s + ' ';
    s2 := s;
    if length(s) > 0 then for i := length(s) downto 1 do
      begin
        if (i < length(s)) and (s[i] = '-') and (s[i + 1] <> ' ') then continue;
        if (s[i] in marks) or (s[i] in inter) then delete(s, i, 1)
      end;
    while pos('  ', s) > 0 do delete(s, pos('  ', s), 1);
    if (length(s) > 0) and (s[length(s)] <> ' ') then s := s + ' ';
    while length(s) > 0 do
      begin
        k := pos(' ', s);
        delete(s, 1, pos(' ', s));
        if k > m then
          begin
            s1 := s2;
            m := k
          end
      end
  until s2 = ' ';
  writeln('Sentence with longest word:');
  writeln(s1);
  ss[i]:=s1;
        for i:=1 to n do
 readln(ss[i]);
 
 for i:=n-1 downto 1 do
  for j:=1 to i do
   if length(ss[j])>length(ss[j+1]) then
    begin
    t:= ss[j];
    ss[j]:=ss[j+1];
    ss[j+1]:=t;
    end;
 
writeln('-----------');
for i:=1 to n do
 writeln(ss[i]);
 
readln;
end.

program kkk;
uses crt;
const z=10;
var a:array [1..z] of string;
i, n, k :integer;
max :array [1..z] of string;
BEGIN
clrscr;
write ('Insert Sent sum :');
        readln(n);
writeln ('Insert Text : ' );
for i:=1 to n do
     begin
write('A[',i,']=');
     readln(a[i]);
    end;
for i:=1 to n do
        begin
        writeln(a[i]);
        write;
        end;
for i:=1 to n do
Begin
k:=pos ('', a[i]);
    if k > 0 then max[i]:='' else max[i]:= a[i];
    while k > 0 do
        begin
        if length(copy(a[i],1,k-1)) > length(max[i]) then max[i]:=copy(a[i],1,k-1);
        delete(a[i],1,k);
        k:=pos(' ',a[i]);
        end;
end;
if length(a[i]) > length(max[i]) then max[i]:=a[i];
Writeln('sent with max word : ', max[i]:5);
 
READLN;
End.

program kkk;
uses crt;
const z=100;
var a:array [1..z] of string;
i, n, k :integer;
max :array [1..z] of string;
str : string;
b,t:string;
    y:array [1..1000] of string;
    q,w:integer;
BEGIN
clrscr;
write ('Insert Sent sum :');
        readln(n);
writeln ('Insert Text : ' );
for i:=1 to n do
     begin
write('A[',i,']=');
     readln(a[i]);
    end;
for i:=1 to n do
        begin
        writeln(a[i]);
        write;
        end;
for i:=1 to n do
Begin
k:=pos ('', a[i]);
    if k > 0 then max[i]:='' else max[i]:= a[i];
    while k > 0 do
        begin
        if length(copy(a[i],1,k-1)) > length(max[i]) then max[i]:=copy(a[i],1,k-1);
        delete(a[i],1,k);
        k:=pos(' ',a[i]);
        end;
end;
if length(a[i]) > length(max[i]) then max[i]:=a[i];
Writeln('sent with max word : ', max[i]:5);
{------------------------------------------}
for i:= 1 to n do
str := max[i];
begin
q:=1;
b:='';
for i:=1 to length(str) do
    begin
    if (str[i]=' ') or(str[i]=' ') and (str[i+1]=' ')
    then
        begin
        y[q]:=b ;
        b:='';
        inc(q);
        end
    else b:=b+str[i];
    end;
y[q]:=b;
for i:=1 to q-1 do
    for w:=i+1 to q do
        if length(y[i])>length(y[w]) then
           begin
           t:=y[w];
           y[w]:=y[i];
           y[i]:=t;
           end;
end;
writeln;
for i:=1 to q do
    write(y[i],' ');
readln;
 
READLN;
End.