Psst.. new poll here.
Psst.. new forums here.
Microsoft is blocking us again (TY IP Reputation!) so just use oauth login instead. :)
Paste
Pasted by hitagi ( 16 years ago )
program l6v2;
uses
crt;
type
t_dbe= record
phn:byte;
rmn:byte;
nm:array[1..4] of string[15];
end;
t_dba= array[1..20] of t_dbe;
var
dba: t_dba;
path: string;
ans: char;
searchbyte, io: byte;
searchstring: string;
procedure readdb(var db: t_dba; path: string; var ioerror: byte);
var
dbf: file of t_dbe;
i: byte;
begin
assign(dbf, path);
{$I-}
reset(dbf);
{$I+}
ioerror:=IOResult;
writeln(ioerror);
if ioerror=0
then
for i:=1 to 20 do
read(dbf, dba[i])
end;
procedure writedb(var db: t_dba; path: string; var ioerror: byte);
var
dbf: file of t_dbe;
i: byte;
begin
assign(dbf, path);
{$I-}
rewrite(dbf);
{$I+}
ioerror:=IOResult;
if ioerror=0
then
for i:=1 to 20 do
write(dbf, dba[i])
end;
procedure showdb(db: t_dba);
var
i: byte;
begin
writeln('ÉÍÍÍÍÍÑÍÍÍÍÍÍÍÑÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
writeln('º No. ³ Phone ³ Room ³ Name 1 ³ Name 2 ³ Name 3 ³ Name 4 º');
writeln('ÇÄÄÄÄÄÅÄÄÄÄÄÄÄÅÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ');
for i:=1 to 20 do
writeln('º ', i:3, ' ³ ', db[i].phn:5, ' ³ ', db[i].rmn:4, ' ³ ', db[i].nm[1]:15, ' ³ ', db[i].nm[2]:15, ' ³ ', db[i].nm[3]:15, ' ³ ', db[i].nm[4]:15, ' º');
writeln('ÈÍÍÍÍÍÏÍÍÍÍÍÍÍÏÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ')
end;
procedure editdbentry(var db: t_dba; entry: byte);
begin
write('Input phone number (', db[entry].phn, '): ');
readln(dba[entry].phn);
write('Input room number (', db[entry].rmn, '): ');
readln(dba[entry].rmn);
write('Input 1st name (', db[entry].nm[1], '): ');
readln(dba[entry].nm[1]);
write('Input 2nd name (', db[entry].nm[2], '): ');
readln(dba[entry].nm[2]);
write('Input 3rd name (', db[entry].nm[3], '): ');
readln(dba[entry].nm[3]);
write('Input 4th name (', db[entry].nm[4], '): ');
readln(dba[entry].nm[4])
end;
procedure createdb(var db: t_dba);
var
i: byte;
begin
for i:=1 to 20 do
begin
clrscr;
writeln('Entry no. ', i);
editdbentry(db, i)
end
end;
procedure editdb(var db: t_dba);
var
i: byte;
begin
write('Input column number: ');
readln(i);
editdbentry(db, i)
end;
procedure searchdbphone(db: t_dba; search: byte);
var
i: byte;
begin
for i:=1 to 20 do
if (db[i].phn=search)
then
writeln('º ', i:3, ' ³ ', db[i].phn:5, ' ³ ', db[i].rmn:4, ' ³ ', db[i].nm[1]:15, ' ³ ', db[i].nm[2]:15, ' ³ ', db[i].nm[3]:15, ' ³ ', db[i].nm[4]:15, ' º');
end;
procedure searchdbroom(db: t_dba; search: byte);
var
i: byte;
begin
for i:=1 to 20 do
if (db[i].rmn=search)
then
writeln('º ', i:3, ' ³ ', db[i].phn:5, ' ³ ', db[i].rmn:4, ' ³ ', db[i].nm[1]:15, ' ³ ', db[i].nm[2]:15, ' ³ ', db[i].nm[3]:15, ' ³ ', db[i].nm[4]:15, ' º');
end;
procedure searchdbname(db: t_dba; search: string);
var
i: byte;
begin
for i:=1 to 20 do
if (db[i].nm[1]=search) or (db[i].nm[2]=search) or (db[i].nm[3]=search) or (db[i].nm[4]=search)
then
writeln('º ', i:3, ' ³ ', db[i].phn:5, ' ³ ', db[i].rmn:4, ' ³ ', db[i].nm[1]:15, ' ³ ', db[i].nm[2]:15, ' ³ ', db[i].nm[3]:15, ' ³ ', db[i].nm[4]:15, ' º');
end;
begin
clrscr;
write('Path to DB file: ');
readln(path);
readdb(dba, path, io);
clrscr;
writeln('DB file: ', path);
writeln;
if io=0
then
begin
writeln('1: Edit database;');
writeln('2: Search by phone number;');
writeln('3: Search by room number;');
writeln('4: Search by name;');
ans:=readkey;
clrscr;
writeln('DB file: ', path);
writeln;
case ans of
'1':
begin
showdb(dba);
writeln;
editdb(dba)
end;
'2':
begin
write('Input phone number to search: ');
readln(searchbyte);
searchdbphone(dba, searchbyte)
end;
'3':
begin
write('Input room number to search: ');
readln(searchbyte);
searchdbroom(dba, searchbyte)
end;
'4':
begin
write('Input name to search: ');
readln(searchstring);
searchdbname(dba, searchstring)
end
end
end
else
begin
writeln('1: Create new database;');
writeln('or any other key to exit.');
ans:=readkey;
case ans of
'1':
createdb(dba);
end
end;
if ans='1'
then
writedb(dba, path, io);
end.
Revise this Paste
Children: 25130