Дан символьный файл

uses crt;
var
i,j,n,m,r:byte;
a:array [1..100] of char;
b:array [1..100] of byte;
y,z:char;
f,g: file of char;
 
begin
clrscr;
assign(f,'d:\1.dat');
assign(g,'d:\2.dat');
rewrite(f);
repeat begin read(x); write(f,x) end; until ord(x)=13; close(f); 
reset(f);
z:='_';
m:=1;
{считаем кол-во записанных человек, фиксируя начало каждого в массиве b}
for m:=1 to filesize(f) do begin read (f,a[m]);
                            if a[m]=' ' then begin inc(r); b[r]:=m end;end;
 
for j:=1 to r do begin
    {каждый цикл начинаем со следующего человека по ссылке на массив  b}
    reset(f); seek(f,b[j]);{считываем фамилию в массив а}
    repeat begin read(f,y); i:=i+1; a[i]:=y; end until y='_'; 
 
    rewrite(g);  seek(f, b[j]+i); {считываем имя отчество и записываем в файл g}
    repeat  begin read(f,y); write(g,y) end until y=','; 
 
    {меняем , на _ в конце файла g}
    seek(g,filesize(g)-1); write(g,z);
    seek(g,filesize(g)); {переходим в конец файла g и дописываем фамилию}
    for n:=1 to i do write(g,a[n]); close(g);
    {переходим к следующему человеку}
   end
end.

Program ggg;
uses crt;
Type A= file of char;
Var f:A;
    i,n:integer;
    sp,sp1,sp2,sp3:string;d:char;
Procedure convert(Var S:String;Var f1:A);
Var i,n:integer;
    c:char;
begin
  for i:=1 to ord(s[0]) do
  begin
    seek(f1,FileSize(f1));
    d:=s[i];
    Write(f1,d);
  end;
  s:='';
end;
Begin
 ClrScr;
 repeat
  Write('Введите колличество записей ');
  ReadLn(n);
 until n > 0;
Assign(F,'f');
ReWrite(f);
for i:=1 to n do
begin
  Write('Фамилия ');
  readLn(sp1);sp1:=sp1+'__';
  Write('Имя ');
  readLn(sp2);sp2:=sp2+'__';
  Write('Отчество ');
  readLn(sp3);sp3:=sp3+',';
  sp:=sp1+sp2+sp3;
  convert(sp,f);
end;
ClrScr;
Reset(f);
While not eof(f) do
  begin
    read(f,d);
    Write(d);
  end;
readLn;
close(f);
end.

Program m;
Uses crt;
Type AA=file of char;
Var
    F,G:AA;
Procedure convert(Stroka:String);
Var i,n:integer;
    c:char;
begin
  for i:=1 to ord(stroka[0]) do
  begin
    seek(G,FileSize(G));  //нахожу конец файла для дозаписи
    c:=stroka[i];
    Write(g,c);
  end;
  //stroka:='';
end;
 
Procedure ststst(St:String);
Var fam,na,pt,h:String;
    x:integer;
begin
h:='_';
    x:=Pos(h,St);
    Fam:=copy(st,1,x-1);  delete(st,1,x+1); //удаляем фамилию
    x:=Pos(h,St);
    Na:=copy(st,1,x-1);   delete(st,1,x+1); //удаляем имя
    pt:=st;              //остаётся отчество
    WriteLn;
    convert(Na+'__');convert(pt+'__');convert(fam+','); //передаём строки для посимвольной записи в файл g
    st:='';
end;
 
 
Procedure Search(Var ff:AA);
Var c:char;
    s:string;
Begin
s:='';  ReSet(ff);
While not eof(ff) do
begin
  read(ff,c);
  if c <> ',' then
    s:=s+c  else
    begin
      Ststst(s);
      s:='';
    end;
end;
end;
 
Procedure Prosmotr(Var fg:AA);
Var d:char;
begin
  While not eof(fg) do
  begin
    Read(fg,d);
    Write(d);
  end;
end;
 
Begin
  ClrScr;
  Assign(f,'f');   Assign(g,'g');  ReWrite(g);
  Reset(f);
  WriteLn('Данный файл : ');
  Prosmotr(f);
  WriteLn;
  Search(f);
  WriteLn('Получилось : ');
  ReSet(g);
  Prosmotr(g);
readLn;
close(f);close(g);
end.