Строки

uses crt;
var s1,s2,tmp:string;
    i,j,k:byte;
    c:char;
begin
clrscr;
writeln('Введите последовательность слов, разделенных пробелами');
readln(s1);
 if s1[1]<>' ' then j:=1;
  for i:=2 to length(s1) do
   begin
    if (s1[i-1]=' ') and (s1[i]<>' ') then j:=i
     else if ((i=length(s1)) and (s1[i]<>' ')) or
      ((s1[i]<>' ') and (s1[i+1]=' ')) then
        begin
         if (i-j) mod 2=1 then
    continue;
     tmp:=copy(s1,j,i);
      for k:=1 to length(tmp) div 2 do
       begin
  if (tmp[k]<>tmp[length(tmp)/2+k]) then
   break;
    if (k=length(tmp)/2) and (tmp[k]=tmp[length(tmp)])
     s2:=s2+ tmp;
      end
       else
        begin
         s2:=s1+s2[i];
         end;
         end;
          writeln(s2);
          end.

div 2

if (k=length(tmp) div 2) and (tmp[k]=tmp[length(tmp)]) then  s2:=s2+ tmp;
else

function SetFirstCharLast(s: string): string;
begin
SetFirstCharLast := Copy(s, 2, Length(s) - 1) + s[1];
end;

s := Copy(s, 2, Length(s) - 1) + s[1];

program laba5;
uses crt;
 
var s1: string;
    i, j, k, len: integer;
 
begin
clrscr;
writeln('Vvedite slova cherez probel');
 readln(s1);
  if s1[1] <> ' '
   then j := 1;
    for i := 2 to length(s1) do
    begin
      if (s1[i-1] = ' ') and (s1[i] <> ' ') then
           j := i
 else if ((i = length(s1)) and (s1[i] <> ' '))
  or ((s1[i] <> ' ') and (s1[i + 1] = ' '))
   then
   begin
    if i - j mod 2 = 0 then
     continue;
len := (i - j + 1 ) div 2;
 for k := 1 to len do
  begin
   if s1[k + j] <> s1[len + k + j] then
    break;
    if (k = len - 1) and (s1[k + j] = s1[len + k + j]) then
     delete(s1, j, len * 2);
        end;
        end;
    end;
        
        s1:=s1 + copy(s1, 2, 1);
            delete(s1, 2, 1);
 
        writeln(s1);
    readln;
end.