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.