Отсортировать файл по алфавиту(Ф.И.О) — Pascal(Паскаль)

Program SortText;
  Uses Crt;
  Type
    FIO = record
            surname : string;
            name : string;
            patronymic : string;
          End;
    ft = file of FIO;
  Var
    f  : text;
    f1 : ft;
 
  Procedure TextType(var f : text;
                     var f1 : ft);
    Var
      st : string;
      buf : FIO;
    Begin
      Reset(f); Rewrite(f1);
      While not EOF(f) do
        Begin
          Readln(f,st);
          buf.surname := Copy(st,1,Pos(st,' ')-1);
          Delete(st,1,Pos(st,' '));
          buf.name := Copy(st,1,Pos(st,' ')-1);
          While Pos(buf.name,' ') <> 0 do
            Delete(buf.name,Pos(buf.name,' '),1);
          Delete(st,1,Pos(st,' '));
          buf.patronymic := Copy(st,1,Pos(st,' ')-1);
          While Pos(buf.patronymic,' ') <> 0 do
            Delete(buf.patronymic,Pos(buf.patronymic,' '),1);
          Write(f1,buf);
        End;
    End;
 
  Procedure TypeText(var f : text;
                     var f1 : ft);
    Var
      buf : FIO;
    Begin
      Reset(f1); Rewrite(f);
      While not EOF(f1) do
        Begin
          Read(f1,buf);
          Write(f,buf.surname); Write(f,buf.name); Writeln(f,buf.patronymic);
        End;
    End;
 
  Procedure Sort(var f1 : ft);
    Var
      i,j : byte;
      a,b,c : FIO;
    Begin
      Reset(f1);
      For i := 0 to FileSize(f1)-1 do
        For j := i+1 to FileSize(f1)-1 do
          Begin
            Seek(f1,i); Read(f1,a);
            Seek(f1,j); Read(f1,b);
            If a.name < b.name Then
              Begin
                c := a; a := b; b := c;
                Seek(f1,i); Write(f1,b);
                Seek(f1,j); Write(f1,c);
              End;
          End;
    End;
 
  Procedure OpenFile(var f:text);
    Var fname : string;
    Begin
      Repeat
        Write('Enter file name>'); Readln(fname);
        assign(f,fname);
        {$I-}
        Reset(f);
        {$I+}
        If IOResult = 0 Then break
        Else
          Begin
            Writeln('Bad file name'); Readkey;
          End;
      Until false;
    End;
 
BEGIN
  ClrScr;
    OpenFile(f);
    assign(f1,'~text.dat'); Rewrite(f1);
    TextType(f,f1);
    Sort(f1);
    TypeText(f,f1);
    Close(f); Close(f1);
    Erase(f1);
  Readkey;
END.

Leave a Comment

+ 20 = 26