Help me pls.

var i,j,index:integer;
    S1,S2:array[1..10000]of char;
    S3:array[1..20000]of char;
function Is1stPalindrom:boolean;
var i:integer;
begin
     Is1stPalindrom:=true;
     for i:=1 to Index do
     begin
        if s1[i]<>s1[Index-i+1] then
        begin
          Is1stPalindrom:=false;
          break;
        end;
     end;

end;
function IsPalindrom(count :integer):boolean;
var i,k:integer;
begin
     IsPalindrom:=true;
     For i:=1 to Index do
     begin
       S3[i]:=S1[i];
     end;
     k:=index;
     for i:=Count downto 1 do
     begin
       s3[k]:=S2[i];
       inc(k);
     end;
     for i:=1 to K do
     begin
        if (S3[i]<>S3[k-i])and(S3[i]<>' ')and(S3[k-i]<>' ') then
        begin
           IsPalindrom:=false;
           Break;
        end;
     end;
end;
begin
     index:=1;
     fillchar(s3,sizeof(s3),' ');
     while not eoln do
     begin
      read(S1[index]);
      inc(index);
     end;

     if Is1stPalindrom then
     begin
       for i:=1 to Index do Write(s1[i]);
       Halt;
     end;

     for i:=1 to Index do
     begin
          S2[i]:=S1[i];
          if IsPalindrom(i) then
          begin
            j:=1;
            while s3[j]<>' ' do
            begin
              write(s3[j]);
              inc(j);
            end;
            Halt;
          end;
     end;
end.