Файл: Упорядочить список студентов по алфавиту и распечатать его. - Free Pascal

const
    M = 4;
type
    TStudent = record
        lastName: String[12];
        firstName: String[10];
        year: Integer;
        month: 1..12;
        day: 1..31;
        marks: Array[1..M] Of 2..5;
    end;
    TFileTStudents = File Of TStudent;
    TArrayTSudents = Array Of TStudent;
var
    f: TFileTStudents;
procedure SwapStudents(var x, y: TStudent); //обмен студентов в массиве
var
    z: TStudent;
begin
    z := x;
    x := y;
    y := z;
end;
function CompareName(const s1, s2: String): Boolean; //True - если второе должно быть перед первым
var
    Result, notFound: Boolean;
    i, minLength: Byte;
begin
    notFound := True; //"пока что" разницы не нашли
    i := 1; //сравниваем с первого символа
    //определяем наименьшую длину
    if (Length(s1) < Length(s2))
    then
        minLength := Length(s1)
    else
        minLength := Length(s2);
    //сравниваем посимвольно
    while ((notFound) And (i <= minLength))  do //пока не найдём разницу или не дойдём до конца одной (более короткой) строки
    begin
        notFound := s1[i] = s2[i]; //помечаем разные ли символы
        if (Not notFound) //если символы разные
        then
            Result := s1[i] > s2[i]; //находим какой из них первее (меньше) по алфавиту
        Inc(i); //переходим к следующему символу
    end;
    CompareName := Result Or ((notFound) And (Length(s2) < Length(s1))); //если определили в цикле или (на отрезке minLength не было разницы и вторая фамилия короче первой. например фамилии "Козлова" и "Козлов". "Козлов" должен быть перед "Козлова").
end;
procedure SortStudentsByLastName(var f: TFileTStudents); //сортировка
var
    ar: TArrayTSudents;
    i, j: Byte;
begin
    //читаем из файла в массив
    ReSet(f); SetLength(ar, 0);
    while (Not EoF(f)) do
    begin
        SetLength(ar, Length(ar) + 1);
        Read(f, ar[Length(ar) - 1]);
    end;
    Close(f);
    //сортировка
    for i := Length(ar) - 2 downto 0 do
        for j := 0 to i do
            if (CompareName(ar[j].lastName, ar[j + 1].lastName)) //сравниваем фамилии
            then //если нужно менять
                SwapStudents(ar[j], ar[j + 1]); //меняем. ваш кэп
    //перезаписываем сортированные данные из массива в файл
    ReWrite(f);
    for i := 0 to Length(ar) - 1 do
        Write(f, ar[i]);
    Close(f);
end;
procedure ReadFormFileAndPrint(var f: TFileTStudents); //чтение из файла и вывод на экран. код элементарный и не требует комментариев
var
    stud: TStudent;
begin
    ReSet(f); WriteLn; WriteLn;
    while (Not EoF(f)) do
    begin
        Read(f, stud);
        with stud do
            WriteLn(lastName, ' ', firstName);
    end;
    Close(f);
end;
procedure AddingStudents(var f: TFileTStudents); //добавление в файл. всё достаточно тривиально и просто
var
    i, j, n: Byte;
    stud: TStudent;
begin
    repeat
        Write('How much to add? ');
        ReadLn(n);
    until (n > 0);
    ReWrite(f);
    for i := 1 to n do
        with stud do
        begin
            WriteLn('Adding ', i, ' student:');
            Write(#9, 'Last name? '); ReadLn(lastName);
            Write(#9, 'First name? '); ReadLn(firstName);
            Write(#9, 'Birth year? '); ReadLn(year);
            repeat
                Write(#9, 'Birth month? '); ReadLn(month);
            until (month in [1..12]);
            repeat
                Write(#9, 'Birth day? '); ReadLn(day);
            until (day in [1..31]);
            WriteLn(#9, 'Adding marks:');
            for j := 1 to M do
            begin
                repeat
                    Write(#9, #9, 'mark[', j, ']='); ReadLn(marks[j]);
                until (marks[j] in [2..5]);
            end;
            Write(f, stud);
        end;
    Close(f);
end;
begin
    Assign(f, 'student.dat'); AddingStudents(f);
    SortStudentsByLastName(f);
    ReadFormFileAndPrint(f);
end.