LAB 2.3 (PROC)

unit Proc;  // один параметр - имя текстового файла

{$APPTYPE CONSOLE}

interface

uses
  SysUtils,
  Windows,
  UnList,   // подключаем модули с типами и процедурами, а затем и с переменными
  UnVar;

procedure rusification;
procedure AddR(var ListN, ListK: PElem; r: TInfo); // адреса начала и конца списка и R
procedure AddN;
procedure AddFromTextFile;
procedure Add1;
procedure SearchIt;
procedure ViewList;


implementation

procedure rusification;
  begin
    SetConsoleCP(1251);      // из модуля Windows
    SetConsoleOutputCP(1251);
  end;

// добавить элемент со значением R в соответствии с заданным порядком в список
procedure AddR(var ListN, ListK: PElem; r: TInfo); // адреса начала и конца списка и R
var ListC: PElem;  // текущий элемент списка
begin
  if ListN = nil then CreateList(ListN, ListK, r)  // если список пуст
  else
    if r >= ListN^.info then AddFirst(ListN, ListK, r)  // добавить в начало
    else
       if r <= ListK^.info then AddLast(ListN, ListK, r)  // добавить в конец
       else
         begin // найти после какого
           ListC:=ListN; // с начала списка
           while ListC^.next^.info >= r do
             ListC := ListC^.next;
           AddMedium(ListN, ListC, ListK, r)  // добавить после текущего
         end;
end;

//  "Добавить псевдослучайные N элементов" в текущий список
procedure AddN;
var n,i: integer; s:string; r: TInfo;
begin
  write('Сколько N=?'); readln(s);
  if not TryStrToInt(s,n) then n:=1;
  for i:=1 to n do
  begin
    r:= char(122-random(25));
    AddR(NachaloSpiska, KonecSpiska, r);
  end;
end;

// Добавление всех данных из текстового файла в текущий список
procedure AddFromTextFile;
var
  f: TextFile;
  r: TInfo;
begin
  if ParamCount=1 then writeln('Введите элементы и Ctrl+Z') ;

  AssignFile(f, ParamStr(1));
  try
    Reset(f);
    try
      try
          while not eof(f) do
          begin
            readln(f, r);
            AddR(NachaloSpiska, KonecSpiska,r);
          end;
          writeln('Список создан');
      except
       writeln('Некорректные данные в текстовом файле '+ ParamStr(1));
      end;
    finally
      CloseFile(f);
    end;
  except
    writeln('Не удалось открыть текстовый файл '+ ParamStr(1));
  end;
end;

// Добавить один элемент  в текущий список
procedure Add1;
var
  r: TInfo;
begin
 try
  write('введите элемент, который хотите добавить  R=?'); readln(r);
  AddR(NachaloSpiska, KonecSpiska, r);
 except
    writeln('Некорректное число или ошибка добавления');
 end;
end;

// "Найти в списке"
procedure SearchIt;
var
  ListC: PElem;
  i,n:integer;
  flag:boolean;
  a,b:char;
begin
   ListC:=NachaloSpiska;
   flag:=true;
   n:=0;
   while (ListC<>nil) and (flag=true) do
  begin
    n:=n+1;
    if ((ListC^.info)=('a')) or ((ListC^.info)=('b')) then
    begin
    writeln('Номер первого символа из заданного диапазона от a до b включительно');
    writeln(n);
    flag:=false;
    end;
    ListC:=ListC^.next;
  end;
  if flag=true then writeln('В списке нет элемента, принадлежащего диапазону [a,b]');
end;

//  "Что сейчас в списке?" - вывод на экран консоли
procedure ViewList;
var
  ListC: PElem;
begin
  writeln('Список:');
  ListC:=NachaloSpiska;
  if ListC=nil then writeln('Пустой');
  while ListC<>nil do
  begin
    writeln(ListC^.info);
    ListC:=ListC^.next;
  end;
end;

end.