home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
pascal
/
library
/
dos
/
tp_fast
/
version4
/
t_file.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-11-15
|
6KB
|
205 lines
{ -------------------------------------------------------------------------- }
{ t_file.pas }
{ demo of file functions for TPFAST }
{ -------------------------------------------------------------------------- }
uses dos,crt,tpfast;
type
userrec = record
name :string[18];
address :string[40];
phone :string[14];
end;
const
maxrecs = 5; { maximum records }
fname = 'test.rec'; { sample file name }
f_read = 0; { used in fopen }
f_write = 1; { ditto }
f_readwrite = 2; { ditto }
readonly = 1; { already defined standard run-time }
hidden = 2; { use logical OR for combined file attributes }
sysfile = 4;
volumeid = 8;
directory = 16;
archive = 32;
var
ch :char;
testrecs :array [1..maxrecs] of userrec;
{ -------------------------------------------------------------------------- }
procedure errorexit(msg :string);
begin
writeln('Error -',msg);
halt(1);
end;
{ -------------------------------------------------------------------------- }
procedure maketestarray;
begin
with testrecs[1] do
begin
name := 'Eddy Murphey';
address := '33 Holywood ave';
phone := '132-3346';
end;
with testrecs[2] do
begin
name := 'Jack Frost';
address := '11 Omeo road Mount Hotham';
phone := '054-230-1306';
end;
with testrecs[3] do
begin
name := 'Indiana Jones';
address := '44 Hospital avenue Egypt';
phone := '991-3127';
end;
with testrecs[4] do
begin
name := 'Jenny Morris';
address := '9 Music house raod Australia';
phone := '(07)-568-9129';
end;
with testrecs[5] do
begin
name := 'Ivan Ackerman';
address := '40 Woody allen bollevard Coloreado';
phone := '(291)-345-6729';
end;
end;
{ -------------------------------------------------------------------------- }
procedure maketestfile;
var
f :integer;
numwritten,loop :integer;
begin
writeln('[ Making test file .... ]');
maketestarray; { init array with names }
f := fcreate(fname,archive); { create the file }
case (f) of
-3 : errorexit('path not found');
-4 : errorexit('too many open files');
-5 : errorexit('access denied');
end;
for loop := 1 to maxrecs do
numwritten := fwrite(f,sizeof(testrecs[loop]),testrecs[loop]);
if (fclose(f) = false) then
writeln('Unable to close file ',fname);
end;
{ -------------------------------------------------------------------------- }
procedure readtestfile;
var
f,numread :integer;
buf :userrec;
begin
writeln('[ Reading test file .... ]');
writeln;
f := fopen(fname,0); { open for reading }
repeat
numread := fread(f,sizeof(buf),buf); { read one record }
if (numread > 0) then { if read OK }
writeln(buf.name:18,buf.address:40,buf.phone:16);
until (numread <= 0);
if (fclose(f) = false) then { close file }
writeln('Unable to close file ',fname); { check if OK }
end;
{ -------------------------------------------------------------------------- }
procedure appendrec;
var
f :integer;
pos,newpos :longint;
buf :userrec;
numwritten :integer;
begin
writeln('[ Appending a record .... ]');
with buf do
begin { create a temp record }
name := 'Darren Bastard';
address := '99 Horse Court ';
phone := '784-2876';
end;
f := fopen(fname,1); { open for writing }
if (f < 0 ) then { check if OK }
errorexit('Unable to open file');
pos := maxrecs * sizeof(buf); { move to end of file }
if (fseek(f,0,pos,newpos) = false) then { check if OK }
errorexit('Error in FSeek operation ...');
numwritten := fwrite(f,sizeof(buf),buf); { write the record }
if numwritten < sizeof(buf) then { check if OK }
errorexit('in appending to file ...');
if (fclose(f) = false) then { close file }
errorexit('Unable to close file.'); { check if OK }
end;
{ -------------------------------------------------------------------------- }
procedure updaterec(recno :byte);
var
f :integer;
pos,newpos :longint;
buf :userrec;
numwritten :integer;
begin
writeln('Updating record number ',recno,' ....');
with buf do
begin { create temp record }
name := 'Darren Bastard';
address := '99 Horse Court ';
phone := '784-2876';
end;
f := fopen(fname,1); { open file for reading }
if (f < 0 ) then { check if OK }
errorexit('Unable to open file');
pos := recno * sizeof(buf); { calculate record position }
if (fseek(f,0,pos,newpos) = false) then { move to record position }
errorexit('File seek failed.');
numwritten := fwrite(f,sizeof(buf),buf); { write the record }
if numwritten < sizeof(buf) then { check if OK }
errorexit('in appending to file ...');
if (fclose(f) = false) then { close file }
errorexit('Unable to close file.'); { check if OK }
end;
{ -------------------------------------------------------------------------- }
begin
clrscr;
maketestfile;
readtestfile;
ch := readkey;
updaterec(2);
readtestfile;
ch := readkey;
end.