home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Jason Aller Floppy Collection
/
276.img
/
FORUM21S.ZIP
/
MYLOGIN.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-09-27
|
12KB
|
429 lines
{$R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }
{$M 65500,0,0 }
unit getlogin;
interface
uses crt,
gentypes,configrt,modem,userret,statret,gensubs,subs1,subs2,windows,
mailret,textret,overret1,mainr1,mainr2;
procedure getloginproc;
procedure returnfromdoor;
implementation
procedure getloginproc;
var isnew:boolean;
procedure addlastcaller (n:mstr);
var qf:file of lastrec;
last,cnt:integer;
l:lastrec;
begin
assign (qf,'Callers');
reset (qf);
if ioresult<>0 then rewrite (qf);
last:=filesize(qf);
if last>maxlastcallers then last:=maxlastcallers;
for cnt:=last-1 downto 0 do begin
seek (qf,cnt);
read (qf,l);
seek (qf,cnt+1);
write (qf,l)
end;
with l do begin
name:=n;
when:=now;
callnum:=round(numcallers)
end;
seek (qf,0);
write (qf,l);
close (qf)
end;
procedure byebye (byefile:sstr);
begin
printfile (textfiledir+byefile);
unum:=-1;
disconnect
end;
procedure nicetry;
begin
byebye ('NiceTry')
end;
procedure getsystempassword;
var tries:integer;
b:boolean;
begin
tries:=0;
writeln(^B' DDT/6');
writeln;
writeln(^B' Kelv''s answering machine. ');
writeln(^B' Leave your name and number and ');
writeln(^B' I''ll try to get back to you as ');
writeln(^B' soon as I can. If it''s urgent ');
writeln(^B' put an (*) after your name. ');
writeln(^B' ------------------------------ ');
repeat
chainstr:='';
writeln (^B'Entry:');
dots:=true;
writestr ('=> *');
tries:=tries+1;
b:=match(input,systempassword)
until (tries=4) or b;
if not b then nicetry
end;
procedure newuser;
function validphone:boolean;
var p:integer;
k:char;
begin
validphone:=false;
p:=1;
while p<=length(input) do begin
k:=input[p];
if k in ['0'..'9']
then p:=p+1
else delete (input,p,1);
end;
if length(input)<>10 then begin
writestr ('The phone number must be 10 digits long.');
exit
end;
if (input[2] in ['2'..'9']) or (input[1] in ['0','1'])
or (input[4] in ['0','1']) then begin
writestr ('Invalid phone number.');
exit
end;
validphone:=true
end;
procedure getoption (c:configtype; txt:lstr; b:boolean);
const yn:array [false..true] of string[3]=('No','Yes');
begin
if hungupon then exit;
txt:=txt+' [def: '+yn[b]+'] ? *';
writestr (txt);
if length(input)<>0 then b:=yes;
if b
then urec.config:=urec.config+[c]
else urec.config:=urec.config-[c]
end;
var oldn:integer;
k:char;
begin
if private then byebye ('Newuser') else begin
printfile (textfiledir+'Newuser');
unum:=0;
oldn:=0;
repeat
if oldn<>0 then unam:='';
if length(unam)=0 then begin
writestr (^B'Enter your name:'^M'=> *');
unam:=input;
if pos('*',unam)>0 then begin
writestr ('Invalid user name!');
oldn:=1
end
end;
if hungupon then exit;
if length(unam)=0
then oldn:=0
else begin
writestr ('Hold on a sec..');
if not validuname(unam)
then oldn:=1
else begin
oldn:=lookupuser(unam);
if oldn<>0 then writestr (^B'Sorry! That name is in use!')
end
end
until oldn=0;
ulvl:=1;
if unam<>'' then begin
unum:=adduser (urec);
if unum<1 then begin
writeln (^B'Sorry! No room for new users right now!'^M,
'Try again later!'^M);
hangupmodem;
exit
end;
writeln (^B^M'You are user number ',unum,'.');
repeat
lastprompt:=^B^M'Please choose a password now.'^B^M'> ';
write (lastprompt)
until getpassword or hungupon;
with urec do begin
regularcolor:=7;
promptcolor:=7;
statcolor:=7;
inputcolor:=7
end;
repeat
writestr (^M'What is your home phone number? *');
until validphone or hungupon;
urec.phonenum:=input;
writeln;
repeat
writestr ('Can you emulate: A)NSI color, V)T52, or N)one:');
if length(input)>0
then k:=upcase(input[1])
else k:='N'
until (k in ['A','N','V']) or hungupon;
case k of
'A':urec.config:=urec.config+[ansigraphics];
'V':urec.config:=urec.config+[vt52];
'N':getoption (lowercase,'Can you display lower case',true)
end;
if k in ['A','V']
then getoption (fseditor,
'Do you want to use the full-screen editor',true)
else urec.config:=urec.config-[fseditor];
getoption (moreprompts,'Should I pause after every screen',false);
repeat
writestr ('How many lines long is your screen? *');
urec.displaylen:=valu(input)
until ((urec.displaylen>20) and (urec.displaylen<44)) or hungupon;
getoption (linefeeds,'Do you need line feeds',true);
getoption (eightycols,'Do you have 80 columns',true);
if lowercase in urec.config then
getoption (asciigraphics,'Can you see IBM graphics characters',true);
if hungupon then begin
unum:=0;
exit
end;
writeurec;
isnew:=true
end else begin
unum:=0;
writeln (^B^M'If you aren''t a new user...')
end
end
end;
procedure getunum;
var tries,cnt:integer;
u:userrec;
enterednum:boolean;
begin
tries:=0;
repeat
tries:=tries+1;
if tries>3 then nicetry else begin
chainstr:='';
writestr
(^M'Enter your full name.'+^B^M+'=> *');
unam:=input;
isnew:=false;
enterednum:=valu(unam)<>0;
if hungupon then unum:=-1 else
if length(unam)=0
then newuser
else begin
unum:=lookupuser (unam);
if unum=0
then
begin
writestr ('Not found! Are you new? *');
if yes then newuser
end
else if not enterednum
then writeln (^M'Use ',unum,' for faster logon.')
end
end
until unum<>0
end;
procedure getpwd;
var u:userrec;
begin
seek (ufile,unum);
read (ufile,u); che;
if not checkpassword(u) then begin
nicetry;
writelog (0,2,unam)
end;
writeln (^M)
end;
procedure inituser;
var asc:boolean;
procedure center (c:lstr; a,b:sstr);
var cnt:integer;
tmp:lstr;
begin
if asc then begin
a:='│';
b:=a
end;
fillchar (tmp[1],80,32);
if length(a)+length(b)+length(c)>39
then c[0]:=chr(39-length(a)-length(b));
tmp[0]:=chr((39-length(c)-length(a)-length(b)) div 2);
c:=a+tmp+c;
tmp[0]:=chr(39-length(c)-length(b));
c:=c+tmp+b;
while c[length(c)]=' ' do c[0]:=pred(c[0]);
writeln (c)
end;
var m:mailrec;
cnt:integer;
tmp:lstr;
const inoutstr:array [false..true] of string[3]=('Out','In');
begin
readurec;
if ulvl=-1 then begin
byebye ('Trashcan');
exit
end;
if requireforms and (urec.infoform<0) then infoform;
writestr ('O.K. you''re on!'^M);
if local
then tmp:=' (Local)'
else tmp:=' at '+baudstr;
writelog (0,1,unam+tmp);
with urec do begin
numon:=numon+1;
numcallers:=numcallers+1;
callstoday:=callstoday+1;
asc:=asciigraphics in config;
if datepart(laston)<>datepart(now) then begin
cnt:=ulvl;
if cnt<1 then cnt:=1;
if cnt>100 then cnt:=100;
timetoday:=usertime[cnt]
end;
if (timetillevent<timetoday+3) and (timetillevent<=63) then begin
writestr (^M'Due to a timed event scheduled for '+eventtime+',');
writeln ('your time today is limited to ',timetillevent-3,' mins.')
end;
write (^B^M);
if asc
then writeln ('╒══════════╡ '^S,versionnum,^N' ╞══════════╕')
else writeln ('/----------: ',versionnum,' :----------\');
center ('Welcome, '+unam+'.','\','/');
center ('Caller number: '+streal(numcallers),' \','/ ');
center ('Last caller: '+getlastcaller,' /','\ ');
center ('This is time on #'+strr(numon)+' for you.','/','\');
center ('Total time on: '+streal(totaltime)+' mins.','\','/');
if laston<>0 then
center ('Last on '+datestr(laston)+' at '+timestr(laston)+
'.',' !','! ');
subs1.laston:=laston;
laston:=now;
center ('Time for today: '+strr(timetoday)+' mins.',' /','\ ');
center ('Your ranking: Level '+strr(ulvl),'/','\');
center ('Sysop is: '+inoutstr[sysopisavail],'!','!');
if asc
then writeln ('╘═════════════════════════════════════╛'^B^M)
else writeln ('\-------------------------------------/'^B^M);
cnt:=getnummail(unum);
if cnt>0
then writeln (^B^G'You have ',cnt,
' piece',s(cnt),' of mail waiting! Use [E] to read.');
if (ulvl>=sysoplevel) then begin
if numfeedback>0 then begin
thereisare (numfeedback);
writeln ('piece',s(cnt),' of feedback waiting! Use [%,F] to read.')
end;
if exist ('Errlog')
then writeln (^B^G'Errors have occured! Use [%,E] to read.')
end;
logontime:=timer;
logofftime:=timer+timetoday;
logonunum:=unum
end;
if exist ('ad')
then writestr ('Buy this software! Use & to read!');
addlastcaller (unam);
writeurec;
bottomline;
if wanted in urec.config then if sysopisavail then begin
writeln (^B,sysopname,' wishes to speak with you.');
writeln ('Paging.. please stand by...'^M);
for cnt:=1 to 25 do if not keyhit then summonbeep;
chatmode:=true
end;
printnews;
if tonext>-1 then begin
writehdr ('Message from last user');
printtext (tonext)
end;
disconnected:=false
end;
begin
stoptimer (numminsidle);
starttimer (numminsused);
textcolor (normbotcolor);
clrscr;
initwinds;
fillchar (urec,sizeof(urec),0);
urec.config:=[lowercase,linefeeds,eightycols];
uselinefeeds:=true;
usecapsonly:=false;
getsystempassword;
printfile (textfiledir+'Welcome.'+strr(random(numwelcomes)+1));
if autologin and local and (not carrier) then begin
unum:=lookupuser (sysopname);
if unum=0
then writeln (usr,'User ',sysopname,' not found!')
else begin
writeln (usr,'* SYSOP AUTOLOGIN *');
unum:=1;
inituser;
exit
end
end;
getunum;
if hungupon then exit;
if not isnew then getpwd;
if hungupon then exit;
inituser
end;
procedure returnfromdoor;
var t:sstr;
begin
if not fromdoor then exit;
readdataarea;
baudrate:=valu(paramstr(2));
parity:=boolean(valu(paramstr(3)));
online:=baudrate<>0;
local:=not online;
if baudrate=0 then baudrate:=defbaudrate;
setparam (usecom,baudrate,parity);
if unum=valu(paramstr(1)) then readurec else begin
unum:=valu(paramstr(1));
readurec;
if (unum<1) or (unum>numusers) then begin
unum:=-1;
exit
end;
logontime:=timer;
logofftime:=timer+urec.timetoday
end;
if hungupon then begin
unum:=-1;
exit
end;
fromdoor:=true;
t:=paramstr(4);
if t=''
then returnto:='D'
else returnto:=upcase(t[1])
end;
begin
end.