برنامه دفترچه تلفن (پاسکال)
uses wincrt;
type
Contact = record
firstname,lastname : string[25];
telephone : string[20];
mobile : string[20];
fax : string[20];
Email : string[20];
address : string[20];
end;
var
CF : File of Contact;
C : Contact;
temp1CF,temp2CF : file of contact;
sc : byte;
procedure start;
begin
Writeln('DAFTARCE TELEPHONE ');
writeln;
writeln('Service Ha :');
writeln;
writeln('* Afzudane Mokhatab : 01');
writeln('* Hazf Mokhatab : 02');
writeln('* Yaftane Mokhatab : 03');
writeln('* Namayesh Mokhataban : 04');
writeln('* Rahandazi Mojadad : 05');
writeln;
writeln('Shomare service ra vared konid :');
readln(sc);
clrscr;
end;
procedure load;
var
i: longint;
pre,k : integer;
begin
gotoxy(4,12);
write('Loading . . . ');
gotoxy(20,12);
pre:=0;
k:=20;
for i:= 1 to 12500 do
begin
if i mod 250 = 0 then
begin
gotoxy(k,11);
write('*');
gotoxy(k,12);
write('*');
gotoxy(k,13);
write('*');
pre := pre+2;
k:=k+1;
end;
gotoxy(45,14);
write(pre);
end;
Assign(CF,'C:\Telephone\CF.dbf');
Assign(temp1CF,'C:\Telephone\temp1CF.dbf');
Assign(temp2CF,'C:\Telephone\temp2CF.dbf');
rewrite(temp1CF);
reset(CF);
while not eof(CF) do
begin
read(CF,C);
write(temp1CF,C);
end;
close(CF);
close(temp1CF);
clrscr;
Start;
end;
procedure add;
var
n,i : integer;
begin
writeln('Tedade Mokataban Ra vared konid :');
readln(n);
rewrite(temp2CF);
for i:=1 to n do
begin
writeln('Nam :');
readln(C.firstname);
writeln('NameKhanevadegi :');
readln(C.lastname);
writeln('Telephone :');
readln(C.telephone);
writeln('Mobile :');
readln(C.mobile);
writeln('E-mail :');
readln(C.email);
writeln('Address :');
readln(C.address);
write(temp2CF,C);
writeln;
writeln('Press any key to continue :');
readln;
clrscr;
end;
close(temp2CF);
rewrite(CF);
reset(temp1CF);
while not eof(temp1CF) do
begin
read(temp1CF,C);
seek(CF,filesize(CF));
write(CF,C);
end;
close(temp1CF);
reset(temp2CF);
while not eof(temp2CF) do
begin
read(temp2CF,C);
seek(CF,filesize(CF));
write(CF,C);
end;
close(temp2CF);
close(CF);
load;
end;
procedure delete;
var
mlnoc : string;
Cindex : integer;
flag : boolean;
begin
writeln;
writeln('Name Khanevadegi Mokhatab Ra vared Koned :');
readln(mlnoc);
reset(CF);
flag :=true;
Cindex:=-1;
while not eof(CF) and flag do
begin
read(CF,C);
Cindex:=Cindex+1;
if C.lastname = mlnoc then
begin
writeln;
writeln('Member Info :');
flag :=false;
write(' * First Name : ');
writeln(C.firstname);
write(' * Last Name : ');
writeln(C.lastname);
write(' * Telephone : ');
writeln(C.telephone);
write(' * Mobile : ');
writeln(C.mobile);
write(' * E-mail : ');
writeln(C.email);
write(' * Address : ');
writeln(C.address);
end;
end;
close(CF);
if flag = true then
begin
writeln('Mokhatab Yaft Nashod');
writeln;
writeln('For Continue Pree Any Key :');
readln;
clrscr;
start;
end;
rewrite(CF);
reset(temp1CF);
while not eof (temp1CF) do
begin
if filepos(temp1CF)=Cindex then
begin
seek(temp1CF,filepos(temp1CF)+1);
end;
read(temp1CF,C);
write(CF,C);
end;
close(CF);
close(temp1CF);
writeln('For Continue Pree Any Key :');
readln;
clrscr;
load;
end;
procedure search;
var
mln : string[25];
flag : boolean;
begin
writeln('SEARCH MEMBER BY LAST NAME ');
writeln;
writeln('Name Khanevadegi Mokhatab Ra vared Koned :');
readln(mln);
reset(CF);
flag :=false;
while not eof(CF) do
begin
read(CF,C);
if C.lastname = mln then
begin
writeln;
writeln('Member Info :');
flag :=true;
write(' * First Name : ');
writeln(C.firstname);
write(' * Last Name : ');
writeln(C.lastname);
write(' * Telephone : ');
writeln(C.telephone);
write(' * Mobile : ');
writeln(C.mobile);
write(' * E-mail : ');
writeln(C.email);
write(' * Address : ');
writeln(C.address);
end;
end;
close(CF);
if flag = false then
writeln('Mokhatab Yaft Nashod');
writeln;
writeln('Pres any key to conyinue :');
readln;
clrscr;
start;
end;
procedure show;
var
index:integer;
begin
index:=5;
reset(CF);
writeln(' * MOSHAKHASAT MOKHATABAN *');
writeln(' *****************************************************************************');
writeln(' * Nam * Telephon * Mobile *');
writeln(' *****************************************************************************');
while not eof(CF) do
begin
read(CF,C);
gotoxy(1,index);
write(' * ',C.firstname,' ',C.lastname);
gotoxy(32,index);
write('* ',C.telephone);
gotoxy(52,index);
write('* ',C.mobile);
gotoxy(79,index);
writeln('*');
inc(index);
end;
gotoxy(1,index);
writeln(' *****************************************************************************');
close(CF);
writeln;
writeln('For Continue Press Enter');
readln;
clrscr;
start;
end;{End of procedure show all Member}
procedure restart;
begin
rewrite(temp1CF);
close(temp1CF);
rewrite(temp2CF);
close(temp2CF);
rewrite(CF);
close(CF);
writeln;
writeln('SYSTEM RESTARTED !');
writeln;
writeln('Press any key to continue :');
readln;
clrscr;
start;
end;
begin
load;
while true do
begin
case sc of
1 : Add;
2 : delete;
3 : search;
4 : Show;
5 : restart;
end;
end;
end.