[Back to FILES SWAG index] [Back to Main SWAG index] [Original]
{
GUY MCLOUGHLIN
...Here's one way of creating generic routines to handle any type
of file...
}
program Demo_Handle_Many_File_Types;
uses
crt;
type (* Path string type definition. *)
st_79 = string[79];
(* Enumerated type of the file types we want to handle. *)
FileType = (Fchar, FrecA, FrecB, Ftext, Funty);
(* First record type definition. *)
recA = record
Name : string;
Age : word
end;
(* Second record type definition. *)
recB = record
Unit : word;
City : string
end;
(* Case-varient multi-file type definition. *)
rc_FileType = record
case FT : FileType of
Fchar : (Fchar1 : file of char);
FrecA : (FrecA1 : file of recA);
FrecB : (FrecB1 : file of recB);
Ftext : (Ftext1 : text);
Funty : (Funty1 : file)
end;
(***** Display I/O error message. *)
(* *)
procedure ErrorMessage({input }
by_Error : byte;
st_Path : st_79);
var
ch_Temp : char;
begin
(* If an I/O error occured, then... *)
if (by_Error <> 0) then
begin
writeln;
case by_Error of
2 : writeln('File not found ---> ', st_Path);
3 : writeln('Path not found ---> ', st_Path);
4 : writeln('Too many files open');
5 : writeln('File access denied ---> ', st_Path);
100 : writeln('Disk read error');
103 : writeln('File not open ---> ', st_Path)
(* NOTE: The full error code listing code be *)
(* implemented if you like. *)
end;
(* Clear keyboard-buffer. *)
while keypressed do
ch_Temp := readkey;
(* Pause for key-press. *)
writeln('Press any key to continue');
repeat until keypressed
end
end; (* ErrorMessage. *)
(***** Generic open routine to handle many different file types. *)
(* *)
procedure OpenFile({input } st_Path : st_79;
bo_Create : boolean;
var rc_File : rc_FileType);
begin
{$I-}
(* Handle appropriate file type. *)
case rc_File.FT of
Fchar : begin
assign(rc_File.Fchar1, st_Path);
if bo_Create then
rewrite(rc_File.Fchar1)
else
reset(rc_File.Fchar1)
end;
FrecA : begin
assign(rc_File.FrecA1, st_Path);
if bo_Create then
rewrite(rc_File.FrecA1)
else
reset(rc_File.FrecA1)
end;
FrecB : begin
assign(rc_File.FrecB1, st_Path);
if bo_Create then
rewrite(rc_File.FrecB1)
else
reset(rc_File.FrecB1)
end;
Ftext : begin
assign(rc_File.Ftext1, st_Path);
if bo_Create then
rewrite(rc_File.Ftext1)
else
reset(rc_File.Ftext1)
end;
Funty : begin
assign(rc_File.Funty1, st_Path);
if bo_Create then
rewrite(rc_File.Funty1, 1)
else
reset(rc_File.Funty1, 1)
end
end;
{$I+}
(* Check for I/O error, and display message if needed. *)
ErrorMessage(ioresult, st_Path)
end; (* OpenFile. *)
var (* Array of 5 mulit-file type records. *)
FileArray : array[1..5] of rc_FileType;
(* Main program execution block. *)
BEGIN
(* Clear the screen. *)
clrscr;
(* Clear the multi-file type array. *)
fillchar(FileArray, sizeof(FileArray), 0);
(* Initialize each file-variable to it's own type. *)
FileArray[1].FT := Fchar;
FileArray[2].FT := FrecA;
FileArray[3].FT := FrecB;
FileArray[4].FT := Ftext;
FileArray[5].FT := Funty;
(* Create a new file of type CHAR. *)
OpenFile('D:\TMP18\CHAR.TST', true, FileArray[1]);
(* Create a new file of type RecA. *)
OpenFile('D:\TMP18\RECA.TST', true, FileArray[2]);
(* Open an existing file of type RecB. *)
OpenFile('D:\TMP18\RECB.TST', false, FileArray[3]);
(* Open an existing TEXT file. *)
OpenFile('D:\TMP18\TEXT.TST', false, FileArray[4]);
(* Open an existing un-typed file. *)
OpenFile('D:\TMP18\BIN.DAT', false, FileArray[5]);
END.
[Back to FILES SWAG index] [Back to Main SWAG index] [Original]