home *** CD-ROM | disk | FTP | other *** search
/ PC Underground / UNDERGROUND.ISO / password / passwd3.pas < prev    next >
Pascal/Delphi Source File  |  1995-07-28  |  3KB  |  114 lines
  1. program PASSWORD_TYPE3;
  2.  
  3. Uses Crt, Design;
  4.  
  5. type PasswordType = record
  6.        page : byte;
  7.        text  : string[20];
  8.      end;
  9.  
  10. var pwords: array[1..10] of PasswordType;
  11.     pword    : PasswordType;
  12.     password : string;
  13.     PasswordCheck : boolean;
  14.     Pw_index : byte;
  15.  
  16. procedure Enter_list;
  17. var li : integer;
  18. begin
  19.  for li := 1 to 10 do begin
  20.   save_screen;
  21.   window(10,8,60,9,' Change password ',black,7);
  22.   writexy(13,10,'Please enter password ');
  23.   write(li,' of 10 of the list');
  24.   writexy(13,12,'Page of the password in the manual: ');
  25.   readln(pwords[li].page);
  26.   writexy(13,14,'Password :');
  27.   readln(pwords[li].text);
  28.   restore_screen;
  29.   textcolor(7);
  30.   textbackground(black);
  31.  end;
  32. end;
  33.  
  34. procedure Save_list;
  35. var pwf : file;
  36. begin
  37.   assign(pwf,'Passtyp3.DAT');
  38.   rewrite(pwf,10*sizeof(PasswordType));
  39.   blockwrite(pwf,pwords,1);
  40.   close(pwf);
  41. end;
  42.  
  43. procedure Load_password(Idx : byte);
  44. var pwf : file;
  45. begin
  46.   assign(pwf,'Passtyp3.DAT');
  47.   reset(pwf,1);
  48.   seek(pwf,Idx*sizeof(PasswordType));
  49.   blockread(pwf,pword,sizeof(PasswordType));
  50.   close(pwf);
  51.   save_screen;
  52.   window(10,8,45,7,'',black,7);
  53.   writexy(12,10,'Please enter the password on page ');
  54.   write(pword.page,'');
  55.   writexy(12,12,'Password: ');
  56.   readln(password);
  57.   restore_screen;
  58. end;
  59.  
  60. procedure CheckPassword;
  61. begin
  62.   if password = pword.text then
  63.     PasswordCheck := true
  64.   else
  65.     PasswordCheck := false;
  66. end;
  67.  
  68. procedure RespondPassword;
  69. begin
  70.   save_screen;
  71.   window(10,8,40,7,'',black,7);
  72.   If PasswordCheck then begin
  73.     writexy(13,11,'Password correct - Access granted');
  74.   end else begin
  75.     writexy(13,11,'Password WRONG ! - No Access !');
  76.   end;
  77.   repeat until keypressed; readkey;
  78.   restore_screen;
  79.   textcolor(7);
  80.   textbackground(black);
  81. end;
  82.  
  83.  
  84. procedure Menu;
  85. var choice : byte;
  86. begin
  87.   repeat
  88.     clrscr;
  89.     writexy(10,1,'Example program for password type 3 (c) ''94 by DATA BECKER');
  90.     writexy(20,4,'M E N U');
  91.     writexy(20,5,'~~~~~~~');
  92.     writexy(15,6,'1)  Enter password list');
  93.     writexy(15,8,'2)  Password query');
  94.     writexy(15,10,'3)  End');
  95.     writexy(15,13,'Your choice: ');
  96.     readln(choice);
  97.     if choice = 1 then begin
  98.       Enter_list;
  99.       Save_list;
  100.     end;
  101.     if choice = 2 then begin;
  102.       Pw_index := random(10)+1;
  103.       Load_password(Pw_Index);
  104.       CheckPassword;
  105.       RespondPassword;
  106.     end;
  107.   until choice = 3;
  108. end;
  109.  
  110. begin
  111.   textcolor(7);
  112.   textbackground(black);
  113.   Menu;
  114. end.