home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ADC_TP3.ZIP / PASSWORD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-03-01  |  4.8 KB  |  167 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