Переписать в отдельный текстовый файл строки, содержащие заданный символ не более одного раза

var
  input, output: text;
  Name,str,str2: string;
  Ch,ch2: char;
  I,j: integer;
  Result: Boolean;
 
begin
  writeln('Заданный символ');
  readln(ch2);
Assign (input, 'F:\IPA\input.txt');
  Reset (input);
  Assign (output,'F:\IPA\output.txt');
  Rewrite (output);
 
  Result := IOResult = 0;
  if Result then begin
 
   while not eof(input) do
 
   begin
   readln(input,str2);
     for j:= 1 to length(str2)  do
          if str2[j]=ch2 then inc(i);
       
 
         if i <= 1  then begin
       
         writeln(output,str2);
         end;
        
         str:=''   ;
         i:=0;
    end;
  end
  else
    writeln('файла нет');
 
  close(input);
  close (output);
  readln;
end.

var
    f, g: Text;
    s: String;
    c: Char;
    i, count: Byte;
begin
    Assign(f, 'f.txt'); Reset(f);
    Assign(g, 'g.txt'); Rewrite(g);
    Write('Введите контрольный символ: '); ReadLn(c);
    while (Not EoF(f)) do
    begin
        ReadLn(f, s);
        count := 0;
        i := 1;
        while ((i <= Length(s)) And (count < 2)) do
        begin
            Inc(count, Ord(s[i] = c));
            Inc(i);
        end;
        if (count < 2)
        then
            WriteLn(g, s);
    end;
    Close(f); Close(g);
end.