rogram Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  windows;

const n=20;
type
tstudent = record
             name:string[10];
             kurs:Byte;
             group:Byte;
             spec:string[10];
             mark:String[9];
           end;
tmas=array [1..n] of tstudent;
tfile=file of tstudent;
var a:tmas;
    f,f1:Text;
    f2:tfile;
    s:String;

 //-----------------------------------------------------------------
procedure vvoddannuh(var a:tmas);
var i:Integer;
p:tstudent;
begin
  Rewrite(f);
  writeln (f,'------------------------------------------------------------');
  writeln (f,'   фио    /к/г/ спец-ть  /оценки     ');
  writeln (f,'------------------------------------------------------------');
  for i:=1 to n do
     with p do
  begin
    Write('введи фамилию');
    Readln(f,name);
    Write('введи курс');
    Readln(f,kurs);
    Write('введи специальность');
    Readln(f,spec);
    Write('введи результат последней сессии');
    Readln(f,mark);
    writeln(f,name:10,kurs:1,spec:10,mark:9);
    writeln
  end;
    Close(f)
end;
//------------------------------------------------------------------------------
Procedure printdannuh(a:tmas);
var i:Integer;
begin
   Rewrite(f1);
   Rewrite(f2);
   writeln (f1,'------------------------------------------------------------');
   writeln (f1,'   фио    /к/г/ спец-ть  /оценки     ');
   writeln (f1,'------------------------------------------------------------');
   for i:=1 to n do
  With a[i] Do
   begin
      writeln(f1,name,kurs,spec,mark);
      write(f2,a[i])
   end;
 Close(f1);
 Close(f2);
end;
//-----------------------------------------------
procedure read_info( a:tmas);
 var i:integer;
  begin
    Reset(f);
    readln(f);
    readln(f);
    readln(f);
    for i:=1 to n do
      With a[i] Do
      begin
         Readln(f,name,kurs,group,spec,mark);
         //Здесь нужно убрать лишние пробелы ...
         name:=TrimLeft(name);
         spec:=TrimLeft(spec)
      end;
    Close(f)

  end;

procedure sort(var a:tmas);
var x:tstudent; i,j:integer;
 begin
   for i:=1 to n-1 do
   for j:=1 to n-i do
    begin
    if a[j].kurs>a[j+1].kurs then
     begin
      x:=a[j]; a[j]:=a[j+1]; a[j+1]:=x;
     end;
    if a[j].kurs=a[j+1].kurs then
      if a[j].group>a[j+1].group then
      begin
       x:=a[j]; a[j]:=a[j+1]; a[j+1]:=x;
      end;
    end;
 end;

procedure Odnofam (r:byte; a:tmas);
var i,j,kk,k: byte; aa:tmas; s,ss: string; f1: Text; f3:tfile;
begin
  Append(f1);
  Reset(f2);
  Seek(f2,FileSize(f2)); //Указатель в конец файла
  Writeln(f1);
 s:='Список групп, в которых есть однофамильцы: ';
 k:=0;
for i:=1 to r do
    for j:=i+1 to r do
           with a[i] do
                if a[i].name=a[j].name then
                begin
                  inc(k);
                  kk:=0;
                  str(a[i].group,ss);
                  ss:=' '+ss+' ';
                  if pos(ss,s)=0 then s:=s+ss;
                  if kk=0 then
                     aa[k]:=a[i]
                end;
   if k>=1 then
     for i:=1 to k do
        with aa[i] do
        begin
           Writeln(f1,'Фио', name);
           Writeln(f1,'к', kurs);
           Writeln(f1,'г', group);
           Writeln(f1,'спец-ть', spec);
           Writeln(f1,'оценки',mark);
           Writeln(f1);
           Write(f2,aa[i])
        end
   else
     writeln('таких групп нет');
writeln(s);
Close(f1);
Close(f2);
readln;
end;


begin
 setconsoleoutputcp(1251);
 SetConsoleCP(1251);
 Assign(f,'список.txt');
 Assign(f1,'список2.txt');
 Assign(f2,'список3.dat');
 if FileExists('список.txt') then
    begin
     read_info(a);
     Reset(f);
     while not Eof(f) do
     begin
       Readln(f,s);
       Writeln(s)
     end;
     Close(f);
     sort(a);
     writeln('список отсортирован');
     printdannuh(a);
     Odnofam(n,a);
     Reset(f1);
      while not Eof(f1) do
     begin
       Readln(f1,s);
       Writeln(s)
     end;
     Close(f1);
     end
 else
    vvoddannuh(a);
 Readln
end.

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  windows;

const n=20;
type
tstudent = record
             name:string[10];
             kurs:Byte;
             group:Byte;
             spec:string[10];
             mark:String[5];
           end;
tmas=array [1..n] of tstudent;
tfile=file of tstudent;
var a:tmas;
    f,f1,f3:Text;
    f2:tfile;
    s:String;

 //-----------------------------------------------------------------
procedure vvoddannuh;
var i:Integer;
    p:tstudent;
begin
  Rewrite(f);
  writeln (f,'------------------------------------------------------------');
  writeln (f,'   фио    /к/г/ спец-ть  /оценки     ');
  writeln (f,'------------------------------------------------------------');
  for i:=1 to n do
     with p do
  begin
    Write('введи фамилию');
    Readln(name);
    Write('введи курс');
    Readln(kurs);
    Write('введи группу');
    Readln(group);
    Write('введи специальность');
    Readln(spec);
    Write('введи результат последней сессии');
    Readln(mark);
    writeln(f,name:10,kurs:1,group:1,spec:10,mark:5);
    writeln
  end;
    Close(f)
end;
//------------------------------------------------------------------------------
Procedure printdannuh(a:tmas);
var i:Integer;
begin
   Rewrite(f1);
   //Rewrite(f2);
   writeln (f1,'------------------------------------------------------------');
   writeln (f1,'   фио    /к/г/ спец-ть  /оценки     ');
   writeln (f1,'------------------------------------------------------------');
   for i:=1 to n do
  With a[i] Do
   begin
      writeln(f1,name,kurs,group,spec,mark);
     // write(f2,a[i])
   end;
 Close(f1);
 //Close(f2);
end;
//-----------------------------------------------

procedure read_info( a:tmas);
 var i:integer;
  begin
    Reset(f);
    readln(f);
    readln(f);
    readln(f);
    for i:=1 to n do
     //With a[i] Do
      begin
         Readln(f,a[i].name,a[i].kurs,a[i].group,a[i].spec,a[i].mark);
         //Здесь нужно убрать лишние пробелы ...
        // name:=TrimLeft(name);
        // spec:=TrimLeft(spec)
      end;
    Close(f)

  end;

procedure sort(var a:tmas);
var x:tstudent; i,j:integer;
 begin
   for i:=1 to n-1 do
   for j:=1 to n-i do
    begin
    if a[j].kurs>a[j+1].kurs then
     begin
      x:=a[j]; a[j]:=a[j+1]; a[j+1]:=x;
     end;
    if a[j].kurs=a[j+1].kurs then
      if a[j].group>a[j+1].group then
      begin
       x:=a[j]; a[j]:=a[j+1]; a[j+1]:=x;
      end;
    end;
 end;
//------------------------------------------------------------------------------
procedure Odnofam (r:byte; a:tmas);
var i,j,kk,k: byte; aa:tmas; s,ss: string; f3: Text; f2:tfile;
begin
  Assign(f3,'list3.txt');
  assign(f2,'list_3.dat');
  Rewrite(f3);
  Rewrite(f2);
 Seek(f2,FileSize(f2)); //Указатель в конец файла
 Writeln(f3);
 s:='Список групп, в которых есть однофамильцы: ';
 k:=0;
for i:=1 to r do
    for j:=i+1 to r do
           with a[i] do
                if a[i].name=a[j].name then
                begin
                  inc(k);
                  kk:=0;
                  str(a[i].group,ss);
                  ss:=' '+ss+' ';
                  if pos(ss,s)=0 then s:=s+ss;
                  if kk=0 then
                     aa[k]:=a[i]
                end;
   if k>=1 then
     for i:=1 to k do
        with aa[i] do
        begin
           Writeln(f3,'Фио', name);
           Writeln(f3,'к', kurs);
           Writeln(f3,'г', group);
           Writeln(f3,'спец-ть', spec);
           Writeln(f3,'оценки',mark);
           Writeln(f3);
           Write(f2,aa[i])
        end
   else
     writeln('таких групп нет');
writeln(s);
Close(f3);
Close(f2);
readln;
end;
//------------------------------------------------------------------------------

begin
 setconsoleoutputcp(1251);
 SetConsoleCP(1251);
 Assign(f,'list_1.txt');
 Assign(f1,'list_2.txt');
 Assign(f2,'list_3.dat');
 if FileExists('list_1.txt') then
    begin
     read_info(a);
     Reset(f);
     while not Eof(f) do
     begin
       Readln(f,s);
       Writeln(s)
     end;
     Close(f);
     sort(a);
     writeln('список отсортирован');
     printdannuh(a);
     Odnofam(n,a);
     Reset(f1);
      while not Eof(f1) do
     begin
       Readln(f1,s);
       Writeln(s)
     end;
     Close(f1);
     end
 else
    vvoddannuh;
 Readln
end.