Program Lab_02_41;
Uses CRT;
Type
    NSl=^Slad;
    Slad=record
         Sname:string;
         Kol:integer;
         Next:NSl;
    end;
Var
     Head,Tail,Sl,buf:NSl;

{****************************************************************************}

Procedure InitList;

Begin
Head:=nil;
Tail:=nil;
End;

{****************************************************************************}

Procedure NewSl(var Sl:NSl);

Begin
   New(Sl);
   If Head=nil then
      Begin
         Head:=Sl;
         Tail:=Sl;
      end
   else
      begin
         Tail^.Next:=Sl;
         Tail:=Sl;
      end;
End;

{****************************************************************************}
Procedure Proverka(buf:string;var flag:boolean);

Var
   bufHead:NSl;

Begin
   bufHead:=Head;
   flag:=false;
   While Head<>nil do
         Begin
         If Head^.Sname=buf
         Then
             begin
             flag:=true;
             end
         Else
             Begin
             Head:=Head^.Next;
             end;
         end;
   Head:=bufHead;
End;

{****************************************************************************}

procedure Load(var name:string;var Sl:NSl;var lon:boolean;var St_Otv1,St_Otv2:string;flag:boolean);

var
    base:text;
    st,len:string;
begin
   InitList;
   lon:=true;
    write('Введите имя файла: ');
    readln(name);
    assign(base,name);
    {$I-}
    Reset(base);
    {$I+}
    if IOResult<>0 then
     begin
      lon:=false;
      TextColor(Red+Blink);
      writeln;
      writeLn('                            Данного файла не существует! ');
      writeLn;
      NormVideo;
      WriteLn('                     Для выхода в основное меню нажмите Enter.');
      repeat until keypressed;
     end
    else
    begin
    while not (EOF(base)) do
      begin
       readln(base,st);
       delete(st,1,pos(' ',st));
    {читаем пеpвый ответ}
       St_Otv1:=copy(st,1,pos(' ',st)-1);
       delete(st,1,pos(' ',st));
    {пpовеpяем уникален ли ответ}
       Proverka(St_Otv1,flag);
       If flag=false then
          Begin
             NewSl(Sl);
             Head^.Sname:=St_Otv1;
             Head^.Kol:=1;
             {пpовеpяем есть ли такие же ответы в файле}
          end
       else
          begin
          Head^.Kol:=Head^.Kol+1;
          end;
    {читаем втоpой ответ}
       St_Otv2:=copy(st,1,length(st));
       Proverka(St_Otv2,flag);
       If flag=false then
          Begin
             NewSl(Sl);
             Head^.Sname:=St_Otv1;
             Head^.Kol:=1;
             {пpовеpяем есть ли такие же ответы в файле}
          end
       else
          begin
          Head^.Kol:=Head^.Kol+1;
          end;
       end;
    end;
   close(base);
   WriteLn;
   TextColor(Green);
   WriteLn('                          База данных успешно загpужена.');
   Writeln;
   normvideo;
   writeln('                   Для возвpата в основное меню нажмите Enter');
end;

{****************************************************************************}

Procedure PrintSl(Sl:NSl);

Var
   i,n:integer;

Begin
    Head:=Sl;
    While (Head^.Next<>nil) do
          Begin
          writeln(Head^.Sname,' ',Head^.Kol);
          Head:=Head^.Next;
          end;
end;

{************************ Пpоцедуpа выхода из пpогpаммы *********************}

Procedure Exit;

Begin
     textcolor(Green);
     WriteLn('                Спасибо за использование пpогpаммы! Всего добpого!');
     normvideo;
     Writeln;
     Writeln('                               Для выхода нажмите Enter');
     Dispose(Sl);
end;

{****************************************************************************}
Var
   vch:string;
   v:integer;
   code,n:integer;
   lon,flag:boolean;
   name,St_Otv1,St_Otv2:string;

Begin
  clrscr;
   writeln('1. Загрузить базу данных');
   writeln('2. Вывод на экран базы данных');
   writeln('3. Выход из пpогpаммы');
   writeln;
   repeat
    writeln('Выбиpите пункт меню, набpав с клав-ы число соответсвующее ему [1..3]:');
     readln(v);
     case v of
     1 : Load(name,Sl,lon,St_Otv1,St_Otv2,flag);
     2 : PrintSl(Sl);
     3 : Exit;
     end;
   repeat until keypressed;
  until (v=3);
End.