Функция, возвращающая количество одинаковых слов в строках, переданных параметрами

type
    TArray = Array[Byte] Of String;
 
procedure GetWordsFromString(s: String; var ar: TArray; var n: Byte);
var
    temp: String;
    i: Byte;
    found: Boolean;
begin
    n := 0;
    s := s + ' ';
    while (Length(s) > 0) do
    begin
        temp := Copy(s, 1, Pos(' ', s) - 1);
        Delete(s, 1, Pos(' ', s));
        found := False; i := 0;
        while ((i < n) And (Not found)) do
        begin
            found := temp = ar[i];
            Inc(i);
        end;
        if (Not found)
        then
        begin
            ar[n] := temp;
            Inc(n);
        end;
    end;
end;
 
function FindSameWords(s1, s2: String): Byte;
var
    words1, words2: TArray;
    i, j, n, m, Result: Byte;
begin
    GetWordsFromString(s1, words1, n);
    GetWordsFromString(s2, words2, m);
    Result := 0;
    if ((n <> 0) And (m <> 0))
    then
        for i := 0 to n - 1 do
            for j := 0 to m - 1 do
                if (words1[i] = words2[j])
                then
                    Inc(Result);
    FindSameWords := Result;
end;
 
var
    s1, s2: String;
begin
    Write('s1='); ReadLn(s1);
    Write('s2='); ReadLn(s2);
    WriteLn('result=', FindSameWords(s1, s2));
end.