В списке на каждой строчке расположен отдельный элемент для поиска.
uses crt;
type
st = array [1..10] of String;
rz = array [1..10] of Integer;
function isLetter(c : char) : boolean;
begin
if ((c >= 'A') and (c <= 'z')) or ((c >= #128) and (c <= #175)) or ((c >= #224) and ( c <= #241))
then
isLetter := true
else
isLetter := false;
end;
function FindNextWord(s : string; var b : integer; var w : string) : boolean;
var
i, j : integer;
begin
i := b;
w :='';
while not isLetter(s[i]) and (i <= length(s)) do
i := i + 1;
if i > length(s) then
begin
FindNextWord := false;
exit;
end;
while isLetter(s[i]) do
begin
w := w + s[i];
i := i + 1;
end;
b := i + 1;
if length(w) > 0 then
FindNextWord := true
else
FindNextWord := false;
end;
var
sp : st;
rez : rz;
s, w : string;
tx, str : text;
i, j, b : integer;
BEGIN
clrscr;
i := 0;
j := 0;
b := 1;
assign(tx, 'text.txt');
reset(tx);
assign(str, 'spisok.txt');
reset(str);
While not eof(str) do
begin
i := i + 1;
readln(str, sp[i]);
end;
While not eof(tx) do
begin
s := '';
readln(tx, s);
for j := 1 to i do
begin
while FindNextWord(s, b, w) = true do
begin
If w = sp[j] then
Inc(rez[j]);
end;
b := 1
end;
end;
for j := 1 to i do
WriteLn(sp[j], ' - ', rez[j]);
ReadLn;
close(tx);
close(str);
END.
Вот частичный.