Разделить текстовый файл на несколько - Turbo Pascal

Формулировка задачи:

В исходном текстовом файле находится информация о студенте: фамилия и группа. Программа сортирует студентов по группам и записывает в новый файл. Нужно, чтобы для каждой группы создавался отдельный файл. Пример исходного файла: Иванов 6101 Петров 6101 Сидоров 6103 Николаев 6103 Данилов 6105 Александров 6105 Все это записывается в виде: 6101 Иванов Петров 6103 Сидоров Николаев 6105 Данилов Александров Задача: Создать для каждой группы отдельный файл, который будет называться номером группы.

{$R-}
uses crt;
 
type stud=record
          fam,grp:string[20];
          end;
     mas=array[1..300] of stud;
 
procedure ReadFile(var f:text; var a:mas; var n:integer; var b:byte);
var nf,s:string;
begin
  b:=0;
  write('Имя для чтения файла: ');
  readln(nf);
  nf:=nf+'.txt';
  assign(f,nf);
  {$I-}
  reset(f);
  {$I+}
  if IOResult <> 0 then
    begin
      b:=1;
      writeln('Файла ',nf,' не существует');
      writeln('Работа программы завершена. Нажмите ENTER');
      readln;
      exit;
    end;
  n:=0;
  while not eof(f) do
    begin
      readln(f,s);
      n:=n+1;
      a[n].fam:=copy(s,1,pos(' ',s)-1);
      delete(s,1,pos(' ',s));
      a[n].grp:=s;
    end;
  close(f);
  end;
 
procedure Sort(var a:mas;  n:integer);
var i,j:integer;
    x:stud;
begin
  for i:=1 to n-1 do
    for j:=i+1 to n do
      if (a[i].grp > a[j].grp) then
        begin
          x:=a[i];
          a[i]:=a[j];
          a[j]:=x;
        end;
end;
 
procedure WriteFile(var f:text; a:mas; n:integer);
var i:integer;
    nf:string;
begin
  write('Имя файла для записи: ');
  readln(nf);
  nf:=nf+'.txt';
  assign(f,nf);
  rewrite(f);
  for i:=1 to n do
    begin
      if (a[i].grp <> a[i-1].grp) or (i=1) then
        begin
          writeln(f,'');
          writeln(f,a[i].grp);
          writeln(f,'  ',a[i].fam);
        end
      else writeln(f,'  ',a[i].fam);
    end;
  close(f);
  write('Список переписан в файл ',nf);
  readln;
end;
 
var f,g:text;
    sp:mas;
    n:integer;
    w:byte;
begin
  clrscr;
  ReadFile(f,sp,n,w);
  if w=1 then exit
  else
    begin
      Sort(sp,n);
      WriteFile(g,sp,n);
    end;
end.

Решение задачи: «Разделить текстовый файл на несколько»

Листинг программы

var
  s: String;
  p: Integer;
  f: Text;
begin
  Assign(input,'input.txt'); Reset(input);
  while not SeekEOF do begin
    ReadLn(s); p:=Pos(' ',s);
    Assign(f,Copy(s,p+1,Length(s))); {$I-}Append(f);{$I+}
    if IOResult<>0 then Rewrite(f);
    WriteLn(f,Copy(s,1,p-1); Close(f);
  end;
end.

Объяснение кода листинга программы

В начале объявляются переменные: s, p и f. Переменная s типа String, переменная p типа Integer, а переменная f типа Text.
Затем происходит назначение файла input.txt в переменную input с помощью функции Assign.
С помощью функции Reset происходит сброса файла input.txt.
Затем в цикле while не используется условие до тех пор, пока не будет достигнут конец файла с помощью функции SeekEOF.
Внутри цикла происходит чтение строки s с помощью функции ReadLn. Значение переменной p устанавливается равным позиции пробела в строке s с помощью функции Pos.
Затем с помощью функции Copy происходит копирование подстроки s от позиции p+1 до конца строки s в переменную f. Функция Append используется для добавления символа новой строки в конец строки f.
Если при чтении файла произошла ошибка, то используется функция Rewrite для перезаписи файла f.
Затем происходит запись подстроки s от позиции 1 до позиции p-1 в файл f с помощью функции WriteLn.
После окончания записи закрывается файл f с помощью функции Close.
Цикл while продолжается до тех пор, пока не будет достигнут конец файла.