Student Database Information System. - Pascal Projects Source Code in Pascal

Special : Web Developer's Collection CD-ROM
50,000+ Web Templates, Logos, Cliparts, Scripts. Order Now!

Add to Favorites Make Home Page

2464 Online

Language Categories

Source Codes Home
Project Ideas New!
Interview Questions
FAQs Home
ASP Home: ASP Source Codes; ASP Script Directory New!; ASP .Net Script Directory New!; ASP Interview Questions; ASP FAQs; ASP How Tos
C Home: C Source Codes; C Script Directory New!; C Interview Questions; C FAQs; C How Tos
C++ Home: C++ Source Codes; C++ Script Directory New!; C++ Interview Questions; C++ FAQs; C++ How Tos
Java Home: Java Source Codes; Java Directory New!; Java Interview Questions; Java FAQs; Java How Tos
JavaScript Home: JavaScript Directory New!; JavaScript Source Codes; JavaScript FAQs; JavaScript How Tos
COBOL Home: COBOL Source Codes; COBOL FAQs; COBOL How Tos
Pascal Home: Pascal Source Codes; Pascal FAQs; Pascal How Tos
PHP Script Directory New!
Python Script Directory New!
Perl & CGI Script Directory New!
Flash Script Directory New!
CFML Script Directory New!
Remotely Hosted Scripts New!
Tools & Utilities Directory New!
XML Script Directory New!
Best Programmers: Amit Mathur; Vishal Bhardwaj; Deepesh Jain
Vyom NetWork

Our Services

Get 9,000 Interview Questions & Answers in an eBook.

9500+ Pages
9000 Question & Answers
All Tech. Categories

14 MB Content

Get it now !!

Home » Pascal Home » Pascal Projects Home » Student Database Information System.

A D V E R T I S E M E N T

Title	Student Database Information System.
Description
Category	Pascal » Pascal Projects
Hits	387825
Code	Select and Copy the Code
{ Description: Student Database. 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:pascalgi' ; type stdname = string[40]; searcharray = array[1..1000] of integer; student = record name : stdname; stdnum : real; semester : real; gpa : real; end; stdarray = array[1..1000] of student; 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 student 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('Student 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('Student 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('Student # '); readln(class[i].stdnum); write('Student 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 Student Number not allowed '); write('Please enter another student 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 student 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 Database'); 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('Student # ' , stdnum1:1:0); writeln('Student 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 student 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('Student # ' ,class[h4].stdnum:1:0); writeln('Student 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('Student # '); readln(class[i].stdnum); write('Student 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 Student Number not allowed '); write('Please enter another student 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 database'); write('Do yo want to continue '); readln(choice); if (choice = 'y') or (choice = 'Y') then begin rewrite(indata1) ; close(indata1) ; writeln('Database 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.

Related Source Codes

Script Name Author

Calendar date to day number and back Nicky McLean

Matrix Multiple Cirruse Salehnasab

Function Power Recursive Cirruse Salehnasab

swim brian colston

tetris (Mini Project) mehdi farrokhzad

Macsi - space fighting game. Macsi P�ter

Recursive Monkey Puzzle Solution - Project Maxim C.L. Wrne

Maze Game Project In Pascal Mahmood

Excellent Rat in a Maze Program. VyomWorld

A car game. You have to drive the car in such a way that you dont strike a barrier on the road. VyomWorld

Tic Tac Toe Game implemented in Pascal. VyomWorld

Game to Gain more blocks by drawing appropriate lines from correct places(dots). VyomWorld

To Find The Coinage Of The Amount Entered. VyomWorld

Randomizes two 3x3 arrays and indicates the numbers whih are common in both the arrays otherwise an cross 'x' is shown instead. VyomWorld

Program that checks the space on drive a: and also gives a graphical representation of memory. VyomWorld

A D V E R T I S E M E N T

Google Groups Subscribe to SourceCodesWorld - Techies Talk

Email:

Free eBook - Interview Questions: Get over 1,000 Interview Questions in an eBook for free when you join JobsAssist. Just click on the button below to join JobsAssist and you will immediately receive the Free eBook with thousands of Interview Questions in an ebook when you join.

Free Tutorials - HTML, Java, SQL, PHP, ASP, Perl, SQL Tutorials
Discuss Programming Problems and Freshers Jobs related issues here.
Discuss Final Year Project Ideas here.