با سلام
من این کد رو توی اینترنت پیدا کردم
ولی موقع اجرا و کامپایل کردن ایراد می گیره می خواستم اگه ممکنه کمکم کنید
یک برنامه برای مدیریت دانشجویان است
Student Database Information System
{
Description: <b style="color:black;background-color:#ffff66">Student</b> <b style="color:black;background-color:#a0ffff">Database</b>. Create a new text file and then run the program. It will ask for the path of the text file and the use the program. the password is 'vyomw'.
}
{+r$}
program databse;
uses graph , crt;
const
directory = 'f:<b style="color:black;background-color:#ff66ff">pascal</b> gi' ;
type
stdname = string[40];
searcharray = array[1..1000] of integer;
<b style="color:black;background-color:#ffff66">student</b> = record
name : stdname;
stdnum : real;
semester : real;
gpa : real;
end;
stdarray = array[1..1000] of <b style="color:black;background-color:#ffff66">student</b>;
var
unchangeable : integer;
class : stdarray;
choice : char;
i , driver , mode : integer;
path3 : string ;
indata1 , backup : text ;
search1 : searcharray;
label 1 , 2 , 3 ;
procedure decryptor(var decstring : stdname);
var
loop : integer;
begin
for loop := 1 to length(decstring) do
decstring[loop] := chr(ord(decstring[loop]) - 121);
end;
procedure intdecrypt(var num : real);
begin
num := num - 27;
num := num / 2;
end;
procedure gpadecrypt(var num : real);
begin
num := num + 0.26;
num := num * 3.29;
num := num / 2.69;
end;
procedure encryptor(var encstring : stdname);
var
loop : integer;
begin
for loop := 1 to length(encstring) do
encstring[loop] := chr(ord(encstring[loop]) + 121);
end;
procedure gpaencrypt(var num : real);
begin
num := num * 2.69;
num := num / 3.29;
num := num - 0.26;
end;
procedure intencrypt(var num : real);
begin
num := num * 2;
num := num + 27;
end;
procedure emptier;
var
i : integer;
begin
for i := 1 to 1000 do
begin
class[i].stdnum := 0;
class[i].semester := 0;
class[i].gpa := 0;
class[i].name := '';
search1[i] := 0;
end;
end;
procedure searcher;
var
b , x , m : integer;
choice , seperator : char;
search : real;
label 1 , 2 , 3 , 4;
begin
2: write('Please enter the <b style="color:black;background-color:#ffff66">student</b> number to search ');
readln(search);
intencrypt(search);
reset(indata1);
x := 1;
while not eof(indata1) do
begin;
readln(indata1, search1[x]);
if (search = search1[x]) then
goto 1;
x := x + 1 ;
if eof(indata1) then
begin
writeln('<b style="color:black;background-color:#ffff66">Student</b> number not found ');
4: write('Do you want to search for more ');
readln(choice);
if (choice = 'y') or (choice = 'Y') then
begin
for b := 1 to 50 do
begin
writeln('')
end;
goto 2
end
else
goto 3;
end;
end;
1 : for m := 1 to 50 do
writeln('');
writeln('Search result found ') ;
writeln('') ;
reset(indata1);
writeln('');
for m := 1 to x do
begin
read(indata1 , class[m].stdnum);
read(indata1 , class[m].semester);
read(indata1 , class[m].gpa);
read(indata1 , seperator);
readln(indata1 , class[m].name);
end;
intdecrypt(class[x].stdnum);
writeln('<b style="color:black;background-color:#ffff66">Student</b> Number ' , class[x].stdnum:4:0);
decryptor(class[x].name);
writeln('Name ' , class[x].name);
intdecrypt(class[x].semester);
writeln('Semester ' , class[x].semester:1:0);
gpadecrypt(class[x].gpa);
writeln('GPA ' , class[x].gpa:1:2);
writeln('');
writeln('');
goto 4;
3: end;
procedure save;
begin
append(indata1);
intencrypt(class[i].stdnum);
write(indata1 , class[i].stdnum:1:0 , ' ' );
intencrypt(class[i].semester);
write(indata1 , class[i].semester:1:0 , ' ' );
gpaencrypt(class[i].gpa);
write(indata1 , class[i].gpa:1:2 , ' ');
encryptor(class[i].name);
writeln(indata1 , class[i].name);
close(indata1);
end;
procedure newrecord;
var
t , h : integer;
n : real;
choice1 , choices : char;
label 1 , 2 , 3 , 4, 5 , 6 ;
begin
1: for t := 1 to 50 do
writeln('');
writeln('please enter as directed') ;
write('<b style="color:black;background-color:#ffff66">Student</b> # ');
readln(class[i].stdnum);
write('<b style="color:black;background-color:#ffff66">Student</b> Name ');
readln(class[i].name);
write('Semester ');
readln(class[i].semester);
write('GPA ');
readln(class[i].gpa);
5: reset(indata1);
if not eof(indata1) then
begin
repeat
readln(indata1 , n); ;
intdecrypt(n);
if n = class[i].stdnum then
begin
writeln('Duplicate <b style="color:black;background-color:#ffff66">Student</b> Number not allowed ');
write('Please enter another <b style="color:black;background-color:#ffff66">student</b> no ');
readln(class[i].stdnum);
goto 5;
end;
until eof(indata1) ;
end;
if eof(indata1) then
goto 3;
3: if (class[i].semester > 8) or (class[i].semester < 1) then
begin
for h := 1 to 50 do
writeln('');
write('Error in data.... Please Renter the Semester Value ') ;
readln(class[i].semester) ;
goto 3;
end;
4: if (class[i].gpa > 4.0) or (class[i].gpa < 1.0) then
begin
write('Error in data.... Please Renter the GPA ');
readln(class[i].gpa);
goto 4;
end;
save;
i := i + 1;
writeln('');
2: write('Do you want to enter more data ');
read(choice1);
writeln('');
if (choice1 = 'y') or (choice1 = 'Y') then
goto 1 ;
write('Are You Sure.... ');
readln(choices);
if (choices = 'N') or (choices = 'n') then
goto 2
else
end;
procedure delrec;
label 1, 2 ;
var
h1 , h2 , h3 , f1 , d : integer;
delstd : real;
begin
d := i;
i := 1;
emptier;
reset(indata1);
write('Please enter the <b style="color:black;background-color:#ffff66">student</b> number you want to delete ');
readln(delstd);
for i := 1 to 1000 do
begin
read(indata1 , class[i].stdnum);
intdecrypt(class[i].stdnum);
read(indata1 , class[i].semester);
intdecrypt(class[i].semester);
read(indata1 , class[i].gpa);
gpadecrypt(class[i].gpa);
readln(indata1 , class[i].name);
decryptor(class[i].name);
if eof(indata1) then
begin
h2 := i;
goto 1 ;
end;
end;
1: close(indata1);
for h1 := 1 to h2 do
if (class[h1].stdnum = delstd) then
begin
h3 := h1 - 1;
writeln(h3);
rewrite(indata1);
for f1 := 1 to h3 do
begin
intencrypt(class[f1].stdnum);
write(indata1 , class[f1].stdnum:4:0 ,' ' );
intencrypt(class[f1].semester);
write(indata1 , class[f1].semester:1:0 , ' ');
gpaencrypt(class[f1].gpa);
write(indata1 , class[f1].gpa:1:2);
encryptor(class[f1].name);
writeln(indata1 , class[f1].name);
end;
h3 := h1 + 1;
for f1 := h3 to h2 do
begin
intencrypt(class[f1].stdnum);
write(indata1 , class[f1].stdnum:4:0 , ' ');
intencrypt(class[f1].semester);
write(indata1 , class[f1].semester:1:0 , ' ');
gpaencrypt(class[f1].gpa);
write(indata1 , class[f1].gpa:1:2);
encryptor(class[f1].name);
writeln(indata1 , class[f1].name);
end;
goto 2;
end;
2: i := d;
emptier;
end;
procedure password;
var
c : string;
e : integer;
label 1 ;
begin
e := 0;
clrscr;
1: write('Please enter your password ');
repeat
e := e + 1;
c[e] := readkey;
if ord(c[e]) = 13 then
else
write('*');
until (ord(c[e]) = 13);
writeln('');
if (c[1] = 'v') and (c[2] = 'y') and (c[3] = 'o') and (c[4] = 'm') and (c[5] = 'w') and (c[6] = chr(13)) then
begin
write('Password Accepted..... Please press any key to continue.');
readkey;
end
else
begin
writeln('Wrong Password');
e := 0;
writeln('');
Write('Do you want to continue...[Y/N] ');
readln(choice);
clrscr;
if (choice = 'y') or (choice = 'Y') then
goto 1
else
choice := 'n';
end;
end;
procedure listrecord;
var
name1 : stdname;
j , h : integer;
seperator , seperator2 ,seperator3 , keys1 : char;
gpa1 , stdnum1 , semester1 : real;
label 1 , 2 ;
begin
for j := 1 to 50 do
writeln('');
writeln('This is the list of all records present in the <b style="color:black;background-color:#a0ffff">Database</b>');
reset(indata1);
while not eof(indata1) do
begin
readln(indata1 , stdnum1 ,seperator ,semester1 ,seperator2, gpa1 ,seperator3, name1);
decryptor(name1);
intdecrypt(stdnum1);
intdecrypt(semester1);
gpadecrypt(gpa1);
writeln('<b style="color:black;background-color:#ffff66">Student</b> # ' , stdnum1:1:0);
writeln('<b style="color:black;background-color:#ffff66">Student</b> Name ' , name1);
writeln('Semester ' , semester1:1:0);
writeln('GPA ' , gpa1:1:2);
writeln('');
writeln('Press any key to continue... or type <x> or <X> to exit');
keys1 := readkey;
if (keys1 = 'x') or (keys1 ='X') then
goto 1;
for h := 1 to 50 do
writeln('');
end;
1: writeln('ending');
end;
procedure editrecord;
var
delstd , n : real;
seperator : char;
h1 , h2 , h3 , f1 , d , h4 , h : integer;
label 1, 2 , 3 , 4 ,5 ;
begin
d := i;
i := 1;
emptier;
reset(indata1);
write('Please enter the <b style="color:black;background-color:#ffff66">student</b> number you want to Edit ');
readln(delstd);
for i := 1 to 1000 do
begin
read(indata1,class[i].stdnum);
intdecrypt(class[i].stdnum);
read(indata1,class[i].semester);
intdecrypt(class[i].semester);
read(indata1,class[i].gpa);
gpadecrypt(class[i].gpa);
read(indata1,seperator);
readln(indata1,class[i].name);
decryptor(class[i].name);
if eof(indata1) then
begin
h2 := i;
goto 1 ;
end;
end;
1: close(indata1);
for h1 := 1 to h2 do
if (class[h1].stdnum = delstd) then
begin
h4 := h1;
h3 := h1 - 1;
writeln(h3);
rewrite(indata1);
for f1 := 1 to h3 do
begin
intencrypt(class[f1].stdnum);
write(indata1 , class[f1].stdnum:4:0 ,' ' );
intencrypt(class[f1].semester);
write(indata1 , class[f1].semester:1:0 , ' ');
gpaencrypt(class[f1].gpa);
write(indata1 , class[f1].gpa:1:2 , ' ');
encryptor(class[f1].name);
writeln(indata1 , class[f1].name);
end;
h3 := h1 + 1;
for f1 := h3 to h2 do
begin
append(indata1);
intencrypt(class[f1].stdnum);
intencrypt(class[f1].semester);
gpaencrypt(class[f1].gpa);
encryptor(class[f1].name);
write(indata1,class[f1].stdnum:4:0 , ' ');
write(indata1,class[f1].semester:1:0 , ' ');
write(indata1,class[f1].gpa:1:2 , ' ');
writeln(indata1,class[f1].name);
end;
close(indata1);
end;
clrscr;
writeln('<b style="color:black;background-color:#ffff66">Student</b> # ' ,class[h4].stdnum:1:0);
writeln('<b style="color:black;background-color:#ffff66">Student</b> Name ' ,class[h4].name);
writeln('Semester ' ,class[h4].semester:1:0);
writeln('GPA ' ,class[h4].gpa:1:2);
writeln('');
i := 1;
writeln('Please renter the values to change the record ');
write('<b style="color:black;background-color:#ffff66">Student</b> # ');
readln(class[i].stdnum);
write('<b style="color:black;background-color:#ffff66">Student</b> Name ');
readln(class[i].name);
write('Semester ');
readln(class[i].semester);
write('GPA ');
readln(class[i].gpa);
5: reset(indata1);
if not eof(indata1) then
begin
repeat
readln(indata1 , n); ;
if n = class[i].stdnum then
begin
writeln('Duplicate <b style="color:black;background-color:#ffff66">Student</b> Number not allowed ');
write('Please enter another <b style="color:black;background-color:#ffff66">student</b> no ');
readln(class[i].stdnum);
goto 5;
end;
until eof(indata1) ;
end;
if eof(indata1) then
goto 3;
3: if (class[i].semester > 8) or (class[i].semester < 1) then
begin
for h := 1 to 50 do
writeln('');
write('Error in data.... Please Renter the Semester Value ') ;
readln(class[i].semester) ;
goto 3;
end;
4: if (class[i].gpa > 4.0) or (class[i].gpa < 1.0) then
begin
write('Error in data.... Please Renter the GPA ');
readln(class[i].gpa);
goto 4;
end;
save;
goto 2;
2: i := d;
emptier;
end;
procedure deleterecord;
var
t : integer;
choice : char;
begin
for t := 1 to 50 do
writeln('');
writeln( ' WARNING ---- This will delete all the records in the current <b style="color:black;background-color:#a0ffff">database</b>');
write('Do yo want to continue ');
readln(choice);
if (choice = 'y') or (choice = 'Y') then
begin
rewrite(indata1) ;
close(indata1) ;
writeln('<b style="color:black;background-color:#a0ffff">Database</b> has been deleted ');
end;
end;
procedure databaser;
var
name1 : stdname;
begin
clrscr;
write('Please enter the path of your databse text file ' );
readln(path3);
assign(indata1 , path3);
end;
procedure backup1;
var
name1 : stdname;
begin
clrscr;
writeln('This will backup your data ');
writeln('Please enter the path of the databse text file to backup data ');
write('>>> ');
readln(name1);
assign(backup , name1);
name1 := '';
rewrite(backup);
reset(indata1);
while not eof(indata1) do
begin
readln(indata1 , name1);
writeln(backup , name1);
end;
writeln('');
writeln('');
writeln('Backup task completed ');
close(indata1);
close(backup);
writeln('press any key to continue ');
readkey;
end;
procedure starter;
var
data : char;
begin
initgraph(driver , mode , directory);
rectangle(10,10 , getmaxx - 10 , 165);
outtextxy(140,15 , 'F A S T - N U S T U D E N T D A T A B A S E ');
outtextxy(135 ,45 ,'PLEASE SELECT YOUR OPTION BY THE BRACKETED LETTER');
outtextxy(12, 75 , '[N]ew Record [E]dit Record [L]ist Record [D]elete Record [S]earch Record' ) ;
outtextxy(12 ,110 ,' [C]lear Databse c[H]ange Databse [B]ackup Databse e[X]it' ) ;
outtextxy(17 , 135 , 'Programming by :- Faraz Younus Bandukda - Farazoftine Software Products ');
data := readkey;
if (data = 'n') or (data = 'N') then
begin
clrscr;
closegraph;
newrecord ;
end;
if (data = 'h') or (data = 'H') then
begin
clrscr;
closegraph;
databaser;
end;
if (data = 'e') or (data = 'E') then
begin
clrscr;
closegraph;
editrecord ;
end;
if (data = 'l') or (data = 'L') then
begin
clrscr;
closegraph;
listrecord ;
end;
if (data = 'c') or (data = 'C') then
begin
clrscr;
closegraph;
deleterecord ;
end;
if (data = 's') or (data = 'S') then
begin
clrscr;
closegraph;
searcher;
end;
if (data = 'x') or (data = 'X') then
begin
unchangeable := 0;
end;
if (data = 'd') or (data = 'D') then
begin
clrscr;
closegraph;
delrec;
end;
if (data = 'b') or (data = 'B') then
begin
clrscr;
closegraph;
backup1;
end;
end;
begin
password;
if (choice = 'n') then
goto 3;
databaser;
emptier;
i := 1;
unchangeable := 1;
while unchangeable >= 1 do
begin
starter;
end;
3 : writeln('');
end.
