Из созданного текста получить два новых текста так, чтобы в одном были четные слова, во втором - нечетные

{Из созданного текста получить два новых текста так, чтобы в одном были
четные слова, во втором - нечетные. После слова оставался свой разделитель
слова. Затем слова в текстах рассортировать по длине слова}
const
  max_str=10000;
  limits = [#0..#32,'.',',',':',';','!','?','"'];
type
   TWords = array[1..max_str] of string;
Var
  s:string;
  sout1,sout2:string;
  fin,fout1,fout2:text;
  text2 : string;
  bigwords,words : TWords;
//  r,q,i,n,k:integer;
 
function GetWords(s : string; var w : TWords) : byte;
{(C) Klem4}
var
   i,back,n : byte;
begin
   i := 1;
   n := 0;
   while(i<=length(s)) do begin
      while(i<=length(s)) and (s[i] in limits) do
       inc(i);
      if i<=length(s) then begin
         back := i;
         while(i<=length(s)) and not(s[i] in limits) do
          inc(i);
         inc(n);
         w[n] := copy(s, back, i-back+1);
      end;
   end;
 
   GetWords := n;
end;
 
 
procedure Sort(n:integer; var a:twords);
var
  i,j:integer;
  s:string;
begin
  for i:=1 to n-1 do
    for j:=i+1 to n do
      if Length(a[i])>Length(a[j]) then
        begin
          s:=a[i];
          a[i]:=a[j];
          a[j]:=s;
        end;
end;
 
procedure GetOddStr(s:string; var sodd,snodd:string);
{(C) CodeR}
Var
  s3,s2,s1:string;
  k:byte;
begin
  s:=s+' ';
  s3:=''; s2:=''; s1:='';
  While Pos(' ',s)>0 do
    Begin
      s1:=Copy(s,1,Pos(' ',s)-1);
      Delete(s,1,Pos(' ',s));
      if s1<>'' then
        inc(k);
      if k mod 2 = 0 then
        s2:=s2+s1+' '
      else
        s3:=s3+s1+' ';
    End;
  snodd:=s2;
  sodd:=s3;
end;
 
procedure SortFile(var f:text);
var
  r,q,i,k,n:integer;
begin
  k:=1; n:=1;
  reset(f);
  while not eof(f) do
    begin
      readln(f,text2);
      k:=GetWords(text2,words);
      q:=n+k-1;
      r:=1;
      for i:=n to q  do
        begin
           bigwords[i]:=words[r];
           inc(r);
        end;
        n:=n+k;
    end;
  close(f);
  sort(n,bigwords);
  rewrite(f);
  for i:=1 to n do
    begin
      write(bigwords[i],' ');
      write(f,bigwords[i],' ');
    end;
  close(f);
end;
 
Begin
  assign(fin,'infile.txt');
  assign(fout1,'outfile1.txt');
  assign(fout2,'outfile2.txt');
  reset(fin);
  rewrite(fout1);
  rewrite(fout2);
  while not eof(fin) do
    begin
      readln(fin,s);
      GetOddStr(s,sout1,sout2);
      writeln(fout1,sout1);
      writeln(fout2,sout2);
    end;
  close(fin);
  close(fout1);
  close(fout2);
  sortfile(fout1);
  writeln;
  sortfile(fout2);
  readln;
End.

var
  t1, t2: string;
  k: byte;
  con: set of char;
  i, kb, max,x: integer;
 
begin
  writeln('Ввести текст');
  readln(t1);
  con := [' ', '.'];
  if not (t1[length(t1)] in con) then {Считаем кол-во букв в слове}
    t1 := t1 + '.';
  max := 0;kb := 0;
  for i := 1 to length(t1) do
    if not (t1[i] in con) then inc(kb)
    else if kb > 0 then
    begin
      if t1[i - kb] = t1[i - 1] then
        t2 :=copy(t1, i - kb, kb+1);
    end;
  write(t1);
  writeln;
end.

{$reference System.Core.dll}
uses System, System.Linq;
 
begin
  var s : string := 
    'Лучшим доктором в мире считается время. ' +
    'Я давно не грущу, обходя этот дом. ' +
    'Только взглянешь на окна, и что-то защемит, ' +
    'И чуть-чуть поболит и отпустит. Потом.';
    
  var all := s.Split('  '.ToCharArray(), StringSplitOptions.RemoveEmptyEntries).
    Select((x : string) -> x + (x[x.Length] in ['.',',',':',';','!','?','"'] ? '' : ' ')).ToArray();
  var odds := all.Where((x : string, i : integer) -> odd(i)).ToArray();
  var evens := all.Where((x : string, i : integer) -> not odd(i)).ToArray();
  writeln(string.Join(' ', evens.OrderBy((x : string) -> x.Length).ToArray()), NewLine, 
          string.Join(' ', odds.OrderBy((x : string) -> x.Length).ToArray()));    
end.