Работа с файлами. Записать в новый файл все слова из исходного, начинающиеся с заданной буквы

uses CRT;
var
c,k:char;
f1,f2: Text;
sl:string;
b:set of char;
function upperchar(c:char):char;
begin
case ord(c) of
    160..175:upperchar:=chr(ord(c)-32);
  224..239:upperchar:=chr(ord(c)-80);
    241:upperchar:=chr(240);
    else
    upperchar:=c;
    end;
end;
BEGIN
b:=[chr(128)..chr(175),chr(224)..chr(241)];
write('Vvedite simvol: ');
readln(c);
c:=upperchar(c);
assign(f1,'in.txt');
assign(f2,'out.txt');
reset(f1);
rewrite(f2);
while not eof(f1) do
begin
    sl:='';
    read(f1,k);
    while (not eof(f1)) and (k in b) do
    begin
        sl:=sl+k;
        read(f1,k);
    end;
  if (k in b) then
      sl := sl + k;
    if length(sl) <> 0 then
      if upperchar(sl[1]) = c then
        writeln(f2, sl);
end;
close(f1);
close(f2);
end.

uses crt;
 var f,g: text;
     s,sl: string;
     i,j: byte;
     c,k: char;
 
 begin
 assign(f,'C:\in.txt');
 assign(g,'C:\out.txt');
 write('c='); readln(c); k:=chr(ord(c)-32);
 reset(f);
 rewrite(g);
 while not (eof(f)) do
       begin
       readln(f,s); s:=' '+s+' ';
       for i:=1 to length(s)-1 do
           if (copy(s,i,2)=' '+c) or (copy(s,i,2)=' '+k) then
              begin
              sl:='';
              j:=i+1;
              while s[j]<>' ' do
                    begin
                    sl:=sl+s[j];
                    inc(j);
                    end;
              write(g,sl,' ');
              end;
       end;
 close(f);
 close(g);
 end.