Строки. Вторую букву каждого слова заменить на 'z'. +3 задачи.

uses crt;
var
s:string;
n,i,j:byte;
begin
clrscr;
writeln('Введите строку');
readln(s);
s:=' '+s+' ';
n:=length(s);
i:=1;
while i<n do
  begin
  if s[i]=' ' then
                  begin
                  j:=i+1;
                  while s[j]<>' ' do
                    begin
                    if j=i+2 then s[j]:='z';
                    inc(j);
                    end;
                  end;
  i:=j;
  end;
delete(s,n,1);
delete(s,1,1);
Writeln('Строка после замены:');
writeln(s);
readln;
end.

uses crt;
var
s,s1:string;
n,i,j:byte;
begin
clrscr;
writeln('Введите строку');
readln(s);
s:=' '+s+' ';
n:=length(s);
i:=1;
while i<n do
  begin
  if s[i]=' ' then
                  begin
                  j:=i+1;
                  s1:=s[j];
                  while s[j]<>' ' do
                    begin
                    inc(j);
                    if s[j]=s1 then
                                   begin
                                   delete(s,j,1);
                                   dec(j);
                                   end;
                    end;
                  end;
  i:=j;
  end;
delete(s,n,1);
delete(s,1,1);
Writeln('Строка после замены:');
writeln(s);
readln;
end.

uses crt;
var st, buf:string;
i, j, k:integer;
f, t:boolean;
words:array[1..200]of string;
 
begin
    k:=0;
    write('-> ');
    readln(st);
    buf:=''; 
    for i:=1 to length(st) do
    begin
        if st[i]<>' ' then
        begin
            buf := buf + st[i];
            f:=true;
        end else begin
            if f then
            begin
                t := true;  
                for j := 1 to k do if words[j] = buf then
                begin
                    t := false;
                    break;
                end;
                if t then
                begin
                    inc(k);
                    words[k]:=buf;
                end;
                f := false;
            end;
            buf := '';
        end;
    end;
    if buf<>'' then
    begin
        t := true;  
        for j := 1 to k do if words[j] = buf then
        begin
            t := false;
            break;
        end;
        if t then
        begin
            inc(k);
            words[k]:=buf;
        end;
        buf:='';
    end;
 
    writeln('Найдено ',k,' слов');
    for i:=1 to k do writeln(words[i]);
    readln;
end.