Односвязный список(запись в файл)

type
  {Тип основных данных. Т. к., данные этого типа будут записаны в файл, то используем
  упакованный тип (packed).}
  TData = packed record
    Name : String;
    Count : Integer;
  end;
  {Типы, описывающие элементы списка.}
  TPElem = ^TElem;
  TElem = record
    Data : TData;
    PNext : TPElem;
  end;
...
var
  List : TPElem;
  F : File of TData;
...

type
  {Тип основных данных. Т. к., данные этого типа будут записаны в файл, то используем
  упакованный тип (packed).}
  TData = packed record
    Name : String;
    Count : Integer;
  end;
  TPData : ^TData;
  {Типы, описывающие элементы списка.}
  TPElem = ^TElem;
  TElem = record
    PData : TPData;
    PNext : TPElem;
  end;
...
var
  List : TPElem;
  F : File of TData;
...

const
  Fn = 'file.txt';
var
  List, PElem : TPElem;
  F : File of TData;
begin
  List := nil;
  Assign(F, Fn);
  Reset(F);
  while not Eof(F) do begin
    New(PElem); {Выделяем память для нового элемента.}
    Read(F, PElem^.Data); {Читаем данные очередного элемента из файла.}
    AddToList(List, PElem); {Добавляем элемент в список List.}
  end;
  Close(F);
...
end.

program Project1;
 
type
  {Тип основных данных.}
  TData = Integer;
  {Указатель на элемент списка.}
  TPElem = ^TElem;
  {Элемент списка.}
  TElem = record
    Data : TData;   {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент.}
  end;
  {Список.}
  TDList = record
    PFirst, PLast : TPElem; {Указатели на первый и на последний элементы списка.}
  end;
 
{Процедура инициализации списка. Внимание! Эту процедуру можно выполнять
только в отношении пустого списка. Иначе, произойдёт утечка памяти.}
procedure Init(var aL : TDList);
begin
  aL.PFirst := nil;
  aL.PLast := nil;
end;
 
{Добавление элемента в конец списка.}
procedure Add(var aL : TDList; const aData : TData);
var
  PNew : TPElem;
begin
  New(PNew);
  PNew^.Data := aData;
  PNew^.PNext := nil;
  if aL.PFirst = nil then
    aL.PFirst := PNew
  else
    aL.PLast^.PNext := PNew;
  aL.PLast := PNew;
end;
 
{Освобождение памяти, занятой под список.}
procedure ListFree(var aL : TDList);
var
  PCur, PDel : TPElem;
begin
  PCur := aL.PFirst;
  while PCur <> nil do begin
    PDel := PCur;
    PCur := PCur^.PNext;
    Dispose(PDel);
  end;
  Init(aL);
end;
 
{Распечатка всего списка.}
procedure LWriteln(const aL : TDList);
var
  PCur : TPElem;
  i : Integer;
begin
  PCur := aL.PFirst;
  i := 0;
  while PCur <> nil do begin
    Inc(i);
    if i > 1 then Write(', ');
    Write(PCur^.Data);
    PCur := PCur^.PNext;
  end;
  if i = 0 then
    Writeln('Список пуст.')
  else
    Writeln;
end;
 
{Прикладные процедуры.}
 
{Диалог добавления элементов в список.}
procedure WorkAdd(var aL : TDList);
var
  S : String;
  Data : TData;
  Code : Integer;
begin
  Writeln('Добавление элементов в список.');
  Writeln('Ввод каждого значения завершайте нажатием Enter.');
  Writeln('Чтобы прекратить ввод, оставьте пустую строку и нажмите Enter.');
  repeat
    Write('Элемент: ');
    {$I-}
    Readln(S);
    {$I+}
    if S <> '' then begin
      Val(S, Data, Code);
      if Code = 0 then
        Add(aL, Data)
      else
        Writeln('Неверный ввод. Повторите.');
    end;
  until S = '';
  Writeln('Ввод элементов списка завершён.');
end;
 
{Диалог записи списка в файл.}
procedure WorkSave(const aL : TDList);
var
  F : File of TData;
  Fn : String;
  PElem : TPElem;
begin
  Writeln('Запись списка в файл.');
  Write('Имя файла: ');
  Readln(Fn);
  if Fn <> '' then begin
    Assign(F, Fn);
    {$I-}
    Rewrite(F);
    {$I+}
    if IOResult = 0 then begin
      PElem := aL.PFirst;
      while PElem <> nil do begin
        Write(F, PElem^.Data);
        PElem := PElem^.PNext;
      end;
      Writeln('Список записан в файл.');
    end
    else
      Writeln('Не удалось создать файл! Проверьте имя файла.');
    end;
end;
 
{Диалог чтения списка из файла.}
procedure WorkLoad(var aL : TDList);
var
  F : File of TData;
  Fn : String;
  Data : TData;
begin
  Writeln('Чтение списка из файла.');
  Write('Имя файла: ');
  Readln(Fn);
  Assign(F, Fn);
  {$I-}
  Reset(F);
  {$I+}
  if IOResult = 0 then begin
    {Освобождаем память, занятую для элементов списка.}
    ListFree(aL);
    {Создаём список из элементов, прочитанных из файла.}
    while not Eof(F) do begin
      Read(F, Data);
      Add(aL, Data);
    end;
    Writeln('Список прочитан из файла.');
  end
  else
    Writeln('Не удалось открыть файл! Проверьте имя файла.');
end;
 
var
  L : TDList;
  Cmd : Integer;
begin
  {Начальная инициализация списка.}
  Init(L);
 
  repeat
    {Меню.}
    Writeln('------------------------------');
    Writeln('Выберите действие:');
    Writeln('1: Добавление элементов в список.');
    Writeln('2: Распечатка всего списка.');
    Writeln('3: Запись списка в файл.');
    Writeln('4: Чтение списка из файла.');
    Writeln('5: Очистка списка (освобождение памяти).');
    Writeln('6: Выход.');
    Write('---Введите команду: ');
    Readln(Cmd);
    case Cmd of
      1 : WorkAdd(L);
      2 :
      begin
        Writeln('Содержимое списка:');
        LWriteln(L);
      end;
      3 : WorkSave(L);
      4 : WorkLoad(L);
      5, 6 :
      begin
        ListFree(L);
        Writeln('Память, выделенная для списка, освобождена (список очищен).');
        if Cmd = 6 then
          Writeln('Работа программы завершена. Для выхода нажмите Enter.');
      end;
      else
        Writeln('Незарегистрированная команда. Повторите ввод.');
    end;
    Write('Для продолжения нажмите Enter. ');
    Readln;
  until Cmd = 6;
end.