home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / ENTERPRS / CPM / TERMS / BOZBBS08.LZH / LOGIN.PAS < prev    next >
Pascal/Delphi Source File  |  2000-06-30  |  5KB  |  144 lines

  1. program login;
  2.  
  3. const debug=false;
  4.  
  5. type user=record
  6.              refnum:integer;
  7.              firstname,lastname,password:string[32];
  8.              access:integer;
  9.              validated:boolean;
  10.           end;
  11.  
  12. var duser,euser:user;
  13.     usrfile,curuser:file of user;
  14.     scrfile:text;
  15.     dchar:char;
  16.     password:string[32];
  17.     index:byte;
  18.     exitflag:boolean;
  19.  
  20. procedure hangup;
  21.    var prog:file;
  22.    begin
  23.       assign(prog,'DBYE.COM');
  24.       execute(prog);
  25.    end;
  26.  
  27. procedure newuser;
  28.    var fn1,fn2,fn3,ln1,ln2,ln3,password,anstr:string[32];
  29.        euser:user;
  30.        index:byte;
  31.        found:boolean;
  32.    begin
  33.       if debug then writeln('[DIAG] entering newuser');
  34.       write(^L^Z);
  35.       assign(scrfile,'NEWUSER.MSS'); reset(scrfile);
  36.       while not eof(scrfile) do begin
  37.          read(scrfile,dchar); write(dchar); end;
  38.       repeat
  39.          write('Your choice: (R)egister (Q)uit -->'); readln(anstr);
  40.       until anstr in ['R','r','Q','q'];
  41.       if anstr in ['R','r'] then begin
  42.          write('Reference #1 (Firstname Lastname) :');
  43.          readln(fn1,ln1);
  44.          reset(usrfile); while not(eof(usrfile) or found) do begin
  45.             read(usrfile,euser); found:=false;
  46.             if (fn1=euser.firstname)
  47.             and (ln1=euser.lastname)
  48.             and euser.validated
  49.             then found:=true;
  50.          end;
  51.          if found then begin
  52.             write('Reference #2 :'); readln(fn2,ln2);
  53.             reset(usrfile); while not(eof(usrfile) or found) do begin
  54.                read(usrfile,euser); found:=false;
  55.                if (fn2=euser.firstname)
  56.                and (ln2=euser.lastname)
  57.                and (not(fn2=fn1) and not(ln2=ln1))
  58.                and euser.validated
  59.                then found:=true;
  60.             end;
  61.          end else begin
  62.             writeln('Incorrect name! Sorry, logon not allowed!');
  63.             hangup; end;
  64.          if found then begin
  65.             write('Reference #3 :'); readln(fn3,ln3);
  66.             reset(usrfile); while not(eof(usrfile) or found) do begin
  67.                read(usrfile,euser); found:=false;
  68.                if (fn3=euser.firstname)
  69.                and (ln3=euser.lastname)
  70.                and (not(fn3=fn2) and not(ln3=ln2))
  71.                and (not(fn3=fn1) and not(ln3=ln1))
  72.                and euser.validated
  73.                then found:=true;
  74.             end;
  75.          end else begin
  76.             writeln('Incorrect name! Sorry, logon not allowed!');
  77.             hangup; end;
  78.          if not found then begin
  79.             writeln('Incorrect name! Sorry, logon not allowed!');
  80.             hangup; end;
  81.          repeat
  82.             write('Enter your password -->'); readln(password);
  83.             write('Verify password ------>'); readln(duser.password);
  84.          until password=duser.password;
  85.          duser.validated:=false;
  86.          duser.access:=5;
  87.          reset(usrfile);
  88.          while not((euser.refnum=0) or eof(usrfile)) do
  89.             read(usrfile,euser);
  90.          euser:=duser;
  91.          euser.refnum:=euser.refnum+1;
  92.          write(usrfile,euser);
  93.       end else hangup;
  94.    end;
  95.  
  96. begin {Main}
  97.    if debug then writeln('[DIAG] debug system active');
  98.    duser.refnum:=0;
  99.    write('Your first name please? -->');
  100.    readln(duser.firstname);
  101.    if not(pos(duser.firstname,' ')=0)
  102.       then duser.lastname:=
  103.          copy(duser.firstname,
  104.             pos(duser.firstname,' ')+1,length(duser.firstname))
  105.    else begin write('And your last name? ------>');
  106.    readln(duser.lastname); end;
  107.    if debug then writeln('[DIAG] all user data read');
  108.    assign(usrfile,'BBSUSERS.DAT');
  109.    assign(curuser,'CURUSER.DAT');
  110.    if debug then writeln('[DIAG] file assigned');
  111.    rewrite(curuser);
  112.    if debug then writeln('[DIAG] current user file rewritten');
  113.    {$I-} reset(usrfile) {$I+};
  114.    if debug then writeln('[DIAG] user file reset');
  115.    if not(ioresult=0) then begin
  116.       writeln('Sorry, user file not present -- logon not allowed!');
  117.       hangup; end;
  118.    if debug then writeln('[DIAG] ioresult checked');
  119.    while not eof(usrfile) do begin
  120.       if debug then writeln('[DIAG] start of file read loop');
  121.       read(usrfile,euser);
  122.       if debug then writeln('[DIAG] user list read');
  123.       if (duser.firstname=euser.firstname)
  124.          and (duser.lastname=euser.lastname)
  125.          then duser:=euser;
  126.       if debug then writeln('[DIAG] checking user list');
  127.    end;
  128.    if duser.refnum=0 then newuser
  129.       else begin
  130.          index:=1;
  131.          repeat
  132.             write('Password? ---------------->');
  133.             readln(password);
  134.             index:=index+1;
  135.          until (password=duser.password) or (index>5);
  136.          if index>5 then begin
  137.             writeln('Logon not allowed!');
  138.             hangup; end;
  139.       end;
  140.       write(curuser,duser);
  141.    close(usrfile);
  142.    close(curuser);
  143. end.
  144.