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

uses crt;
var f,g:text;
    nf,ng:string;
    c:char;
begin
clrscr;
write('Имя файла для чтения: ');
readln(nf);{вводим без расширения, например file1}
nf:=nf+'.txt';
assign(f,nf);
{$I-} reset(f);  {$I+}
if IOResult <> 0 then
 begin
  writeLn('Файл ',nf,' не найден!');
  writeLn('Работа программы завершена. Нажмите ENTER');
  readln;
  exit;
 end;
write('Имя для нового файла: ');
readln(ng);{также}
ng:=ng+'.txt';
assign(g,ng);
rewrite(g);
while not eof(f) do
 begin
  read(f,c); {читаем символ}
  {если при переводе его из ANSI в ASCII получается согласная}
  if chr(ord(c)-64) in ['Б','Г','Д','Ж','З','Й','К','Л','М','Н','П','Р','С','Т','Ф','Х',
  'Ц','Ч','Ш','Щ','Ъ','Ь'] then write(g,c);{пишем ее в новый файл}
 end;
close(f);
close(g);
write('Согласные буквы переписаны в файл ',ng);
readln
end.

Const
  m=['А','У','Е','Ы','О','Э','Я','И','Ю','Ё'];
Var
  f,g: Text;
  s: String;
  x: Char;
BEGIN
Write('Введите имя файла: ');
Readln(s);
Assign(f,s+'.txt');
{$I-}
Reset(f);
{$I+}
If IOResult=0 Then
begin
  Assign(g,s+'2.txt');
  Rewrite(g);
  While not Eof(f) do
  begin
    Read(f,x);
    If not (x in m) Then
    Write(g,x);
  end;
  Close(f);
  Close(g);
  Writeln('Gotovo');
end
Else Writeln('Fail ne naiden');
Readln
END.