Найти самое короткое слово предложения

uses Crt;
type
   matr = array[1..100] of string;
var
   s1,s2: string;
   m1,m2: matr;
   i,j,min,k1,k2,ik: integer;
label 100;
 
procedure sch(s: string; var m: matr; var k: integer);
var
   i1,i2: integer;
begin
   s:= s +' ';
   i1:= 0;
   k:= 1;
   repeat
      i2:= pos(' ',s);
      m[k]:= copy(s,i1+1,i2-i1-1);
      inc(k);
      delete(s,i2,1);
      i1:= i2-1;
   until i2>length(s);
   dec(k)
end;
 
BEGIN
   clrscr;
   writeln('Введите первое предложение');
   readln(s1);
   writeln('Введите второе предложение');
   readln(s2);
   sch(s1,m1,k1);
   sch(s2,m2,k2);
   min:= 255;
   for i:= 1 to k1 do begin
      for j:= 1 to k2 do
         if m1[i] = m2[j] then goto 100;
      if length(m1[i]) < min then begin
         min:= length(m1[i]);
         ik:= i;
      end;
100:
   end;
   writeln(m1[ik]);
   readln
END.

if m1[i] = m2[j] then Break;

uses Crt;
type
   matr = array[1..100] of string;
var
   s1,s2: string;
   m1,m2: matr;
   i,j,min,k1,k2,ik: integer;
   b: boolean;
 
procedure sch(s: string; var m: matr; var k: integer);
var
   i1,i2: integer;
begin
   s:= s +' ';
   i1:= 0;
   k:= 1;
   repeat
      i2:= pos(' ',s);
      m[k]:= copy(s,i1+1,i2-i1-1);
      inc(k);
      delete(s,i2,1);
      i1:= i2-1;
   until i2>length(s);
   dec(k)
end;
 
BEGIN
   clrscr;
   writeln('s1 = ?');
   readln(s1);
   writeln('s2 = ?');
   readln(s2);
   sch(s1,m1,k1);
   sch(s2,m2,k2);
   min:= 255;
 
   for i:= 1 to k1 do begin
      b:= true;
      for j:= 1 to k2 do
         if m1[i] = m2[j] then
            begin b:= false; break end;
      if b then
         if length(m1[i]) < min then begin
            min:= length(m1[i]);
            ik:= i;
         end;
   end;
   writeln(m1[ik]);
   readln
END.

var
  s,s3,s1,s2:string;
  l:integer;
 begin
   write('Предложение 1>'); readln(s1);
   write('Предложение 2>'); readln(s2);
   s2:=#32+s2+#32;
   s1:=s1+#32;
   l:=length(s1);s3:='';
   repeat
     s:=copy(s1,1,pos(#32,s1)-1);
     if (s<>'') and (pos(#32+s+#32,s2)=0) and (length(s)<l)then 
        begin 
          l:=length(s);
          s3:=s;
        end;
        delete(s1,1,pos(#32,s1));
     until s1='';
     if s3='' then writeln('Все слова из Предложения 1 присутствуют в Предложении 2');
     writeln(s3);
 end.

var
  p1,p2:string;
 function compare(ss1,ss2:string):string;
 var
   s,s1,s2,s3:string;
   l:integer;
 begin
  s2:=#32+ss2+#32;
   s1:=ss1+#32;
   l:=length(s1);s3:='';
   repeat
     s:=copy(s1,1,pos(#32,s1)-1);
     if (s<>'') and (pos(#32+s+#32,s2)=0) and (length(s)<l)then 
        begin 
          l:=length(s);
          s3:=s;
        end;
        delete(s1,1,pos(#32,s1));
     until s1='';
   compare:=s3;
 end;
 begin
   write('Предложение 1>'); readln(p1);
   write('Предложение 2>'); readln(p2);
      if compare(p1,p2)='' then writeln('Все слова из Предложения 1 присутствуют в Предложении 2')
                           else writeln('Короткое слово из Предложения 1: ',compare(p1,p2));
      if compare(p2,p1)='' then writeln('Все слова из Предложения 2 присутствуют в Предложении 1')
                           else writeln('Короткое слово из Предложения 2: ',compare(p2,p1));
 end.

const
  LSize=100;
  delims=[#0..'/',':'..'@','['..'`','{'..#127];
type
  TWord=String[40];
 
function GetWord(s: String; var i: Integer): String;
var j: Integer;
begin
  while (i<=Length(s)) and (s[i] in delims) do Inc(i);
  j:=i;
  while (i<=Length(s)) and not (s[i] in delims) do Inc(i);
  GetWord:=Copy(s,j,i-j);
end;
 
function IsLess(s1, s2: String): Boolean;
begin
  IsLess:=(Length(s1)<Length(s2)) or 
          (Length(s1)=Length(s2)) and (s1<s2);
end;
 
procedure SplitWords(s: String; var w: array of TWord;
  wSize: Integer; var n: Integer);
var
  i, j, k: Integer;
  tw: TWord;
begin
  n:=0; i:=1;
  while (n<wSize) do begin
    tw:=GetWord(s,i); if tw='' then Break;
    j:=0; while (j<n) and IsLess(tw,w[j]) do Inc(j);
    if (j=n) or (j<n) and (tw<>w[j]) then begin
      Inc(n); for k:=n downto j+1 do w[k]:=w[k-1];
      w[j]:=tw;
    end;
  end;
end;
 
procedure MergeUniq(w1, w2: array of TWord; n1, n2: Integer;
  var w: array of TWord; Size: Integer; var n: Integer);
var
  i, i1, i2: Integer;
begin
  n:=0; i1:=0; i2:=0;
  while (i1<n1) and (i2<n2) do begin
    if IsLess(w1[i1],w2[i2]) then begin w[n]:=w1[i1]; Inc(i1); Inc(n); end
    else if IsLess(w2[i2],w1[i1]) then begin w[n]:=w2[i2]; Inc(i2); Inc(n); end
    else begin Inc(i1); Inc(i2); end;
  end;
  while (i1<n1) do begin w[n]:=w1[i1]; Inc(i1); Inc(n); end;
  while (i2<n2) do begin w[n]:=w2[i2]; Inc(i2); Inc(n); end;
end;
 
var
  w1, w2, w3: array [1..LSize] of TWord;
  c1, c2, c3: Integer;
  s: String;
begin
  Write('Предложение 1: '); ReadLn(s); SplitWords(s,w1,LSize,c1);
  Write('Предложение 2: '); ReadLn(s); SplitWords(s,w2,LSize,c2);
  MergeUniq(w1,w2,c1,c2,w3,LSize,c3);
  Write('Искомое слово');
  if c3>0 then WriteLn(': ',w3[1])
  else WriteLn(' не найдено.');
end.