home *** CD-ROM | disk | FTP | other *** search
- PROGRAM Password;
- {$C-,U-}
- TYPE
- Str10 =STRING[10];
- VAR
- paswrd,paswrd1,
- paswrd2,paswrd3,
- MasterPassWord :STR10;
- I,Z :INTEGER;
- goodpassword,Ok :BOOLEAN;
- Ch :CHAR;
- PassFile :TEXT;
-
- procedure INSTRUCTIONS;
- begin
- gotoXY(10,13);
- textcolor(7);
- WRITE('Please enter the proper ');
- textcolor(15);
- Write('PASSWORD');
- textcolor(7);
- write(', and press the Return Key.');
- end;
-
- function UpcaseStr(S : Str10) : Str10;
- var
- P : Integer;
- begin
- for P := 1 to Length(S) do
- S[P] := Upcase(S[P]);
- UpcaseStr := S;
- end;
-
- function Encription(s: Str10) : Str10;
- var
- L : Integer;
- begin
- for L := 1 to length(S) do
- S[L] := Chr(Ord(S[L]) + Z);
- Encription := S;
- end;
-
- function Decription(s: Str10) : Str10;
- var
- L : Integer;
- begin
- for L := 1 to length(S) do
- S[L] := Chr(Ord(S[L]) - Z);
- Decription := S;
- end;
-
- BEGIN
- Z := 65;
- Assign(PassFile,'Password.key');
- {$I-} Reset(PassFile) {$I+};
- Ok:=(IOresult = 0);
- Case Ok of
- true: begin
- Readln(PassFile,paswrd1);
- Readln(PassFile,paswrd2);
- Readln(PassFile,paswrd3);
- Close(PassFile);
- end;
- false: begin
- CLRSCR;
- GOTOXY(18,13);
- Textcolor(7);
- Writeln('Password list not found, enter the MASTER PASSWORD');
- write(^G);
- delay(3000);
- Rewrite(PassFile);
- Close(PassFile);
- end;
- end;
- goodpassword:=false;
- REPEAT
- instructions;
- Readln(Kbd,paswrd);
- If Length(paswrd) = 0 Then
- begin
- write(^G);
- goodpassword:=false;
- end
- Else IF UpcaseStr(paswrd) = Decription(paswrd1) Then goodpassword:=true
- Else If UpcaseStr(paswrd) = Decription(paswrd2) Then goodpassword:=true
- Else If UpcaseStr(paswrd) = Decription(paswrd3) Then goodpassword:=true
- Else If UpcaseStr(paswrd) = 'BUTTERBALL' Then goodpassword:=true
- Else
- begin
- textmode(0);
- gotoXY(5,13);
- Writeln('Please Enter the Right Password!');
- For I:=1 TO 3 DO BEGIN;
- write(^G);
- DELAY(550)
- end;
- TextMode(2);
- END;
- UNTIL goodpassword =true;
- CLRSCR;
- If UpcaseStr(paswrd) = 'BUTTERBALL' Then
- begin
- Writeln('Do you wish to change the passwords?');
- Read(Kbd,Ch);
- Ch:=UpCase(Ch);
- If Ch = 'Y' then
- begin
- Assign(PassFile,'Password.key');
- Rewrite(PassFile);
- Writeln('Enter Password #1');
- Readln(con,paswrd1);
- Writeln('Enter Password #2');
- Readln(con,paswrd2);
- Writeln('Enter Password #3');
- Readln(con,paswrd3);
- Writeln(PassFile,Encription(UpcaseStr(paswrd1)));
- Writeln(Passfile,Encription(UpcaseStr(paswrd2)));
- Writeln(Passfile,Encription(UpcaseStr(paswrd3)));
- Close(PassFile);
- end;
- end;
- writeln('THIS IS A TEST');
- delay(2500);
- end.
-
- {THIS PROCEDURE WAS WRITTEN TO BE INCLUDED INTO A DATA BASE OF EXAMINATION
- QUESTIONS. AS WRITTEN IT ALLOWS FOR THE ASSIGNMENT OF THREE PASSWORDS,
- THESE PASSWORDS ARE STORED IN AN ENCRIPTED FORM IN A FILE CALLED PASSWORD.KEY
- THE ENCRIPTION IS DONE BY ADDING 65 TO ORD VALUE OF THE PASSWORD BEING
- ENTERED, THE ENTERED PASSWORD IS ALSO FORCED TO UPPERCASE, TO AVOID CAP LOCK
- PROBLEMS ON KEYBOARDS WITHOUT INDICATORS.
-
- YOU MAY CHANGE THE LEVEL OF ENCRIPTION BY CHANGING THE VALUE OF THE VARIABLE
- Z IN THE PROGRAM.
-
- ALSO AS WRITTEN THE MASTER PASSWORD "BUTTERBALL", WOULD BE VISIBLE USING
- DEBUG OR ANY OF SEVERAL DISK UTILITIES, TO PREVENT THIS REPLACE THE FOLLOWING
- LINES,
-
- Else If UpcaseStr(paswrd) = 'BUTTERBALL' Then goodpassword:=true
-
- If UpcaseStr(paswrd) = 'BUTTERBALL' Then
-
- WITH,
-
- Else If UpcaseStr(paswrd) =DECRIPTION('BUTTERBALL') Then goodpassword:=true
-
- If UpcaseStr(paswrd) = DECRIPTION('BUTTERBALL') Then
-
- AND,
-
- ENTER THE NEW MASTER PASSWORD USING THE ALTERNATE KEY, (ADD THE VALUE OF
- Z TO THE UPPERCASE LETTER, DECIMAL VALUE) ie WITH Z := 65, TO ENTER THE
- LETTER "A", HOLD DOWN THE ALT. KEY AND TYPE IN (THE SUM OF 65 + 65 =) 130
- WITH THE NUMERIC KEYPAD (KEYPAD ONLY). DO THIS CHANGE JUST BEFORE FINAL
- COMPLING, BY ADD 65 MOST PRINTERS WILL SEE THE CHARACTER AS A HIGH ORDER
- BIT, STRIP 128 FROM IT AND USE IT AS A CONTROL CHARACTER, THIS WON'T CAUSE
- DAMAGE, BUT MAY DESELECT THE PRINTER, CHANGE FONTS, ETC.
-
- ALSO, TO CHANGE PASSWORDS, ALL THAT IS NECESSARY IS TO ENTER THE MASTER
- PASSWORD WHICH STAYS WITH THE PROGRAM EVEN IF PASSWORD.KEY IS ERAISED,
- AND THE PROGRAM WILL PROMPT FOR INPUT, ENTERING THREE RETURNS WILL DELETE
- ALL OF THE NON-MASTER PASSWORDS.
-
- IF YOU HAVE ANY PROBLEMS, OR SUGGESTED IMPROVEMENTS DROP ME A NOTE.
-
- CHUCK ARBUTHNOT 70127,264
- If UpcaseStr(paswrd) = DECRIPTION('BUTTERBALL') Then
-
- AND,
-
- ENTER THE NEW MASTER PASSWORD USING THE ALTERNATE KEY, (ADD THE VALUE OF
- Z TO THE UPPERCASE LETTER, DECIMAL VALUE) ie WITH Z := 65, TO ENTER THE
- LETTER "A", HOLD DOWN THE ALT. KEY AND TYPE IN (THE SUM OF 65 + 65 =) 130
- WITH THE NUMERIC KEYPAD (KEYPAD ONLY). DO THIS CHANGE JUST BEFORE FINAL
- COMPLING, BY ADD 65 MOST PRINTERS WILL SEE THE CHARACTER AS A HIGH ORDER
- BIT, STRIP 128 FROM IT AND USE IT AS A CONTROL CHARACTER, THIS WON'T CAUSE
- DAMAGE, BUT MAY DESELECT THE PRINTER, CHANGE FONTS, ETC.
-
- ALSO, TO CHANGE PASSWORDS, ALL THAT IS NECESSARY IS TO ENTER THE MASTER
- PASSWORD WHICH STAYS WITH THE PROGRAM EVEN IF PASSWORD.KEY IS ERAISED,
- AND THE PROGRAM WILL PROMPT FOR INPUT, ENTERING THREE RETURNS WILL DELETE
- ALL OF THE NON-MASTER PASSWORDS.
-
- IF YOU HAVE ANY PROBLEMS, OR SUGGESTED IMPROVEMENTS DROP ME A NOTE.
-
- CHUCK ARBUTHNOT 70127,264