home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / TURBOP.ZIP / PASSWORD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-11-01  |  6.0 KB  |  189 lines

  1. PROGRAM Password; 
  2. {$C-,U-} 
  3. TYPE 
  4.   Str10         =STRING[10]; 
  5. VAR 
  6.   paswrd,paswrd1, 
  7.   paswrd2,paswrd3, 
  8.   MasterPassWord         :STR10; 
  9.   I,Z                    :INTEGER; 
  10.   goodpassword,Ok        :BOOLEAN; 
  11.   Ch                     :CHAR; 
  12.   PassFile               :TEXT; 
  13.  
  14. procedure INSTRUCTIONS; 
  15. begin 
  16.       gotoXY(10,13); 
  17.       textcolor(7); 
  18.       WRITE('Please enter the proper '); 
  19.       textcolor(15); 
  20.       Write('PASSWORD'); 
  21.       textcolor(7); 
  22.       write(', and press the Return Key.'); 
  23. end; 
  24.  
  25. function UpcaseStr(S : Str10) : Str10; 
  26. var 
  27.   P : Integer; 
  28. begin 
  29.   for P := 1 to Length(S) do 
  30.     S[P] := Upcase(S[P]); 
  31.   UpcaseStr := S; 
  32. end; 
  33.  
  34. function Encription(s: Str10) : Str10; 
  35. var 
  36.   L : Integer; 
  37. begin 
  38.   for L := 1 to length(S) do 
  39.     S[L] := Chr(Ord(S[L]) + Z); 
  40.     Encription := S; 
  41. end; 
  42.  
  43. function Decription(s: Str10) : Str10; 
  44. var 
  45.   L : Integer; 
  46. begin 
  47.   for L := 1 to length(S) do 
  48.     S[L] := Chr(Ord(S[L]) - Z); 
  49.     Decription := S; 
  50. end; 
  51.  
  52. BEGIN 
  53.     Z := 65; 
  54.     Assign(PassFile,'Password.key'); 
  55.     {$I-} Reset(PassFile) {$I+}; 
  56.     Ok:=(IOresult = 0); 
  57.     Case Ok of 
  58.     true: begin 
  59.          Readln(PassFile,paswrd1); 
  60.          Readln(PassFile,paswrd2); 
  61.          Readln(PassFile,paswrd3); 
  62.          Close(PassFile); 
  63.        end; 
  64.     false:  begin 
  65.         CLRSCR; 
  66.         GOTOXY(18,13); 
  67.         Textcolor(7); 
  68.         Writeln('Password list not found, enter the MASTER PASSWORD'); 
  69.         write(^G); 
  70.         delay(3000); 
  71.         Rewrite(PassFile); 
  72.         Close(PassFile); 
  73.         end; 
  74.     end; 
  75.     goodpassword:=false; 
  76.   REPEAT 
  77.     instructions; 
  78.     Readln(Kbd,paswrd); 
  79.     If Length(paswrd) = 0 Then 
  80.       begin 
  81.         write(^G); 
  82.         goodpassword:=false; 
  83.       end 
  84.     Else IF UpcaseStr(paswrd) = Decription(paswrd1) Then goodpassword:=true 
  85.     Else If UpcaseStr(paswrd) = Decription(paswrd2) Then goodpassword:=true 
  86.     Else If UpcaseStr(paswrd) = Decription(paswrd3) Then goodpassword:=true 
  87.     Else If UpcaseStr(paswrd) = 'BUTTERBALL' Then goodpassword:=true 
  88.     Else 
  89.     begin 
  90.     textmode(0); 
  91.     gotoXY(5,13); 
  92.     Writeln('Please Enter the Right Password!'); 
  93.     For I:=1 TO 3 DO BEGIN; 
  94.     write(^G); 
  95.     DELAY(550) 
  96.     end; 
  97.      TextMode(2); 
  98.     END; 
  99.   UNTIL goodpassword =true; 
  100.      CLRSCR; 
  101.      If UpcaseStr(paswrd) = 'BUTTERBALL' Then 
  102.      begin 
  103.      Writeln('Do you wish to change the passwords?'); 
  104.      Read(Kbd,Ch); 
  105.      Ch:=UpCase(Ch); 
  106.      If Ch = 'Y' then 
  107.        begin 
  108.        Assign(PassFile,'Password.key'); 
  109.        Rewrite(PassFile); 
  110.        Writeln('Enter Password #1'); 
  111.        Readln(con,paswrd1); 
  112.        Writeln('Enter Password #2'); 
  113.        Readln(con,paswrd2); 
  114.        Writeln('Enter Password #3'); 
  115.        Readln(con,paswrd3); 
  116.        Writeln(PassFile,Encription(UpcaseStr(paswrd1))); 
  117.        Writeln(Passfile,Encription(UpcaseStr(paswrd2))); 
  118.        Writeln(Passfile,Encription(UpcaseStr(paswrd3))); 
  119.        Close(PassFile); 
  120.        end; 
  121.      end; 
  122. writeln('THIS IS A TEST'); 
  123. delay(2500); 
  124. end. 
  125.  
  126. {THIS PROCEDURE WAS WRITTEN TO BE INCLUDED INTO A DATA BASE OF EXAMINATION 
  127.  QUESTIONS.  AS WRITTEN IT ALLOWS FOR THE ASSIGNMENT OF THREE PASSWORDS, 
  128.  THESE PASSWORDS ARE STORED IN AN ENCRIPTED FORM IN A FILE CALLED PASSWORD.KEY 
  129.  THE ENCRIPTION IS DONE BY ADDING 65 TO ORD VALUE OF THE PASSWORD BEING 
  130.  ENTERED, THE ENTERED PASSWORD IS ALSO FORCED TO UPPERCASE, TO AVOID CAP LOCK 
  131.  PROBLEMS ON KEYBOARDS WITHOUT INDICATORS. 
  132.  
  133.  YOU MAY CHANGE THE LEVEL OF ENCRIPTION BY CHANGING THE VALUE OF THE VARIABLE 
  134.  Z IN THE PROGRAM. 
  135.  
  136.  ALSO AS WRITTEN THE MASTER PASSWORD "BUTTERBALL", WOULD BE VISIBLE USING 
  137.  DEBUG OR ANY OF SEVERAL DISK UTILITIES, TO PREVENT THIS REPLACE THE FOLLOWING 
  138.  LINES, 
  139.  
  140.     Else If UpcaseStr(paswrd) = 'BUTTERBALL' Then goodpassword:=true 
  141.  
  142.     If UpcaseStr(paswrd) = 'BUTTERBALL' Then 
  143.  
  144.  WITH, 
  145.  
  146.    Else If UpcaseStr(paswrd) =DECRIPTION('BUTTERBALL') Then goodpassword:=true 
  147.  
  148.    If UpcaseStr(paswrd) = DECRIPTION('BUTTERBALL') Then 
  149.  
  150.  AND, 
  151.  
  152.  ENTER THE NEW MASTER PASSWORD USING THE ALTERNATE KEY, (ADD THE VALUE OF 
  153.  Z TO THE UPPERCASE LETTER, DECIMAL VALUE) ie WITH Z := 65, TO ENTER THE 
  154.  LETTER "A", HOLD DOWN THE ALT. KEY AND TYPE IN (THE SUM OF 65 + 65 =) 130 
  155.  WITH THE NUMERIC KEYPAD (KEYPAD ONLY).  DO THIS CHANGE JUST BEFORE FINAL 
  156.  COMPLING, BY ADD 65 MOST PRINTERS WILL SEE THE CHARACTER AS A HIGH ORDER 
  157.  BIT, STRIP 128 FROM IT AND USE IT AS A CONTROL CHARACTER, THIS WON'T CAUSE 
  158.  DAMAGE, BUT MAY DESELECT THE PRINTER, CHANGE FONTS, ETC. 
  159.  
  160.  ALSO, TO CHANGE PASSWORDS, ALL THAT IS NECESSARY IS TO ENTER THE MASTER 
  161.  PASSWORD WHICH STAYS WITH THE PROGRAM EVEN IF PASSWORD.KEY IS ERAISED, 
  162.  AND THE PROGRAM WILL PROMPT FOR INPUT, ENTERING THREE RETURNS WILL DELETE 
  163.  ALL OF THE NON-MASTER PASSWORDS. 
  164.  
  165.  IF YOU HAVE ANY PROBLEMS, OR SUGGESTED IMPROVEMENTS DROP ME A NOTE. 
  166.  
  167.  CHUCK ARBUTHNOT 70127,264
  168. 
  169.    If UpcaseStr(paswrd) = DECRIPTION('BUTTERBALL') Then 
  170.  
  171.  AND, 
  172.  
  173.  ENTER THE NEW MASTER PASSWORD USING THE ALTERNATE KEY, (ADD THE VALUE OF 
  174.  Z TO THE UPPERCASE LETTER, DECIMAL VALUE) ie WITH Z := 65, TO ENTER THE 
  175.  LETTER "A", HOLD DOWN THE ALT. KEY AND TYPE IN (THE SUM OF 65 + 65 =) 130 
  176.  WITH THE NUMERIC KEYPAD (KEYPAD ONLY).  DO THIS CHANGE JUST BEFORE FINAL 
  177.  COMPLING, BY ADD 65 MOST PRINTERS WILL SEE THE CHARACTER AS A HIGH ORDER 
  178.  BIT, STRIP 128 FROM IT AND USE IT AS A CONTROL CHARACTER, THIS WON'T CAUSE 
  179.  DAMAGE, BUT MAY DESELECT THE PRINTER, CHANGE FONTS, ETC. 
  180.  
  181.  ALSO, TO CHANGE PASSWORDS, ALL THAT IS NECESSARY IS TO ENTER THE MASTER 
  182.  PASSWORD WHICH STAYS WITH THE PROGRAM EVEN IF PASSWORD.KEY IS ERAISED, 
  183.  AND THE PROGRAM WILL PROMPT FOR INPUT, ENTERING THREE RETURNS WILL DELETE 
  184.  ALL OF THE NON-MASTER PASSWORDS. 
  185.  
  186.  IF YOU HAVE ANY PROBLEMS, OR SUGGESTED IMPROVEMENTS DROP ME A NOTE. 
  187.  
  188.  CHUCK ARBUTHNOT 70127,264
  189.