Переписать в новый файл G все строки текстового файла F, которые содержат строковую переменную S (Паскаль)

[pashka_dos]

Задача: создать текстовый файл F. Переписать в новый файл G все строки файла F, которые содержат строковую переменную S.
Не знаю почему, но программа работает через 1 раз т.е. иногда записывеет строку в файл G а игогда не записывает. Вот код.Где ошибка?

program file_;
uses crt;
var f,f1: text;
    n,i,j: integer;
    s,s_u: string;
    m: array [1..100] of string;
begin
clrscr;
write('Колличество строк в файле?...'); readln(n);
assign(f,'abc.txt');
rewrite(f);
for i:=1 to n do begin
    write('Введите ',i,' строку...');
    readln(s);
    writeln(f,s);
    writeln;
end;
close(f);
write('Введите строку которую нужно найти в файле F и записать в файл G...');readln(s_u);
reset(f);
         for i:=1 to 3 do begin
             read(f,s);
             if s = s_u then m[i]:=s;
         end;
close(f);

assign(f1,'abc2.txt');

rewrite(f1);
for i:=1 to n do
    if m[i] <> '' then writeln(f1,m[i]);
close(f1);

writeln('Содержимое файла G...');

reset(f1);
for i:=1 to n do
    if m[i] <> '' then begin
       read(f1,m[i]);
       writeln(m[i]);
end;
close(f1);

readln;
readln;
END.

[Serge_Bliznykov]

полный ужас и абстракция.
начиная от использования массива непонятного назначения, и заканчивая циклом от 1 до 3 (почему до 3-х) ?!?!


я бы предложил такой вариант:

.... тут заполнение исходного файла 
close(f);

write('Введите строку которую нужно найти в файле F и записать в файл G...');
readln(s_u);

reset(f);
assign(f1,'abc2.txt');
rewrite(f1);
while Not Eof(f) do begin
     readln(f,s);
     if Pos(s_u, s)>0 then WriteLn(f1, s);
end;
close(f);
close(f1);

ВСЁ!

p.s. я бы создание исходного файла вынес вообще в отдельную программу!