RE: برنامه كتبخانه تحت++C
سلام
من اين برنامه رو با پاسكال نوشتم
خودت تبديلش كن به ++C
program lib;
uses wincrt;
const
length = 20;{len of array}
type
book = record
ISBN : longint;
Bookname : string;
nevisande : string;
motarjem : string;
nasher : string;
end;{end of book record}
recfile = file of book;
flong = file of byte;
var
SecurityNumber1 : byte;
SecurityNumber2 : byte;
adminCommand,flag,P,p2,SC : byte;
index,SecurityNumber,i,isbn1 : longint;
dastour : char;
command,str0,str1,str2,strP,tstre : string;
bookrec : book;
fp : recfile;
f : flong;
{************************************************************}
function search(name : string) : longint;
var
i1 : longint;
brec : book;
begin
assign(fp, 'c:\rec.dat');
reset(fp);
i1 := 0;
search := -1;
while not eof(fp) do
begin
read(fp, brec);
if name = brec.Bookname then
begin
search := i1;
exit;
end;
i1 := i1 + 1;
end; {while}
close(fp);
end; {search}
function searchAuthor(author : string) : longint;
var
i1 : longint;
brec : book;
begin
assign(fp, 'c:\rec.dat');
reset(fp);
i1 := 0;
searchAuthor := -1;
while not eof(fp) do
begin
read(fp, brec);
if author = brec.nevisande then
begin
searchAuthor := i1;
exit;
end;
i1 := i1 + 1;
end; {while}
close(fp);
end;
function searchISBN(isbn : longint) : longint;
var
i1 : longint;
brec : book;
begin
assign(fp, 'c:\rec.dat');
reset(fp);
i1 := 0;
searchISBN := -1;
while not eof(fp) do
begin
read(fp, brec);
if isbn = brec.ISBN then
begin
searchISBN := i1;
exit;
end;
i1 := i1 + 1;
end; {while}
close(fp);
end;
{**************************************************************}
procedure Enter(brec : book; choice : byte);
begin
assign(fp, 'c:\rec.dat');
if choice = 0 then
rewrite(fp)
else
begin
reset(fp);
seek(fp, filesize(fp));
end;
write(fp, brec);
close(fp)
end; {enter}
procedure print(str : string);
begin
writeln;
writeln(' ',str);
writeln;
writeln;
end;
procedure show(i2 : longint);
var
brec : book;
begin
assign(fp, 'c:\rec.dat');
reset(fp);
seek(fp, i2);
read(fp, brec);
writeln(' book name is: ', brec.Bookname);
writeln(' ISBN is: ', brec.ISBN);
writeln(' author is: ', brec.nevisande);
writeln(' pulisher is: ', brec.nasher);
writeln(' translator is: ', brec.motarjem);
close(fp);
end;
procedure edit(i3 : longint);
var
SC : byte;
brec : book;
ds : char;
begin
assign(fp, 'c:\rec.dat');
reset(fp);
seek(fp, i3);
read(fp, brec);
while SC <> 5 do
begin
writeln('Edit menu: ');
writeln(' 0. Change name.');
writeln(' 1. Change ISBN.');
writeln(' 2. Change author.');
writeln(' 3. Change publisher.');
writeln(' 4. Change translator.');
writeln(' 5. Save and back to main menu.');
write('Enter your select(0-5): ');
readln(SC);
if SC = 0 then
begin
clrscr;;
writeln('Old book name is: ',brec.Bookname);
write('Enter new book name: ');
readln(brec.Bookname);
writeln;
writeln('<< Book information changed >>');
write('Press Enter to continue...');
readln;
end
else if SC = 1 then
begin
clrscr;;
writeln('Old ISBN name is: ',brec.ISBN);
write('Enter new ISBN: ');
readln(brec.ISBN);
writeln;
writeln('<< Book information changed >>');
write('Press Enter to continue...');
readln;
end
else if SC = 2 then
begin
clrscr;;
writeln('Old author is: ',brec.nevisande);
write('Enter new author: ');
readln(brec.nevisande);
writeln;
writeln('<< Book information changed >>');
write('Press Enter to continue...');
readln;
end
else if SC = 3 then
begin
clrscr;;
writeln('Old publisher is: ',brec.nasher);
write('Enter new publisher: ');
readln(brec.nasher);
writeln;
writeln('<< Book information changed >>');
write('Press Enter to continue...');
readln;
end
else if SC = 4 then
begin
clrscr;;
writeln('Old translator is: ',brec.motarjem);
write('Enter new translator: ');
readln(brec.motarjem);
writeln;
writeln('<< Book information changed >>');
write('Press Enter to continue...');
readln;
end
else
begin
end;
clrscr;
end;
write('Some information may be changed! save them (y/n)? ');
readln(ds);
if (ds = 'y') or (ds = 'Y') then
begin
seek(fp, i3);
write(fp, brec);
close(fp);
writeln('<< Changes saved >>');
write('Press Enter to continue...');
readln;
end
else
begin
writeln('<< Changes not saved >>');
write('Press Enter to continue...');
readln;
end;
end;
procedure delete(i4 : longint);
var
i,j : longint;
brec : book;
fbrec : book;
f : recfile;
begin
assign(fp, 'c:\rec.dat');
assign(f, 'c:\temp.dat');
reset(fp);
rewrite(f);
seek(fp,i4);
read(fp,brec);
close(fp);
reset(fp);
while not eof(fp) do
begin
read(fp,fbrec);
if fbrec.ISBN <> brec.ISBN then
begin
write(f,fbrec);
end;
end;
close(f);
close(fp);
erase(fp);
rename(f, 'c:\rec.dat');
end;
procedure Result(i : longint; str : string);
begin
if i <> -1 then
begin
clrscr;
writeln('Result is: ');
show(i);
writeln;
write('Press Enter to continue...');
readln;
end
else
begin
clrscr;
writeln('<< ', str, ' not found >>');
write('Press Enter to continue...');
readln;
end;
end;
procedure DeleteResult(i : longint);
begin
if i <> -1 then
begin
writeln;
show(i);
write('Do you want to delete this record(y/n)? ');
readln(dastour);
if (dastour = 'y') or (dastour = 'Y') then
begin
delete(i);
clrscr;
writeln('<< Book deleted >>');
write('Press Enter to continue...');
readln;
end
else
begin
end;
end
else
begin
writeln('<< Book not found >>');
write('Press Enter to continue...');
readln;
end;
end;
procedure EditResult(i : longint; str : string);
begin
if i <> -1 then
begin
writeln;
show(i);
writeln;
edit(i);
end
else
begin
clrscr;
writeln('<< ',str,' not found >>');
write('Press Enter to continue...');
readln;
end;
end;
procedure check(i : longint);
var
flag : longint;
brec : book;
begin
flag := searchISBN(i);
while flag <> -1 do
begin
clrscr;
writeln('<< ',bookrec.ISBN,' is avilable >>');
write('Enter another ISBN: ');
readln(bookrec.ISBN);
writeln;
flag := searchISBN(bookrec.ISBN);
end;
end;
procedure menu;
begin
writeln(' 0. Delete old data and create new file.');
writeln(' 1. Add the book information.');
writeln(' 2. Edit the book information.');
writeln(' 3. Delete the book information.');
writeln(' 4. Search a book.');
writeln(' 5. Append data');
writeln(' 6. Exit');
writeln;
write('Enter your select (0-7) : ');
readln(adminCommand);
end; {menu}
procedure userMenu;
begin
writeln(' 0. Delete old data and create new file. inactive');
writeln(' 1. Add the book information. inactive');
writeln(' 2. Edit the book information. inactive');
writeln(' 3. Delete the book information. inactive');
writeln(' 4. Search a book.');
writeln(' 5. Change the pasword. inactive');
writeln(' 6. Exit');
writeln;
write('Enter your select (0-7) : ');
readln(adminCommand);
end; {userMenu}
procedure SearchMenu;
begin
writeln(' 0. Search book name.');
writeln(' 1. Search ISBN.');
writeln(' 2. Search author.');
writeln(' 3. Back to administrator menu.');
writeln;
write('Enter your select (0-3) : ');
end;
begin{main block}
index := 1;
flag := 0;
SecurityNumber1 := 1;
SecurityNumber2 := 2;
adminCommand := 10;
write('Enter pasword: ');
readln(SecurityNumber);
if (SecurityNumber = SecurityNumber1) or (SecurityNumber = SecurityNumber2) then {get pasword}
begin
if (SecurityNumber = SecurityNumber1) then
str0 := 'Main administrator menu: '
else
str0 := 'Main user menu: ';
while adminCommand <> 6 do
begin
clrscr;
writeln(str0);
if (SecurityNumber = SecurityNumber1) then
menu
else
userMenu;
if adminCommand = 1 then {add new book}
begin
if (SecurityNumber = SecurityNumber2) then
else
begin
SC := 10;
while SC <> 1 do
begin
clrscr;
writeln('Add new book menu: ');
writeln(' 0. Add book information.');
writeln(' 1. Back to main menu.');
writeln;
write('Enter your select(0-1): ');
readln(SC);
if SC = 0 then
begin
clrscr;
write('Enter book''s name: ');
readln(bookrec.Bookname);
write('Enter ISBN: ');
readln(bookrec.ISBN);
check(bookrec.ISBN);
write('Enter author: ');
readln(bookrec.nevisande);
write('Enter publisher: ');
readln(bookrec.nasher);
write('Enter transletor: ');
readln(bookrec.motarjem);
Enter(bookrec, 1);
end;
end;
end
end
else if adminCommand = 2 then {edit book}
begin
if (SecurityNumber = SecurityNumber2) then
else
begin
clrscr;
SC := 10;
writeln('Edit menu: ');
SearchMenu;
readln(SC);
if SC = 0 then
begin
clrscr;
write('Enter book name: ');
readln(str2);
i := search(str2);
EditResult(i, 'Book');
end
else if SC = 1 then
begin
clrscr;
write('please enter ISBN: ');
readln(isbn1);
i := searchISBN(isbn1);
EditResult(i, 'ISBN');
end
else if SC = 2 then
begin
clrscr;
write('please enter author: ');
readln(str2);
i := searchAuthor(str2);
EditResult(i, 'Author');
end
else
begin
end;
end
end
else if adminCommand = 3 then {delete book}
begin
if (SecurityNumber = SecurityNumber2) then
else
begin
clrscr;
SC := 10;
writeln('Delete menu: ');
SearchMenu;
readln(SC);
if SC = 0 then
begin
clrscr;
write('Enter book name to delete: ');
readln(str2);
i := search(str2);
DeleteResult(i);
end
else if SC = 1 then
begin
clrscr;
write('Enter ISBN to delete: ');
readln(isbn1);
i := searchISBN(isbn1);
DeleteResult(i);
end
else if SC = 2 then
begin
clrscr;
write('please enter author: ');
readln(str2);
i := searchAuthor(str2);
DeleteResult(i);
end
else
begin
end;
end
end
else if adminCommand = 4 then {search book}
begin
clrscr;
SC := 10;
writeln('Search menu: ');
SearchMenu;
readln(SC);
if SC = 0 then
begin
clrscr;
write('Enter book name: ');
readln(str2);
i := search(str2);
Result(i, 'Book');
end
else if SC = 1 then
begin
clrscr;
write('Enter ISBN: ');
readln(isbn1);
i := searchISBN(isbn1);
Result(i, 'ISBN');
end
else if SC = 2 then
begin
clrscr;
write('Enter author: ');
readln(str2);
i := searchAuthor(str2);
Result(i, 'Author');
end
else {back to administrator menu}
begin
end;
end
else if adminCommand = 0 then {rewrite data}
begin
if (SecurityNumber = SecurityNumber2) then
begin
end
else
begin
Enter(bookrec, 0);
clrscr;
writeln('<< Data seved >>');
write('Press Enter to continue...');
readln;
end;
end
else if adminCommand = 5 then {Append data}
begin
Enter(bookrec, 0);
clrscr;
writeln('<< Data Append >>');
write('Press Enter to continue...');
readln;
end;
clrscr;
end {end of while}
end
else
writeln('pasword is wrong!!! ');
write('Do you want to exit(y/n)? ');
readln(dastour);
if (dastour = 'y') or (dastour = 'Y') then
exit
else
begin
end;
end.{end of program lib}
و پاسی از شب را از خواب برخیز، قرآن و نماز بخوان! این یک وظیفه اضافی برای توست، امید آنکه پروردگارت تو را به مقامی در خور ستایش برانگیزد(سوره اسراء آیه79)
|
صفحه اصلی
انجمن
جستجو
فهرست اعضا
افزونه های فایرفاکس
» 
تشکر شده توسط :
