home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / pinmoney.zip / PINMONEY.PAS < prev   
Pascal/Delphi Source File  |  1989-05-10  |  15KB  |  435 lines
  1. program pinmoney;
  2.  
  3.   {This program permits the user to store several PINs or passwords
  4.   in a single place so that they can be easily found.}
  5.  
  6. uses crt,printer,dos;
  7. const
  8.  version  = '1.00';
  9.  strnum    = '0..9';
  10.  stringnum = '0123456789';
  11.  strlet    = 'A..Z';
  12.  stringlet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  13.  strlow    = 'a..z';
  14.  stringlow = 'abcdefghijklmnopqrstuvwxyz';
  15.  strall    = 'a..z,A..Z';
  16.  stringall = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
  17.  strchr    = 'A..Z,0..9,+-.:;{}[]()*';
  18.  stringchr = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-.:;{}[]()*ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ';
  19.  strunx    = 'a..z,A..Z,0..9,+-.:;{}[]()*';
  20.  stringuna = 'abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz';
  21.  stringunb = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-.:;{}[]()*0123456789+-.:;{}[]()*';
  22.  strlab1   = 'pin   bank  faxcodhouse boxkeybuttonplug  pinboxdriverkey   save  lock1 faxkeyfoggy x-ray box   office';
  23.  strlab2   = 'boxes check fax   car   sport keys  pinloklock2 pin   plate buttonkeyhollock  switchclock disk  box   ';
  24.  vpos      = 4;
  25.  hpos      = 3;
  26.  vresp     = 15;
  27.  
  28. type
  29.  string6 = string[6];
  30.  
  31. var
  32.  found_file :searchrec;
  33.  outfile    :text;
  34.  yr,mo,da,dow:word;
  35.  file_name,
  36.  file_name_2,
  37.  Code_Word,
  38.  errorstring,
  39.  stringunx,
  40.  stringused,
  41.  strshow,
  42.  stringlabel,
  43.  secretstuff:string;
  44.  labelused  :string6;
  45.  i,j,k,
  46.  iok,jok,
  47.  line_value :integer;
  48.  filled     :array [1..26] of integer;
  49.  savedata   :array [0..9,1..26] of char;
  50.  savelabel  :array [0..9] of string[6];
  51.  temp       :integer;
  52.  overall_code,
  53.  getme      :char;
  54.  dot        :boolean;
  55.  
  56. procedure cleardata;
  57.   var
  58.   i,j   :integer;
  59.  
  60.   begin
  61.   stringlabel :=strlab1+strlab2;
  62.   stringunx := stringuna+stringunb;
  63.   stringused := stringnum;
  64.   k := random(length(stringlabel)-60);
  65.   k := (k div 6)* 6+1;
  66.   for i := 0 to 9 do
  67.     begin
  68.     for j := 1 to 26 do savedata[i,j] := stringused[random(length(stringused))+1];
  69.     savelabel[i] := stringlabel[k]+stringlabel[k+1]+stringlabel[k+2]+stringlabel[k+3]+stringlabel[k+4]+stringlabel[k+5];
  70.     k := k + 6;
  71.     end;
  72.   end;                                                        {----- cleardata}
  73.  
  74. procedure print_the_screen;
  75.   begin
  76.   getdate(yr,mo,da,dow);
  77.   writeln(lst,'   ');
  78.   writeln(lst,'.                                                                                .');
  79.   writeln(lst,'   ');
  80.   writeln(lst,'           A B C D E  F G H I J  K L M N O  P Q R S T  U V W X Y  Z  label');
  81.   writeln(lst,'  ');
  82.   for i := 0 to 9 do
  83.    begin
  84.    write(lst,'       ',i:1,'   ');
  85.    for j := 1 to 26 do
  86.      begin
  87.      write(lst,savedata[i,j],' ');
  88.      if j div 5 * 5 = j then write (lst,' ');
  89.      end;
  90.    writeln (lst,' ',savelabel[i]);
  91.    end;
  92.   writeln(lst,'   ');
  93.   writeln(lst,'           A B C D E  F G H I J  K L M N O  P Q R S T  U V W X Y  Z  ',mo,'/',da,'/',yr-1900);
  94.   writeln(lst,'   ');
  95.   writeln(lst,'.                                                                                .');
  96.   writeln(lst,'   ');
  97.   end;                                                {------ print_the_screen}
  98.  
  99.  
  100. procedure display_screen;
  101.  
  102.   begin
  103.   gotoxy (hpos,vpos-2);
  104.   writeln('     P I N M O N E Y  --  Keeps track of PINs      Version ',version);
  105.   gotoxy(hpos,vpos);
  106.   writeln('     A B C D E F G H I J K L M N O P Q R S T U V W X Y Z   label');
  107.   for i := 0 to 9 do
  108.    begin
  109.    gotoxy(hpos,vpos+2+i);
  110.    write(i:1);
  111.    gotoxy(hpos+5,vpos+2+i);
  112.    for j := 1 to 26 do write(savedata[i,j],' ');
  113.    write ('  ',savelabel[i],'             ');
  114.    end;
  115.   writeln;
  116.   gotoxy(hpos,vpos+13);
  117.   writeln('     A B C D E F G H I J K L M N O P Q R S T U V W X Y Z   label');
  118.   gotoxy(1,vpos+vresp);
  119.   writeln ('                                                                 ');
  120.   writeln ('Enter 0..9 to change a line     [ ]          L. P. Levine                ');
  121.   writeln ('      S,s to save the data                   3942 N. Oakland Avenue      ');
  122.   writeln ('      L,l to load new data                   Shorewood, WI 53211         ');
  123.   writeln ('      P,p to print the form                  (414) 962-4719              ');
  124.   writeln ('      X to exit.                             len@evax.milw.wisc.edu      ');
  125.   gotoxy(33,vpos+vresp+1);
  126.   write   ('[');
  127.   repeat until keypressed;
  128.   overall_code := readkey;
  129.   end;                                                 {----- display_screen}
  130.  
  131.  
  132. procedure get_code_word(var Code_Word:string);
  133.  {get a string from the user.  String must be all letters, must be at least
  134.    'n' characters long! and must have no repeats!.}
  135.  var
  136.   code  :string;
  137.   i     :integer;
  138.   alldone:boolean;
  139.  
  140.  begin
  141.  clrscr;
  142.  repeat     {until alldone = true}
  143.   gotoxy (1,2);
  144.   writeln ('           P I N M O N E Y  -  Keeps track of PIN numbers.');
  145.   gotoxy (1,12);
  146.   begin
  147.   writeln ('           Enter a code word, all letters, no repeated letters.');
  148.   writeln ('           The word should contain as many letters as are contained in ');
  149.   writeln ('           the longest password or PIN you will be encoding.');
  150.   writeln;
  151.   writeln ('           Remember that word, it is stored nowhere in this program!');
  152.   writeln;
  153.   gotoxy(1,21);
  154.   writeln ('           Examples: rosebud acegikmo baconstrip waxmonger');
  155.   gotoxy(1,18);
  156.   write   ('                                                  ');
  157.   gotoxy(1,18);
  158.   write   ('                   Codeword:  ');
  159.   readln (code);
  160.   alldone := true;
  161.   for temp := 1 to 26 do filled[temp] := 0;
  162.   for i := 1 to length(code) do
  163.     begin
  164.     if ((upcase(code[i]) < 'A') or (upcase(code[i]) > 'Z'))
  165.           and (alldone = true) then
  166.      begin
  167.      alldone := false;
  168.      writeln ('              The Character ',code[i],' is an invalid character   ');
  169.      end; {if upcase...}
  170.      filled[ord(upcase(code[i]))-64] := filled[ord(upcase(code[i]))-64] +1;
  171.      if (filled[ord(upcase(code[i]))-64] > 1) and (alldone = true) then
  172.        begin
  173.        writeln('              The Character ',code[i],' is used more than once     ');
  174.        alldone := false;
  175.        end; {if filled...}
  176.     end;
  177.   end;
  178.   if (length(code) < 4) and (alldone = true) then
  179.     begin
  180.     alldone := false;
  181.      writeln ('              Use a longer codeword.                              ');
  182.      end;   {length < 4 }
  183.  until alldone = true;
  184.  Code_Word := '';
  185.  for i := 1 to length(code) do
  186.    begin
  187.    Code_Word := Code_Word + upcase(chr(ord(code[i])));
  188.    end;
  189.  clrscr;
  190.  gotoxy(11,18);
  191.  writeln('Your code word is "',Code_Word,'".  Remember it.');
  192.  writeln;
  193.  writeln ('                   press any key');
  194.  overall_code := readkey;
  195.  end;                                                     {----- get_code_word}
  196.  
  197. procedure getline(var line_number  :integer;
  198.                   var stringused   :string;
  199.                   var labelused    :string6;
  200.                   var passcode     :string);
  201.  
  202.  begin
  203.  val(overall_code,line_number,i);
  204.  gotoxy(hpos+70,vpos+2+line_number); writeln ('<--');
  205.  gotoxy(hpos+70,vpos+2+line_number); writeln ('<--');
  206.  gotoxy(1,vpos+vresp);
  207.  writeln ('                                                                         ');
  208.  writeln ('                                                                         ');
  209.  writeln ('                                                                         ');
  210.  writeln ('                                                                         ');
  211.  writeln ('                                                                         ');
  212.  writeln ('                                                                         ');
  213.  gotoxy(1,vpos+vresp);
  214.  write ('Enter Label (6 characters) '); readln(labelused);
  215.  labelused := labelused + '       ';
  216.  gotoxy(hpos+59,vpos+2+line_number); writeln (labelused);
  217.  errorstring := '  ';
  218.  repeat
  219.  begin
  220.  i:=9;
  221.  while (i<1) or (i>6) do
  222.    begin
  223.    gotoxy(1,vpos+vresp);
  224.    writeln ('                                                                         ');
  225.    writeln ('                                                                         ');
  226.    writeln ('                                                                         ');
  227.    writeln ('                                                                         ');
  228.    writeln ('                                                                         ');
  229.    write   ('  ',errorstring,'                                                        ');
  230.    gotoxy(1,vpos+vresp);
  231.    writeln('Set 1: 0..9              Set 2: A..Z');
  232.    writeln('Set 3: a..z              Set 4: a..z,A..Z');
  233.    writeln('Set 5: A..Z,0..9,+-.:;{}[]()*');
  234.    write  ('Set 6: a..z,A..Z,0..9,+-.:;{}[]()*   ');
  235.    write  ('Which set?     '); getme := readkey;
  236.    val(getme,i,j);
  237.    end;
  238.    case i of
  239.       1:  begin
  240.           stringused := stringnum;
  241.           strshow    := strnum;
  242.           end;
  243.       2:  begin
  244.           stringused := stringlet;
  245.           strshow    := strlet;
  246.           end;
  247.       3:  begin
  248.           stringused := stringlow;
  249.           strshow    := strlow;
  250.           end;
  251.       4:  begin
  252.           stringused := stringall;
  253.           strshow    := strall;
  254.           end;
  255.       5:  begin
  256.           stringused := stringchr;
  257.           strshow    := strchr;
  258.           end;
  259.       6:  begin
  260.           stringused := stringunx;
  261.           strshow    := strunx;
  262.           end;
  263.       end;                             {case i of}
  264.  gotoxy(1,vpos+vresp);
  265.  writeln ('                                                                         ');
  266.  writeln ('                                                                         ');
  267.  writeln ('                                                                         ');
  268.  writeln ('                                                                         ');
  269.  writeln ('                                                                         ');
  270.  writeln ('                                                                         ');
  271.  gotoxy(5,vpos+vresp+1);
  272.  writeln('Characters:  ',strshow);
  273.  gotoxy(5,vpos+vresp+3);
  274.  write  ('Enter Passcode: '); readln(passcode);
  275.  iok := 0;
  276.  for i := 1 to length(passcode) do
  277.    begin
  278.    jok := 0;
  279.    for j := 1 to length(stringused) do
  280.    if passcode[i] = stringused[j] then jok := 1;
  281.    iok := iok + jok;
  282.    end;
  283.  end;
  284.  errorstring := 'Characters not in requested set, reenter please.';
  285.  
  286.  until iok = length(passcode)
  287.  end;                                                           {----- getline}
  288.  
  289. procedure build_a_line;
  290. begin
  291.   getline(line_value,stringused, labelused, secretstuff);
  292.   savelabel[line_value] := labelused;
  293.   k := length(stringused);
  294.   for j := 1 to 26 do
  295.     begin
  296.     savedata[line_value,j] := stringused[random(k)+1];
  297.     end;
  298.   for j := 1 to length(secretstuff) do
  299.     begin
  300.     savedata[line_value,ord(Code_Word[j])-64] := secretstuff[j]
  301.     end;
  302. end;                                                       {----- build_a_line}
  303.  
  304. procedure save_the_file;
  305.   begin
  306.  gotoxy(1,vpos+vresp);
  307.  writeln ('                                                                         ');
  308.  writeln ('   Save file to:         (enter name without extension.)                 ');
  309.  writeln ('                                                                         ');
  310.  writeln ('                                                                         ');
  311.  writeln ('                                                                         ');
  312.  writeln ('                                                                         ');
  313.  gotoxy(18,vpos+vresp+1);
  314.  dot := false;
  315.  readln(file_name);
  316.  for i := 1 to length(file_name) do if file_name[i] = '.' then dot := true;
  317.  if (not dot) then
  318.    begin
  319.    file_name_2 := file_name+'.pin';
  320.    file_name := file_name+'.txt';
  321.    end
  322.    else
  323.    begin
  324.    file_name_2 := file_name;
  325.    file_name := 'x.txt';
  326.    end;
  327.   assign(outfile,file_name_2);
  328.   rewrite(outfile);
  329.   for i := 0 to 9 do
  330.    begin
  331.    for j := 1 to 26 do write(outfile,savedata[i,j]);
  332.    writeln(outfile,savelabel[i]);
  333.    end;
  334.   close (outfile);
  335.   assign(outfile,file_name);
  336.   rewrite(outfile);
  337.   getdate(yr,mo,da,dow);
  338.   writeln(outfile,'   A B C D E  F G H I J  K L M N O  P Q R S T  U V W X Y  Z  label');
  339.   writeln(outfile,'   ');
  340.   for i := 0 to 9 do
  341.    begin
  342.    write  (outfile,i,'  ');
  343.    for j := 1 to 26 do
  344.      begin
  345.      write(outfile,savedata[i,j],' ');
  346.      if j div 5 * 5 = j then write(outfile,' ');
  347.      end;
  348.    writeln(outfile,' ',savelabel[i]);
  349.    end;
  350.   writeln(outfile,'   ');
  351.   writeln(outfile,'   A B C D E  F G H I J  K L M N O  P Q R S T  U V W X Y  Z  ',mo,'/',da,'/',yr-1900);
  352.   close (outfile);
  353.   end;                                                    {----- save_the_file}
  354.  
  355.  
  356. procedure load_the_file;
  357.   begin
  358.  gotoxy(1,vpos+vresp-4);
  359.  writeln ('                                                                        ');
  360.  writeln ('         Files:                                                         ');
  361.  writeln ('                                                                        ');
  362.  writeln ('                                                                        ');
  363.  writeln ('                                                                         ');
  364.  writeln ('                                                                         ');
  365.  writeln ('                                                                         ');
  366.  writeln ('                                                                         ');
  367.  writeln ('                                                                         ');
  368.  writeln ('                                                                         ');
  369.  gotoxy(1,vpos+vresp);
  370.  findfirst('*.pin',32,found_file);
  371.  i := 25;
  372.  j := vpos+vresp-3;
  373.  while doserror <> 18 do
  374.    begin
  375.    gotoxy(i,j);
  376.    write(found_file.name);
  377.    i := i + 15;
  378.    if i > 69 then
  379.      begin
  380.      writeln;
  381.      i := 10;
  382.      j := j + 1
  383.      end;
  384.    findnext(found_file);
  385.    end;
  386.  gotoxy(1,vpos+vresp+5);
  387.  writeln ('   Load file from:         (enter file without extension)          ');
  388.  gotoxy(20,vpos+vresp+5);
  389.  dot := false;
  390.  readln(file_name);
  391.  for i := 1 to length(file_name) do if file_name[i] = '.' then dot := true;
  392.  if (not dot) then file_name_2 := file_name+'.pin';
  393.   assign(outfile,file_name_2);
  394.   reset(outfile);
  395.   for i := 0 to 9 do
  396.    begin
  397.    for j := 1 to 26 do read(outfile,savedata[i,j]);
  398.    readln(outfile,savelabel[i]);
  399.    end;
  400.   close (outfile);
  401.   clrscr;
  402.   end;                                                    {----- load_the_file}
  403.  
  404.  
  405. begin {main program procedure}
  406. randomize;
  407. get_code_word(Code_Word);
  408. overall_code := ' ';
  409. cleardata;
  410. clrscr;
  411. while overall_code <> 'X' do
  412. begin
  413. display_screen;
  414. if (overall_code >= '0') and (overall_code <= '9') then
  415. build_a_line;
  416. if upcase(overall_code) = 'S' then
  417. save_the_file;
  418. if upcase(overall_code) = 'L' then
  419. load_the_file;
  420. if upcase(overall_code) = 'P' then
  421. print_the_screen;
  422. end;           {overall_code <> X}
  423. clrscr;
  424. end.
  425.  
  426.   { Search record used by FindFirst and FindNext
  427.   SearchRec = record
  428.                 Fill: array[1..21] of Byte;
  429.                 Attr: Byte;
  430.                 Time: Longint;
  431.                 Size: Longint;
  432.                 Name: string[12];
  433.               end;
  434.   }
  435.