{$A+,B+,E+,F+,I+,L+,N-,O+,R-,S+,V-} unit cuser; interface uses crt, dos, {rcg11172000 no overlay under Linux.} {overlay,} common; procedure cstuff(which,how:byte; var user:userrec); implementation (****************************************************************************** procedure: cstuff(which,how:byte; var user:userrec); --- purpose: Inputs user information. --- variables passed: which- 1:Address 6:Occupation 11:Screen size 2:Age 7:User name 12:Sex 3:ANSI status 8:Phone # 13:BBS reference 4:City & State 9:Password 14:Zip code 5:Computer type 10:Real name how- 1:New user logon in process 2:Menu edit command 3:Called by the user-list editor user- User information to modify ******************************************************************************) var callfromarea:integer; procedure cstuff(which,how:byte; var user:userrec); var done,done1:boolean; try:integer; fi:text; s:astr; i:integer; procedure findarea; var c:char; begin print('Are you calling from:'); print(' 1. United States'); print(' 2. Canada'); print(' 3. Other country'); nl; prt('Select (1-3) : '); onek(c,'123'); if (hangup) then exit; callfromarea:=ord(c)-48; done1:=TRUE; end; procedure doaddress; begin if (how=3) then print('Enter new mailing address.') else print('Enter your mailing address: [APT#]'); prt(':'); if (how=3) then inputl(s,30) else inputcaps(s,30); if (s<>'') then begin user.street:=s; done1:=TRUE; end; end; procedure doage; var b:byte; s:astr; function numsok(s:astr):boolean; var i:integer; begin numsok:=FALSE; for i:=1 to 8 do if not ((s[i] in ['0'..'9']) or (i=3) or (i=6)) then exit; numsok:=TRUE; end; begin {rcg11272000 y2k stuff.} {if (how=3) then prompt('Enter date of birth (mm/dd/yy) : ')} if (how=3) then prompt('Enter date of birth (mm/dd/yyyy) : ') else begin sprint('^301^5=January ^304^5=April ^307^5=July ^310^5=October'); sprint('^302^5=February ^305^5=May ^308^5=August ^311^5=November'); sprint('^303^5=March ^306^5=June ^309^5=September ^312^5=December'); nl; {rcg11272000 y2k stuff.} {prt('Enter your date of birth (mm/dd/yy) : ');} prt('Enter your date of birth (mm/dd/yyyy) : '); end; {rcg11272000 y2k stuff.} { cl(3); input(s,8); if ((length(s)=8) and (s[3]='/') and (s[6]='/')) then } cl(3); input(s,10); if ((length(s)=10) and (s[3]='/') and (s[6]='/')) then if (numsok(s)) then if (ageuser(s)<3) then sprint(#3#7+'Isn''t '+cstr(ageuser(s))+' years old a little YOUNG???') else begin user.bday:=s; done1:=TRUE; end; if ((not done1) and (how=1)) then sprint(#3#7+'Sorry, try again!'); end; procedure doansi; begin pr(#27+'[0;1;5;33;40mANSI test'); tc(14+128); writeln('ANSI test'); nl; if pynq('Do you have ANSI (are the above words blinking)? ') then begin user.ac:=user.ac+[ansi]; if pynq('Do you have a color monitor? ') then user.ac:=user.ac+[color]; end; done1:=TRUE; end; procedure docitystate; var s,s1,s2:astr; begin case how of 2:findarea; 3:callfromarea:=1; end; if (callfromarea<>3) then begin if (how=3) then begin print('Enter new city & state: '); prt(':'); inputl(s,30); if (s<>'') then user.citystate:=s; done1:=TRUE; exit; end; case callfromarea of 1:print('City & State entry.'); 2:print('City & Province entry.'); end; nl; if (callfromarea=1) then s1:='state' else s1:='province'; print('First enter your city name (do not include '+s1+'):'); prt(':'); inputcaps(s1,26); while (copy(s1,1,1)=' ') do s1:=copy(s1,2,length(s1)-1); while (copy(s1,length(s1),1)=' ') do s1:=copy(s1,1,length(s1)-1); nl; if (length(s1)<2) then begin sprint(#3#7+'Why do I find it hard to believe'); sprint(#3#7+'that that is '+#3#5+'not'+#3#7+' a real city?'); nl; if (callfromarea=1) then s2:='Detroit' else s2:='Toronto'; sprint(#3#7+'Example: "'+s2+'" is a real city.'); exit; end; if (pos(',',s1)<>0) then begin if (callfromarea=1) then s2:='state' else s2:='province'; sprint(#3#7+'NO COMMAS! Don''t enter your '+s2+' YET,'); sprint(#3#7+'just enter your CITY!!! I''ll ask for your'); sprint(#3#7+allcaps(s2)+' as soon as I know your CITY!!!'); nl; if (callfromarea=1) then s2:='Detroit' else s2:='Toronto'; sprint(#3#7+'Example: "'+s2+'" is a city!'); exit; end; if (callfromarea=1) then s2:='state' else s2:='province'; prompt('Now enter your 2-letter '+s2+' abbreviation: '); cl(3); input(s2,2); nl; if (length(s2)<2) then begin sprint(#3#0+'TWO '+#3#7+'characters. '+#3#0+'TWO '+#3#7+'characters. Can''t you count?'); sprint(#3#7+'(Hint: notice the word "'+#3#0+'TWO'+#3#7+'")'); exit; end; user.citystate:=s1+', '+s2; done1:=TRUE; end else begin print('First enter your city name, and nothing else:'); prt(':'); inputcaps(s1,26); if (length(s1)<2) then exit; nl; print('Now enter your country name:'); prt(':'); inputcaps(s2,26); if (length(s2)<2) then exit; nl; s:=s1+', '+s2; print('Final result: "'+s+'"'); if (length(s)>30) then begin print('Too long! Max total length is 30 characters.'); print('Find some way to abbreviate.'); exit; end; user.citystate:=s; done1:=TRUE; end; end; procedure docomputer; var fp:text; ctyp:array[1..31] of string[30]; i,n:integer; s,s1:astr; c:char; abort,next,other,cexist:boolean; begin other:=TRUE; cexist:=FALSE; assign(fp,systat.afilepath+'computer.txt'); {$I-} reset(fp); {$I+} if (ioresult=0) then begin cexist:=TRUE; other:=FALSE; i:=0; repeat inc(i); readln(fp,ctyp[i]); until eof(fp) or (i=30); close(fp); n:=i+1; ctyp[n]:='Other'; abort:=FALSE; for i:=1 to n do begin s:=#3#1+mln(cstr(i)+'.',3)+ctyp[i]; if (odd(i)) then s1:=s else printacr(mln(s1,33)+s,abort,next); end; if (odd(n)) then printacr(s1,abort,next); nl; if (how=3) then prt('Enter new computer type: ') else prt('Enter your computer type: '); input(s,2); i:=value(s); if (i>=1) and (i'') then begin user.computer:=s; done1:=TRUE; end; end; s:=''; i:=1; while (i<=length(user.computer)) do begin if (user.computer[i]<>#3) then s:=s+user.computer[i] else inc(i); inc(i); end; end; procedure dojob; begin if (how=3) then print('Enter new occupation.') else print('Enter your occupation:'); prt(':'); if (how=3) then inputl(s,40) else inputcaps(s,40); if (s<>'') then begin user.occupation:=s; done1:=TRUE; end; end; procedure doname; var i:integer; s1,s2:astr; sfo:boolean; sr:smalrec; begin if (systat.allowalias) then begin print('Enter your handle, or your first & last'); print('name if you don''t want to use one.') end else print('Enter your first & last name. Handles are NOT ALLOWED!'); prt(':'); input(s,36); done1:=TRUE; nl; if ((not (s[1] in ['A'..'Z','?'])) or (s='')) then done1:=FALSE; sfo:=(filerec(sf).mode<>fmclosed); if (not sfo) then reset(sf); for i:=1 to filesize(sf)-1 do begin seek(sf,i); read(sf,sr); if (sr.name=s) then begin done1:=FALSE; sprint(#3#7+'That name is already being used.'); end; end; if (not sfo) then close(sf); assign(fi,systat.afilepath+'trashcan.txt'); {$I-} reset(fi); {$I+} if (ioresult=0) then begin s2:=' '+s+' '; while not eof(fi) do begin readln(fi,s1); if s1[length(s1)]=#1 then s1[length(s1)]:=' ' else s1:=s1+' '; s1:=' '+s1; for i:=1 to length(s1) do s1[i]:=upcase(s1[i]); if pos(s1,s2)<>0 then begin sprint(#3#7+'"'+copy(s1,pos(s1,s2),length(s1))+'" may not be used!'); done1:=FALSE; end; end; close(fi); end; if (not done1) and (not hangup) then begin sprint(#3#7+^G'Sorry, can''t use that name.'); inc(try); sl1('Unacceptable name : '+s); end; if (try>=3) then hangup:=TRUE; if (done1) then user.name:=s; if ((done) and (how=1) and (not systat.allowalias)) then user.realname:=caps(s); end; procedure dophone; begin case how of 2:findarea; 3:callfromarea:=1; end; if (how=3) then print('Enter new VOICE phone number:') else print('Enter your VOICE phone number:'); if (((how=1) and (callfromarea=3)) or (how=3)) then begin prt(':'); input(s,12); if (length(s)>5) then begin user.ph:=s; done1:=TRUE; end; end else begin print(' ###-###-####.'); prt(':'); input(s,12); if (length(s)=12) and (s[4]='-') and (s[8]='-') then begin user.ph:=s; done1:=TRUE; end else if (how=1) then sprint(#3#7+'Please enter it correctly!'); end; end; procedure dopw; var s:astr; begin case how of 1:begin print('Enter a password that you will use to log on again.'); print('It must be between 4 and 20 characters in length.'); prt(':'); input(s,20); if (length(s)<4) then sprint(#3#7+'Must be at least 4 characters long.') else if (length(s)>20) then sprint(#3#7+'Must be less than 20 characters long.') else begin nl; sprint(#3#3+'Your password: '+#3#5+s); done1:=pynq('Is this correct? '); if (done1) then user.pw:=s; end; end; 2:begin sprint(#3#5+'For security reasons, when changing passwords'); sprint(#3#5+'you must first enter your old password.'); nl; sprompt(#3#0+'User password : '+#3#5); input(s,20); if (s<>user.pw) then sprint(^G+#3#7+'>> INCORRECT PASSWORD <<') else begin nl; print('Your new password must be 4-20 chrs in length.'); nl; repeat prt('New password: '); mpl(20); input(s,20); nl; until (((length(s)>=4) and (length(s)<=20)) or (s='') or (hangup)); if (s<>'') then begin nl; nl; sprint(#3#3+'New Password: "'+#3#5+s+#3#3+'"'); if pynq('Are you SURE this is what you want? ') then begin if (not hangup) then user.pw:=s; sysoplog('Changed password.'); done1:=TRUE; end else print('Aborted.'); end else print('Aborted.'); end; nl; end; 3:begin print('Enter new password.'); prt(':'); input(s,20); if (s<>'') then begin done1:=TRUE; user.pw:=s; end; end; end; end; procedure dorealname; var i:integer; begin if ((how=1) and (not systat.allowalias)) then begin user.realname:=caps(user.name); done1:=TRUE; exit; end; if (how=3) then print('Enter new REAL first & last name, or') else print('Enter your REAL first & last name, or'); print('enter "=" if same as your user name.'); prt(':'); if (how=3) then inputl(s,36) else inputcaps(s,36); if (s='=') then s:=caps(user.name); while copy(s,1,1)=' ' do s:=copy(s,2,length(s)-1); while copy(s,length(s),1)=' ' do s:=copy(s,1,length(s)-1); if (pos(' ',s)=0) and (how<>3) then begin print('Enter it correctly! First AND last name please!'); s:=''; end; if (s<>'') then begin user.realname:=s; done1:=TRUE; end; end; procedure doscreen; var v:string; bb:byte; begin if (how=1) then begin user.linelen:=systat.linelen; user.pagelen:=systat.pagelen; end; prt('How many columns wide is your screen (32-132) ['+ cstr(thisuser.linelen)+'] : '); ini(bb); if (not badini) then user.linelen:=bb; prt('Number of lines per page (4-50) ['+cstr(thisuser.pagelen)+'] : '); ini(bb); if (not badini) then user.pagelen:=bb; if (user.pagelen>50) then user.pagelen:=50; if (user.pagelen<4) then user.pagelen:=4; if (user.linelen>132) then user.linelen:=132; done1:=TRUE; end; procedure dosex; var c:char; begin if (how=3) then begin prt('New sex (M,F) : '); onek(c,'MF '^M); if (c in ['M','F']) then user.sex:=c; end else begin user.sex:=#0; repeat prt('Your sex (M,F) ? '); onek(user.sex,'MF'^M); if (user.sex=^M) then begin nl; sprint(#3#7+'Don''t know your own sex, eh? Better see a doctor!'); nl; end; until ((user.sex in ['M','F']) or (hangup)); end; done1:=TRUE; end; procedure dowherebbs; begin if (how=3) then print('Enter new BBS reference.') else begin print('Where did you hear about this BBS from? (be specific;'); print('do not say, for example, "some guy on another board")'); end; prt(':'); if (how=3) then inputl(s,40) else inputcaps(s,40); if (s<>'') then begin user.wherebbs:=s; done1:=TRUE; end; end; procedure dozipcode; begin case how of 2:findarea; 3:callfromarea:=1; end; case callfromarea of 1:begin if (how=3) then print('Enter new postal code (##### or #####-####)') else begin print('Enter your zipcode (9 digit if available)'); print(' ##### or #####-####'); end; prt(':'); input(s,10); if (length(s) in [5,10]) then begin user.zipcode:=s; done1:=TRUE; end; end; 2:begin print('Enter your zipcode (@#@#@# format -- "@"=letter "#"=number)'); prt(':'); input(s,6); if ((length(s)=6) and (s[1] in ['A'..'Z']) and (s[2] in ['0'..'9']) and (s[3] in ['A'..'Z']) and (s[4] in ['0'..'9']) and (s[5] in ['A'..'Z']) and (s[6] in ['0'..'9'])) then done1:=TRUE else print('Illegal format!'); end; 3:begin print('Enter your postal code:'); prt(':'); input(s,10); if (length(s)>2) then begin user.zipcode:=s; done1:=TRUE; end; end; end; end; procedure forwardmail; var u:userrec; s:astr; i:integer; b,ufo:boolean; begin nl; print('If you forward your mail, all mail'); print('addressed to you will go to that person'); print('Now enter the user''s number, or just'); print('hit to deactivate mail forwarding.'); prt(':'); input(s,4); i:=value(s); nl; if (i=0) then begin user.forusr:=0; print('Forwarding deactivated.'); end else begin ufo:=(filerec(uf).mode<>fmclosed); if (not ufo) then reset(uf); b:=TRUE; if (i>=filesize(uf)) then b:=FALSE else begin seek(uf,i); read(uf,u); if (u.deleted) or (nomail in u.ac) then b:=FALSE; end; if (i=usernum) then b:=FALSE; if (b) then begin user.forusr:=i; print('Forwarding set to: '+caps(u.name)+' #'+cstr(i)); sysoplog('Started forwarding mail to '+caps(u.name)+' #'+cstr(i)); end else print('Sorry, can''t forward to that user.'); if (not ufo) then close(uf); end; end; procedure mailbox; begin if (nomail in user.ac) then begin user.ac:=user.ac-[nomail]; sprint(#3#5+'Mailbox now open.'); sysoplog('Opened mailbox.'); end else if (user.forusr<>0) then begin user.forusr:=0; print('Mail no longer forwarded.'); sysoplog('Stopped forwarding mail.'); end else begin if pynq('Do you want to close your mailbox? ') then begin user.ac:=user.ac+[nomail]; sprint(#3#5+'Mailbox now closed.'); sprint(#3#5+'You >CAN NOT< recieve mail now.'); sysoplog('Closed mailbox.'); end else if pynq('Do you want your mail forwarded? ') then forwardmail; end; done1:=TRUE; end; procedure tog_ansi; var c:char; begin prompt('Which emulation? (1) TTY (none), (2) ANSI, (3) AVATAR : '); cl(3); onek(c,'123'); user.ac:=user.ac-[ansi]; user.ac:=user.ac-[avatar]; case c of '2':user.ac:=user.ac+[ansi]; '3':user.ac:=user.ac+[avatar]; end; (* if (ansi in user.ac) then begin user.ac:=user.ac-[ansi]; print('ANSI disabled.'); end else begin user.ac:=user.ac+[ansi]; print('ANSI activated.'); end; *) done1:=TRUE; end; procedure tog_color; begin if (color in user.ac) then begin user.ac:=user.ac-[color]; print('ANSI color disabled.'); end else begin user.ac:=user.ac+[color]; print('ANSI color activated.'); end; done1:=TRUE; end; procedure tog_pause; begin if (pause in user.ac) then begin user.ac:=user.ac-[pause]; print('No pause on screen.'); end else begin user.ac:=user.ac+[pause]; print('Pause on screen active.'); end; done1:=TRUE; end; procedure tog_input; begin if (onekey in user.ac) then begin user.ac:=user.ac-[onekey]; print('Full line input.'); end else begin user.ac:=user.ac+[onekey]; print('One key input.'); end; done1:=TRUE; end; procedure tog_clsmsg; begin if (user.clsmsg=1) then begin user.clsmsg:=2; print('Clear screen for messages OFF.'); end else begin user.clsmsg:=1; print('Clear screen for messages ON.'); end; done1:=TRUE; end; procedure tog_avadj; begin if (user.avadjust=2) then begin user.avadjust:=1; print('AVATAR color adjustment disabled.'); end else begin user.avadjust:=2; print('AVATAR color adjustment enabled.'); end; done1:=TRUE; end; procedure tog_expert; begin if (novice in user.ac) then begin user.ac:=user.ac-[novice]; chelplevel:=1; print('Expert mode ON.'); end else begin user.ac:=user.ac+[novice]; chelplevel:=2; print('Expert mode OFF.'); end; done1:=TRUE; end; procedure chcolors; var s:astr; c,c1,c2:integer; ch:char; mcol,ocol:byte; ctyp,done:boolean; function colo(n:integer):astr; begin case n of 0:colo:='Black'; 1:colo:='Blue'; 2:colo:='Green'; 3:colo:='Cyan'; 4:colo:='Red'; 5:colo:='Magenta'; 6:colo:='Yellow'; 7:colo:='White'; end; end; function dt(n:integer):astr; var s:astr; begin s:=colo(n and 7)+' on '+colo((n shr 4) and 7); if (n and 8)<>0 then s:=s+', High Intensity'; if (n and 128)<>0 then s:=s+', Blinking'; dt:=s; end; function stf(n:integer):astr; var s:astr; begin case n of 0:s:='Other'; 1:s:='Default'; 2:s:='Unused'; 3:s:='Yes/No'; 4:s:='Prompts'; 5:s:='Note'; 6:s:='Input line'; 7:s:='Y/N question'; 8:s:='Blinking'; 9:s:='Other'; end; stf:=cstr(n)+'. '+mln(s,20); end; procedure liststf; var c:integer; begin nl; for c:=0 to 9 do begin setc(7); prompt(stf(c)); setc(user.cols[ctyp][c]); print(dt(user.cols[ctyp][c])); end; end; begin ctyp:=color in user.ac; setc(7); if (ctyp) then print('Set multiple colors.') else print('Set B&W colors.'); ch:='?'; done:=FALSE; repeat case ch of 'Q':done:=TRUE; 'L':liststf; '0'..'9':begin nl; setc(7); print('Current:'); nl; c1:=value(ch); setc(7); prompt(stf(c1)); setc(user.cols[ctyp][c1]); print(dt(user.cols[ctyp,c1])); nl; setc(7); print('Colors:'); nl; for c:=0 to 7 do begin setc(7); prompt(cstr(c)+'. '); setc(c); prompt(mln(colo(c),12)); setc(7); prompt(mrn(cstr(c+8),2)+'. '); setc(c+8); print(mln(colo(c)+'!',9)); end; ocol:=user.cols[ctyp][c1]; nl; prt('Foreground: '); input(s,2); if (s='') then mcol:=ocol and 7 else mcol:=value(s); prt('Background: '); input(s,2); if (s='') then mcol:=mcol or (ocol and 112) else mcol:=mcol or (value(s) shl 4); if pynq('Blinking? ') then mcol:=mcol or 128; nl; setc(7); prompt(stf(c1)); setc(mcol); print(dt(mcol)); nl; if pynq('Is this correct? ') then user.cols[ctyp][c1]:=mcol; end; end; if (not done) then begin nl; prt('Colors: (0-9) (L)ist (Q)uit :'); onek(ch,'QL0123456789'); end; until done or hangup; done1:=TRUE; end; procedure checkwantpause; begin if pynq('Should screen pausing be active? ') then user.ac:=user.ac+[pause] else user.ac:=user.ac-[pause]; done1:=TRUE; end; procedure ww(www:integer); begin nl; case www of 1:doaddress; 2:doage; 3:doansi; 4:docitystate; 5:docomputer; 6:dojob; 7:doname; 8:dophone; 9:dopw; 10:dorealname; 11:doscreen; 12:dosex; 13:dowherebbs; 14:dozipcode; 15:mailbox; 16:tog_ansi; 17:tog_color; 18:tog_pause; 19:tog_input; 20:tog_clsmsg; 21:chcolors; 22:tog_expert; 23:findarea; 24:checkwantpause; 25:tog_avadj; end; end; begin try:=0; done1:=FALSE; case how of 1:repeat ww(which) until (done1) or (hangup); 2,3:begin ww(which); if not done1 then print('Function aborted!'); end; end; end; end.