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 >
Wrap
Pascal/Delphi Source File
|
2000-06-30
|
5KB
|
144 lines
program login;
const debug=false;
type user=record
refnum:integer;
firstname,lastname,password:string[32];
access:integer;
validated:boolean;
end;
var duser,euser:user;
usrfile,curuser:file of user;
scrfile:text;
dchar:char;
password:string[32];
index:byte;
exitflag:boolean;
procedure hangup;
var prog:file;
begin
assign(prog,'DBYE.COM');
execute(prog);
end;
procedure newuser;
var fn1,fn2,fn3,ln1,ln2,ln3,password,anstr:string[32];
euser:user;
index:byte;
found:boolean;
begin
if debug then writeln('[DIAG] entering newuser');
write(^L^Z);
assign(scrfile,'NEWUSER.MSS'); reset(scrfile);
while not eof(scrfile) do begin
read(scrfile,dchar); write(dchar); end;
repeat
write('Your choice: (R)egister (Q)uit -->'); readln(anstr);
until anstr in ['R','r','Q','q'];
if anstr in ['R','r'] then begin
write('Reference #1 (Firstname Lastname) :');
readln(fn1,ln1);
reset(usrfile); while not(eof(usrfile) or found) do begin
read(usrfile,euser); found:=false;
if (fn1=euser.firstname)
and (ln1=euser.lastname)
and euser.validated
then found:=true;
end;
if found then begin
write('Reference #2 :'); readln(fn2,ln2);
reset(usrfile); while not(eof(usrfile) or found) do begin
read(usrfile,euser); found:=false;
if (fn2=euser.firstname)
and (ln2=euser.lastname)
and (not(fn2=fn1) and not(ln2=ln1))
and euser.validated
then found:=true;
end;
end else begin
writeln('Incorrect name! Sorry, logon not allowed!');
hangup; end;
if found then begin
write('Reference #3 :'); readln(fn3,ln3);
reset(usrfile); while not(eof(usrfile) or found) do begin
read(usrfile,euser); found:=false;
if (fn3=euser.firstname)
and (ln3=euser.lastname)
and (not(fn3=fn2) and not(ln3=ln2))
and (not(fn3=fn1) and not(ln3=ln1))
and euser.validated
then found:=true;
end;
end else begin
writeln('Incorrect name! Sorry, logon not allowed!');
hangup; end;
if not found then begin
writeln('Incorrect name! Sorry, logon not allowed!');
hangup; end;
repeat
write('Enter your password -->'); readln(password);
write('Verify password ------>'); readln(duser.password);
until password=duser.password;
duser.validated:=false;
duser.access:=5;
reset(usrfile);
while not((euser.refnum=0) or eof(usrfile)) do
read(usrfile,euser);
euser:=duser;
euser.refnum:=euser.refnum+1;
write(usrfile,euser);
end else hangup;
end;
begin {Main}
if debug then writeln('[DIAG] debug system active');
duser.refnum:=0;
write('Your first name please? -->');
readln(duser.firstname);
if not(pos(duser.firstname,' ')=0)
then duser.lastname:=
copy(duser.firstname,
pos(duser.firstname,' ')+1,length(duser.firstname))
else begin write('And your last name? ------>');
readln(duser.lastname); end;
if debug then writeln('[DIAG] all user data read');
assign(usrfile,'BBSUSERS.DAT');
assign(curuser,'CURUSER.DAT');
if debug then writeln('[DIAG] file assigned');
rewrite(curuser);
if debug then writeln('[DIAG] current user file rewritten');
{$I-} reset(usrfile) {$I+};
if debug then writeln('[DIAG] user file reset');
if not(ioresult=0) then begin
writeln('Sorry, user file not present -- logon not allowed!');
hangup; end;
if debug then writeln('[DIAG] ioresult checked');
while not eof(usrfile) do begin
if debug then writeln('[DIAG] start of file read loop');
read(usrfile,euser);
if debug then writeln('[DIAG] user list read');
if (duser.firstname=euser.firstname)
and (duser.lastname=euser.lastname)
then duser:=euser;
if debug then writeln('[DIAG] checking user list');
end;
if duser.refnum=0 then newuser
else begin
index:=1;
repeat
write('Password? ---------------->');
readln(password);
index:=index+1;
until (password=duser.password) or (index>5);
if index>5 then begin
writeln('Logon not allowed!');
hangup; end;
end;
write(curuser,duser);
close(usrfile);
close(curuser);
end.