Monday 5 August 2013

Pascal database with output for printer

const maxsize = 99;
type
address = record
name : string[40];
street : string[40];
town : string[40];
county : string[40];
postcode : string[40];
telephone : string[40];
email : string[40];
end;
type personinfo = array[1..maxsize] of address;
var
details : personinfo;
diskfile : file of address;
txtfile : file of string;
output : text;
counter : integer;
choice : integer;
 
procedure save;
var
loop : integer;
begin
assign(diskfile,'address.data');
rewrite(diskfile);
for loop := 1 to counter do
write(diskfile,details[loop]);
close(diskfile);
end;
procedure printrecords;
var
loop : integer;
begin
assign(output,'printout.prn');
rewrite(output);
for loop := 1 to counter do
with details[loop] do
begin
writeln(output,details[loop].name);
writeln(output,details[loop].street);
writeln(output,details[loop].town);
writeln(output,details[loop].county);
writeln(output,details[loop].postcode);
writeln(output,details[loop].telephone);
writeln(output,details[loop].email);
writeln(output);
writeln(output);
end;
close(output);
end;
 
 
procedure load;
begin
assign(diskfile,'address.data');
reset(diskfile);
while not eof(diskfile) do
begin
counter := counter + 1;
read(diskfile, details[counter]);
end;
close(diskfile);
end;
procedure newaddress;
begin
counter :=counter + 1;
with details[counter] do
begin
write('Enter name: ');
readln(name);
write('Enter street: ');
readln(street);
write('Enter town / city: ');
readln(town);
write('Enter county: ');
readln(county);
write('Enter postcode: ');
readln(postcode);
write('Enter telephone number: ');
readln(telephone);
write('Enter email address: ');
readln(email);
end;
end;
 
 
procedure display;
var
loop : integer;
begin
for loop := 1 to counter do
begin
with details[loop] do
begin
writeln('RECORD NO. ',loop);
writeln(name);
writeln(street);
writeln(town);
writeln(county);
writeln(postcode);
writeln(telephone);
writeln(email);
writeln('');
end;
end;
end;
procedure search;
var
loop : integer;
target : string[40];
begin
writeln('Enter name to search for: ');
readln(target);
for loop := 1 to counter do
if details[loop].name = target then
with details[loop] do
begin
writeln('RECORD NO. ',loop);
writeln(name);
writeln(street);
writeln(town);
writeln(county);
writeln(postcode);
writeln(telephone);
writeln(email);
writeln('');
end;
end;
procedure delete;
var
target : integer;
loop : integer;
begin
write('Record number? ');
readln(target);
if(target>0) and (target<counter)
then begin
for loop := target to counter - 1 do
details[loop] := details[loop+1];
counter := counter -1;
end;
end;
procedure sort;
var
noswaps : boolean;
current : address;
x : integer;
begin
repeat
noswaps := true;
for x := 1 to counter -1 do
begin
if details[x].name > details[x + 1].name then
begin
current := details[x];
details[x] := details[x+1];
details[x+1] := current;
noswaps := false;
end;
end;
until noswaps;
end;
 
begin
counter:= 0;
{load;}
writeln('Address details');
repeat
{while choice <> '6' do
begin}
writeln('Load file 1');
writeln('New address 2');
writeln('Display addresses 3');
writeln('Select by name 4');
writeln('Delete record 5');
writeln('Sort records 6');
writeln('Save 7');
writeln('Save records to file for printing 8');
writeln('Exit 9');
writeln('Choose ...');
readln(choice);
{case choice of
'1' : load;
'2' : newcd;
'3' : display;
'4' : search;
'5' : delete;
'6' : sort;
'7' : save;
end;}
if choice = 1 then load;
if choice = 2 then newaddress;
if choice = 3 then display;
if choice = 4 then search;
if choice = 5 then delete;
if choice = 6 then sort;
if choice = 7 then save;
if choice = 8 then printrecords;
until choice = 9;
{end;}
end.
 

No comments:

Post a Comment