home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programming
/
powerprogramming1994.iso
/
progtool
/
borland
/
jnfb88.arc
/
TSORT.ARC
/
RDSRT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-10-16
|
2KB
|
94 lines
program Read_Sort_Write_Sequential_File;
type
FileName = record (* FileName is an 18-byte record *)
Filenm : array[1..12] of char;
Index : array[1..4] of char;
CR : byte;
LF : byte;
end;
DirectoryFile = file of FileName;
var
Nom : array[1..18] of char; Results : integer;
{$I SORT.BOX }
procedure Inp;
var
rec : integer;
f : text;
begin
ClrScr;
writeln('Preparing to sort file names.'); writeln;
writeln('Collecting file names...'); writeln;
Assign(f,'TEST.DAT'); {$I-} Reset(f); {$I+}
if IOresult <> 0 then begin
writeln('Not there.');
end;
rec := 0;
repeat
rec := rec + 1;
write(#13, rec:6);
readln(f,Nom);
SortRelease(Nom);
until EOF(f);
writeln(' file names collected'); writeln;
writeln('Now sorting...(this might take a few minutes).');
end;
function Less;
var
FirstObject : FileName absolute X;
SecondObject: FileName absolute Y;
begin
Less := FirstObject.Filenm < SecondObject.Filenm;
end;
procedure OutP;
var
i : integer;
Thing : FileName;
g : text;
begin
writeln;
writeln('Writing temporary disk files...');
Assign(g,'TEST.OUT');
Rewrite(g);
repeat
SortReturn(Thing);
writeln(g,Thing.Index);
until SortEOS;
close(g);
end;
procedure DisplayResults(results : integer);
begin
Writeln;
Writeln;
case Results of { display sort results }
0 : Writeln('Returning to main program.');
3 : Writeln('Error: not enough memory to sort');
8 : Writeln('Error: illegal item length.');
9 : Writeln('Error: can only sort ', MaxInt, ' records.');
10 : Writeln('Error: disk full or disk write error.');
11 : Writeln('Error: disk error during read.');
12 : Writeln('Error: directory full or invalid path name');
end; (* case *)
end; (* DisplayResults *)
begin
Results := TurboSort(SizeOf(FileName)); DisplayResults( Results );
end.
------------------------------------------------- end of Figure 1 ------