uses crt;
var d:text; n,i,kt,j,m,dem:longint; s,k:string; a:array[1..1000,1..1000]of string; b,c:array[1..10000]of longint;
begin
clrscr;
write('Sach can tim:');readln(k);
assign(d,'SACH.txt');reset(d);
while not(eof(d)) do
begin
readln(d,n,s);
b[n]:=1;
for i:=2 to length(s) do
if s[i]=' ' then inc(b[n])
else
begin
a[n,b[n]]:=a[n,b[n]]+s[i];
if a[n,b[n]]=k then
begin
kt:=0; inc(dem);
for j:=1 to m do if c[j]=n then kt:=1;
if kt=0 then
begin
inc(m);
c[m]:=n;
end;
end;
end;
end;
write('Co ',dem,' cuon sach ',k,' trren cac ke:');
for i:=1 to m do write(c[i],',');
close(d);
readln
end.
///////////////////////////////////////////////////
Một số text cho bạn tham khảo: