LBSOS KRNLI/O ERRORFILE 'SOS.KERNEL' NOT FOUNDINVALID KERNEL FILExةw,@  4  J  ȱ⩤i8#) ) 8LeO^A t2*CLEAN.TEXT t2H&,USRUTIL.TEXT)Pt2ڶ%*PROG.NOTES$HDt2&#DISKNAME.DAT 99III.TEL.09DE.2u' ,INFONET.TEXT%Ht0ٶ)MAIL.TEXT-0t0ٶ -COMMENTS.TEXTF'Lt1ڶ)UTIL.TEXTm t1ڶ+BRICKS.TEXTx!@t1ڶ)CHAT.TEXTm#im#iЛ#Lȱ  6L憦  Lsmm l y` @8(Je稽 ʈ  !"#$%&'()*+er; isexpert,oncethrough,up,lf:boolean; nulls:integer; opname,mpass:string[16]; ufile:file of user; logfile:text; okcmds:set of char; rs232:interactive; fname,cmdstr:string; abort:bool Parent:Points to unused records in the file} lstring=string[255]; str255=lstring; var cfile:file of crecord; ch:char; num,usernum:integer; buf:packed array[0..16383] of char; userrec,oprec:us usernum,parent,child:integer; fileblock:alloc; end; {Record zero usage: (Usernum:Points to the root of the Library system Child:Contains the total number of records in the index file ; blocktype=packed array[0..511] of char; cstring=string[20]; crecord=packed record name:string[40]; username:string[16]; date:cstring; restrict,reply:boolean; ,used,link:integer; canop,canmail,canclass,cantopic,canadd, isexpert,canlist,canrestrict,oponly,candelete:boolean; nulls:0..30; lf,up:boolean; end; alloc=string[16] nocarr='NO CARRIER'; okresp='OK'; ringresp='RING'; type user=packed record username,password:string[16]; name:string[40]; phone:string[20]; isnet:boolean; mailalc usrutil_prog='.profile/infonet.stuff/USRUTIL'; (data_prefix='.profile/infonet'; blank=' '; con300='CONNECT'; con1200='CONNECT 1200'; (con2400='CONNECT 2400'; LOGFILE'; hello_in='.profile/infonet.stuff/LOGIN'; hello_hello='.profile/infonet.stuff/HELLO'; hello_off='.profile/infonet.stuff/LOGOFF'; (new_add_file='.profile/infonet.stuff/new.adds'; arm'; (sysop_name='BOB DEHART';{all CAPS for email use} (voice_num='(703) 687-6485';{to contact sysop via voice} (userfile='.profile/infonet.stuff/USERS.DATA'; idxfile='.profile/infonet.stuff/INDEX.DATA'; logname='.profile/infonet.stuff/Company. } { This version was further enhanced and customized by Ed } { Gooding to support his ///'s Company bbs. } {$list+} {$setc chat:=true} uses applestuff,chainstuff; {$i-} {$v-} {$r-} const bbs_name='Glenwood F{ This program is an adaptation of the version of Infonet } { written and released to the public domain by Harold Stuart } { of Sun Remarketing. It was subsequently restructured and } { greatly enhanced by Walt Pawley of Wump Research & ean; opnum,editlen:integer; isalias:boolean; channel:integer; rsdcb:packed array[0..50] of 0..255; rssize:array[0..3] of integer; x:integer; s:string; (intime:string; (outtime:string; (uname:string; dontdo:boolean; pos:integer; carrierx:boolean; sysopisin:boolean; looksee:boolean; opnote:string[80]; userbaud:integer; procedure callit; forward; procedure clear((userrec.password<>'') or (usernum=0)) and ((usernum=0) or (userrec.password<>pass))); if channel=7 then #begin %writeln('System now in use by ',uname); %out(chr(23)); #end; getclock(s); intime:=s; up:=userrec.up; lf:=userrec.lf; isd; upcase(pass); if ((userrec.password<>'') or (usernum=0)) and ((usernum=0) or (userrec.password<>pass)) then begin dolog(concat('Bad login: ',uname,' ',pass)); strout('Invalid Username or Password.'); end; until not ( out(chr(0)); prompt('Username: '); linein(uname,true); upcase(uname); until uname<>''; usernum:=find(uname); userrec:=ufile^; if (userrec.password<>'') or (usernum=0) then begin prompt('Password: '); linein(pass,false); enewpass } begin { login } printblock(hello_in); outcr; outcr; logpass:=0; repeat repeat logpass:=logpass+1; if logpass>4 then begin strout(concat('Please call the SYSOP at ',voice_num,' (voice).')); exit(callit); end; e); upcase(p2); if length(p2)>16 then p2:=copy(p2,1,16); if p1<>p2 then strout('Password mis-match.'); until p1=p2; sgufile(usernum); ufile^.password:=p1; userrec.password:=p1; put(ufile); dolog(concat(' changed password to ',p1)); end; { getng; begin outcr; strout('You do not have a password.'); repeat repeat prompt('Enter new password: '); linein(p1,false); until p1<>''; if length(p1)>16 then p1:=copy(p1,1,16); upcase(p1); prompt('Re-enter new password: '); linein(p2,fals {$include .profile/infonet.stuff/clean} {$page}  {$include .profile/infonet.stuff/chat} {$page}  {$include .profile/infonet.stuff/bricks} {$page} procedure login; var pass:string; logpass:integer; procedure getnewpass; var p1,p2:strinward; function val(s:string):integer; forward;  {$page} {$include .profile/infonet.stuff/mail} {$page}  {$include .profile/infonet.stuff/comments} {$page}  {$include .profile/infonet.stuff/util} {$page} n):integer; forward; function getYN:boolean; forward; function inp:char; forward; function inpYN:boolean; forward; function outputlevel:integer; forward; function upch(ch:char):char; for:integer; forward; function carrier:boolean; forward; function checkkey:boolean; forward; function find(s:string):integer; forward; function filefree:integer; forward; function getchoice(numok:booleaprocedure spcfile(rec:integer); forward; procedure sgufile(rec:integer); forward; procedure spufile(rec:integer); forward; procedure strout(s:lstring); forward; procedure upcase(var s:string); forward; function buflevorward; procedure printblock(list:lstring); forward; procedure prompt(s:lstring); forward; procedure setbaud(rate:integer); forward; procedure setblock(var list:lstring); forward; procedure sgcfile(rec:integer); forward; tring); forward; procedure goedit; forward; procedure linein(var s:string;b:boolean);forward; procedure makeokcmds; forward; procedure out(ch:char); forward; procedure outcr; f(list:lstring); forward; procedure delay(amount:integer); forward; procedure delayout(amount:integer;s:string);forward; procedure dolog(e:str255); forward; procedure edit; forward; procedure getclock(var s:sexpert:=userrec.isexpert; nulls:=userrec.nulls; if userrec.password='NOPASSWORD' then getnewpass; if sysopisin then "begin #outcr; #strout(' The SYSOP is in. '); #end; if userrec.link<>0 then begin sgcfile(userrec.link); outcr; if not cfile^.reply then strout(' You have new mail waiting!'); end; if userrec.mailalc<=userrec.used then begin outcr; outcr; strout(' Your mail allocation is used up!'); strout(' You must delete file^.parent; sgcfile(0); filefree:=cfile^.parent; cfile^.parent:=t; spcfile(0); end else begin cfile^.child:=cfile^.child+1; filefree:=cfile^.child; spcfile(0); end; end; { filefree } procedure clear; var f:file; begin GRAM STOPPED.'); exit(program); end; num:=ufile^.link; opname:=ufile^.username; mpass:=ufile^.password; end; { initfile } function filefree; var t:integer; begin sgcfile(0); if cfile^.parent<>0 then begin sgcfile(cfile^.parent); t:=c close(logfile,purge); rewrite(logfile,logname); writeln(logfile); end; end; procedure initfile; var z:integer; begin reset(ufile,userfile); z:=ioresult; if z<>0 then begin writeln('Error ',z,' opening '); writeln('PROhen writeln(f,instr) else strout(instr); readln(logfile,instr); end; close(f,lock); end; { printlog } procedure deletelog; var ch:char; begin prompt('Are you sure you want to delete the Log File? -> '); if inpYN then begin t<>0 then begin strout('Error opening that file.'); exit(printlog); end else tofile:=true; end; close(logfile,lock); reset(logfile,logname); readln(logfile,instr); while (not eof(logfile)) and (buflev=0) do begin if tofile ting; ch:char; x,y:integer; instr:str255; begin prompt('Want to send it to a file? -> '); tofile:=false; if inpYN then begin prompt('Ok, then enter the file''s pathname -> '); linein(s,true); rewrite(f,s); if ioresul 'B':s:=hello_hello; 'C':s:=hello_off; 'Q':exit(dohello); end; abort:=false; edit; if abort then exit(dohello); setblock(s); end; end; { dohello } procedure printlog; var f:text; tofile:boolean; old,s:strpYN then begin outcr; strout('Is this the file which prints at:'); prompt('A-Connect, B-Login, C-Logoff (Q-Quit)-> '); repeat ch:=upch(inp) until ch in ['A'..'C','Q']; out(ch); outcr; case ch of 'A':s:=hello_in; enu } if not oncethrough then writecmds; outcr; prompt('Command'); x:=getchoice(false); end; { menu } procedure dohello; var ch:char; s:string; begin ch:=' '; outcr; prompt('Do you want to make a new "Greeting" file? (Y/N) -> '); if inth the Sysop'); {$endc} if 'P' in okcmds then strout('P: [P]hone - Activate your modem'); #strout('S: [S]tyle - Change your personal System Parameters'); #strout(concat('L: [L]og - off ',bbs_name)); #oncethrough:=true; end; { writecmds } begin { m strout('H: [H]ello - Make "Hello" Files (Connect, Login, & Logoff)'); strout('X: e[X]amine - Print/Display who''s called lately'); strout('D: [D]elete - the Log File'); end; {$ifc chat} if 'T' in okcmds then strout('T: [T]alk - "chat" wiout('M: [M]ail - Use the Electronic Mail facility'); if 'B' in okcmds then begin #strout('B: [B]rowse - through the Library''s files'); strout('I: [I]ndex - List the Library''s Table of Contents'); end; if 'H' in okcmds then begin gin } procedure menu; var x:integer; procedure writecmds; begin outcr; strout(concat(' ',bbs_name,' Main Menu commands:')); outcr; if 'N' in okcmds then strout('N: Display [N]ewly Added and Changed Files'); if 'M' in okcmds then #strsome old mail before'); strout(' you can receive any more new mail.'); writeln('This user''s mail allocation has been EXHAUSTED!'); #dolog(' mail box is full!!'); end; outcr; printblock(hello_hello); outcr; outcr; isalias:=false; end; { loreset(f,list); close(f,purge); dolog(concat(' deleted file: ',list)); end; procedure makecmds; var x:integer; begin cmdstr:='N,'; with userrec do begin if canmail then cmdstr:=concat(cmdstr,'M,'); if canclass then cmdstr:=concat(cmdstr,'B,I,'); if canop then cmdstr:=concat(cmdstr,'H,X,D,'); {$ifc chat} if channel<>2 then cmdstr:=concat(cmdstr,'T,'); {$endc} if channel=2 then cmdstr:=concat(cmdstr,'P,'); cmdstr:=concat(cmdstr,'S,L'); outcr; outcr; delayout(100,'Hello'); %exit(wait); end; end; exit(callit); end; { wait } procedure callit; begin if channel=7 then wait else looksee:=false; up:=true; lf:=true; login; dolog(concat('Login: ',userrec.username)); on2400) then begin carrierx:=true; if s=con2400 then userbaud:=2400; %if s=con1200 then userbaud:=1200; %if s=con300 then userbaud:=300; setbaud(userbaud); dolog('Connect'); getclock(s); write(chr(7),s,' Connect. '); writeln(concat(bbs_name,' is now waiting for phone calls')); repeat if not getresp(60,s) then initmodem; until s=ringresp; delayout(10,'ATA'); while getresp(60,s) do begin if s=nocarr then exit(callit); if (s=con300) or (s=con1200) or (s=conr x:=0 to 3 do rssize[x]:=0; end; procedure wait; var s:string[40]; ch:char; x,y:integer; begin close(cfile,lock); close(ufile,lock); reset(cfile,idxfile); reset(ufile,userfile); initmodem; writeln; g; until s=okresp; end; procedure getchannel; var x:integer; begin "channel:=7; {write('Want to activate your modem? -> ');} {if getYN then channel:=7 else channel:=2;} rsdcb[0]:=15; fonse codes from modem} #flag:=getresp(4,s); {wait for "OK" from modem} if not flag then begin write(chr(7)); { beep to get human to the modem } delayout(10,'ATZ'); %flag:=getresp(4,s); delayout(10,'ATX1'); end; until fla flag:boolean; begin repeat repeat setbaud(userbaud); delay(30); writeln(rs232); writeln(rs232); delayout(10,'+++'); #flag:=getresp(4,s); delayout(10,'ATZ'); flag:=getresp(4,s); #delayout(10,'ATX1'); {select extended respo#else if rate=1200 then rsdcb[1]:=8 %else rsdcb[1]:=10; unitstatus(7,rsdcb,6); end; procedure initmodem; { Assumes Hayes command set. I had trouble getting my Hayes modem to } { hang up on occasion. Good luck. Wump } var s:string[40]; rewrite(cfile,idxfile); with cfile^ do begin usernum:=0; parent:=0; child:=0; end; put(cfile); close(cfile,lock); reset(cfile,idxfile); end; procedure setbaud; begin rsdcb[0]:=15; unitstatus(7,rsdcb,4); if rate=300 then rsdcb[1]:=6  {put modem back into command mode} #flag:=getresp(4,s); {wait for "OK" from modem} #delayout (10,'ATH'); {hang the modem up} end else begin close(logfile,lock); exit(program); end; end; procedure allocfile; begin prompt(uname); prompt(' logged in: '); prompt(intime); prompt(', logged off: '); prompt(outtime); outcr; outcr; printblock(hello_off); if channel=7 then begin #repeat until outputlevel = 0; {wait until all chars are sent} #delayout (1000,'+++');.'Z'] then begin if length(s)>12 then s:=''; s1[1]:=ch; s:=concat(s,s1); end; until (ch=chr(10)) and (s<>''); getresp:=true; end; procedure logout; var s:string[40]; )flag:boolean; begin outcr; getclock(s); outtime:=s; begin unitclear(1); close(logfile,lock); exit(program); end; x:=x+1; if x>180 then begin x:=0; y:=y+1; if y>=timeout then exit(getresp); end; end; unitread(channel,ch,1,,12); if ch in [' '. end; makeokcmds; end; { makecmds } function getresp(timeout:integer;var s:string):boolean; var x,y:integer; s1:string[1]; begin s:=''; s1:=' '; getresp:=false; repeat x:=0; y:=0; while buflev=0 do begin if checkkey then cethrough:=isexpert; repeat makecmds; "oncethrough:=isexpert; menu; case ch of #'N':begin (printblock(new_add_file); (dolog(' Viewed the New Adds/Changes File'); 'end; 'M':mail; 'B':comments; 'H':dohello; 'X':printlog; 'D':deletelog; 'I':printcontents; 'P':if channel=2 then begin channel:=7; ch:='L'; end; 'S':util; {$ifc chat} 'T':chat; {$endc} #'?':oncethrough:=false; end; until ch='L'; logout; end; { callit } procedure dolog; var x:inte procedure mail; var oncethrough:boolean; choice:integer; procedure dosend; var x,y,usr:integer; clock,subj,touser,inpstring,saveusers,logmsg:string; tmp:user; {working copy of user record} (list:alloc; {16 byte st,./0123456789:;<=>?@ABCDO^*; end else begin writeln; write('Want to exit the bbs program?'); if getYN then exit(program); write(' Want to put the bbs online?'); if getYN then channel:=7 end; until false; end. if ioresult=10 then allocfile; initfile; ch:=' '; repeat carrierx:=false; callit; {init. modem, wait for a call} if channel=7 then begin userbaud:=2400; carrierx:=false; dolog('Disconnected'); if random<=1638 then cleanup reset(rs232,'.rs232'); if ioresult<>0 then begin writeln(chr(7),'No RS-232 driver in system.'); writeln('Program stopped.'); exit(program); end; setchain(usrutil_prog); setuplog; nulls:=0; getchannel; randomize; reset(cfile,idxfile); e) or (x>500); if x>500 then newlog; writeln('Done.'); end; end; { setuplog } begin writeln(chr(28),chr(5),' ',bbs_name,' BBS'); writeln; userbaud:=2400; sysopisin:=false; looksee:=false; opnote:=''; (logfile,logname); readln(logfile,s); end; begin { setuplog } reset(logfile,logname); if ioresult<>0 then newlog else begin x:=0; write('Seeking the end of the Log File...'); repeat x:=x+1; readln(logfile,s); write('.'); until eof(logfilger; s:string; begin getclock(s); writeln(logfile,s,' ',e); end; procedure setuplog; var s:str255; x:integer; procedure newlog; begin close(logfile,purge); rewrite(logfile,logname); writeln(logfile); close(logfile,lock); resetring} ctemp:crecord; {working copy of library record} checkmulti,badtouser:boolean; (t:integer; procedure extract; {separate user names when more than 1 entered in To:} var x:integer; begin x:=1; {$r-} while (x<=length(inpstring)) and (inpstring[x]<>',') do x:=x+1; touser:=copy(inpstring,1,x-1); {extract single user from list} delete(inpstring,1,x-1); {delete that user from list} if (inpstring<>'') and (inpstring[1]=',') then delete(inpstring,1,1); while strout('There aren''t that many letters in the list') else begin if x<>0 then begin outcr; prompt('Message from '); prompt(cfile^.username); %prompt(' on '); %strout(cfile^.date); prompt('Subject: '); prompt(cfile^.nad -> '); linein(s,true); x:=val(s); end else x:=sel; pnt:=0; lnk:=userrec.link; if x<>0 then while (pnt0) do begin sgcfile(lnk); pnt:=pnt+1; if pnt<>x then lnk:=cfile^.parent; end; if lnk=0 then ); &end; end; until inpstring=''; sgufile(usernum); userrec:=ufile^; end; { dosend } procedure doread(sel:integer); var x,pnt,lnk:integer; s:string; begin if sel=0 then begin prompt('Enter the number of the mail that you want to remp.name:=subj; {move in subject name again - getting trashed} 'cfile^:=ctemp; 'put(cfile); 'seek(ufile,usr); 'ufile^:=tmp; 'put(ufile); 'prompt('Message was sent to '); 'strout(touser); 'logmsg:=concat(' sent mail to ',touser); 'dolog(logmsg'list:=concat('%',s); {replace .profile/infonet/ with % before saving} 'ctemp.fileblock:=list; {save and record note name} 'x:=filefree; {get new record space} 'ctemp.child:=0; 'ctemp.parent:=tmp.link; 'tmp.link:=x; 'seek(cfile,x); 'cte$if tmp.mail_alc=tmp.used %then strout('Not enough room in user''s file to hold message.') %else &begin 'list:=''; {reset list to force generation of new filename} 'setblock(list); {go write the new note} {force sysop name} if touser='SYSOP' then touser:=sysop_name; {force sysop name} usr:=find(touser); if usr=0 "then #begin $prompt('User ');prompt(touser);prompt(': ');strout('not found.'); #end "else #begin $sgufile(usr); $tmp:=ufile^; t('No message sent'); exit(dosend); end; repeat extract; t:=t+1; if checkmulti and (t>1) then begin strout('Dump allowed to one user only.'); exit(dosend); end; if touser='' then exit(dosend); if touser='OPERATOR' then touser:=sysop_name;prompt('Subject: '); linein(subj,true); if length(subj)>40 then subj:=copy(subj,1,40); ctemp.name:=subj; getclock(clock); ctemp.date:=clock; abort:=false; s:=''; { create a new file name } edit; checkmulti:=dontdo; if abort then begin outcr; stroubadtouser:=false; {reset switch that indicates invalid sendee name} $checkusers; {validate user names prior to entering mail} $if badtouser=true then exit(dosend); $inpstring:=saveusers; {restore list of users for sending mail} #end; rrec.oponly "then inpstring:=sysop_name {Force sysop name} "else #begin $prompt('To: '); $linein(inpstring,true); $if inpstring='' then exit(dosend); $upcase(inpstring); $saveusers:=inpstring; {save copy of users cause extract wipes them out} $the [U]ser List function to verify it.'); &outcr; &badtouser:=true; {set switch to exit dosend routine} %end; #end; until inpstring=''; end; {checkusers} begin { dosend } t:=0; outcr; ctemp.username:=userrec.username; ctemp.reply:=false; if use$usr:=find(touser); {try to find user name in registered user file} $if usr=0 then %begin &outcr; &prompt('User ');prompt(touser);strout(' is not registered here.'); &strout(' Please check your spelling of the user''s name,'); &strout(' or choose (inpstring[1]=' ') and (inpstring<>'') do delete(inpstring,1,1); end; procedure checkusers; {validate user names prior to entering mail} begin repeat "extract; {separate user names when more than one has been entered} "if touser <> '' then #begin ame); %if userrec.canop &then 'begin (prompt(' File <'); (prompt(cfile^.fileblock); (strout('> '); 'end &else (outcr; printblock(cfile^.fileblock); %dolog(concat(' Read mail from ',cfile^.username)); %dolog(concat(' sent on ',cfile^.date)); %dolog(concat(' regarding ',cfile^.name)); cfile^.reply:=true; spcfile(lnk); end; end; end; { doread } procedure doreadall; var lnk:integer; begin outcr; lnk:=userrec.link; while lnk<>0 do begin sgcfile(lnk); out if ioresult<>0 then strout('Error opening file') else begin reset(f1,cfile^.fileblock); if ioresult<>0 then strout('Error opening mail file') else begin x:=1; while x<>0 do ut('There aren''t that many letters in the list') else begin prompt('Enter destination name -> '); linein(s,true); if s='' then strout('No letter filed') else begin rewrite(f,s); you want to file? '); linein(s,true); num:=val(s); if num<>0 then begin pnt:=userrec.link; x:=1; sgcfile(pnt); while (x0) do begin pnt:=cfile^.parent; x:=x+1; sgcfile(pnt); end; if pnt=0 then stroinp; 'if ch = chr(3) then exit(dolist); end; #end; "end; end; { dolist } procedure dofile; var pnt,num,x:integer; s:string; f,f1:file; b:packed array[0..511] of 0..255; begin pnt:=userrec.link; prompt('Which letter do s:=ufile^.username; if length(s)<16 then s:=copy(concat(s,blank),1,16); prompt(s); prompt(' '); strout(ufile^.name); if buflev<>0 then begin %ch:=inp; %if ch=chr(3) then exit(dolist) %else begin 'while buflev = 0 do {nothing}; 'ch:= userrec.used:=0; userrec.link:=0; end else strout('No mail deleted'); end; { dokill } procedure dolist; var max,x:integer; s:string[255]; begin outcr; sgufile(0); max:=ufile^.link; for x:=1 to max do begin get(ufile); le pnt<>0 do begin out('.'); sgcfile(pnt); clear(cfile^.fileblock); pnt:=cfile^.parent; end; strout('done'); #dolog(' purged their mailbox'); sgufile(usernum); ufile^.used:=0; ufile^.link:=0; spufile(usernum); outcr; strout('WARNING: If you kill ALL of your mail, you will not be able'); strout('to get any of it back.'); outcr; prompt('Are you sure you want to kill ALL of your mail? '); pnt:=userrec.link; if inpYN then begin prompt('Working'); whi spcfile(old); $dolog(concat(' Deleted mail from ',cfile^.username)); strout('Message deleted.'); end; end; seek(ufile,usernum); ufile^:=userrec; put(ufile); end; { dodelete } procedure dokill; var ch:char; pnt:integer; begin ; end; if pnt=0 then strout('There aren''t that many letters in the list') else begin sgcfile(pnt); userrec.used:=userrec.used-1; clear(cfile^.fileblock); y:=cfile^.parent; sgcfile(old); cfile^.parent:=y; errec.link:=pnt; seek(ufile,usernum); ufile^:=userrec; put(ufile); end else begin pnt:=userrec.link; y:=0; if x<>0 then while (y0) do begin old:=pnt; sgcfile(pnt); y:=y+1; pnt:=cfile^.parentegin prompt('Enter the number of the message that you want to delete -> '); linein(s,true); x:=val(s); if x<>0 then if x=1 then begin sgcfile(userrec.link); userrec.used:=userrec.used-1; clear(cfile^.fileblock); pnt:=cfile^.parent; us#dolog(concat(' sent on ',cfile^.date)); #dolog(concat(' regarding ',cfile^.name)); cfile^.reply:=true; spcfile(lnk); lnk:=cfile^.parent; end; end; { doreadall } procedure dodelete; var freeup,old,pnt,x,y:integer; s:string; bcr; prompt('Message from '); strout(cfile^.username); prompt('Subject: '); strout(cfile^.name); strout(cfile^.date); printblock(cfile^.fileblock); #dolog(concat(' Read mail from ',cfile^.username)); begin x:=blockread(f1,b,1); num:=blockwrite(f,b,x); end; end; end; end; end; end; close(f,lock); close(f1); end; { dofile } procedure makecmds; begin cmdstr:=''; if userrec.link<>0 then begin cmdstr:='R,A,D,K,I,'; if userrec.canop then cmdstr:=concat(cmdstr,'F,'); end; if userrec.can_list then cmdstr:=concat(cmdstr,'U,'); cmdstr:=concat(cmdstr,'S,Q,?'); makeokcmds; end; { makecmds } procedure writecmds; begin oEGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijk!! >> << .}0}0O^}D 'I':listmail; 'F':dofile; 'U':dolist; 'S':dosend; '?':oncethrough:=false; otherwise if ch<>'Q' then doread(choice) end; if ch<>'Q' then makecmds; until ch='Q'; end; { mail } ail } makecmds; if 'R' in okcmds then listmail; oncethrough:=isexpert; repeat if not oncethrough then writecmds; outcr; prompt('Mail'); choice:=getchoice(true); case ch of 'R':doread(0); 'A':doreadall; 'D':dodelete; 'K':dokill; if buflev<>0 then if inp=chr(3) then exit(listmail); old:=pntr; pntr:=cfile^.parent; if (old=pntr) and (pntr<>0) then begin cfile^.parent:=0; spcfile(pntr); pntr:=0; end; num:=num+1; end; end; { listmail } begin { m out(' '); prompt(cfile^.date); prompt(' '); if cfile^.reply then out(' ') else out('*'); out(' '); s:=cfile^.username; if length(s)<16 then s:=copy(concat(s,blank),1,16); prompt(s); out(' '); strout(cfile^.name); rocedure listmail; var old,pntr:integer; s:string; num:integer; begin outcr; pntr:=userrec.link; num:=1; while pntr<>0 do begin sgcfile(pntr); str(num,s); if length(s)<5 then s:=copy(concat(s,blank),1,5); prompt(s); y "then strout('S: [S]end a message to the Sysop') "else strout('S: [S]end a message to a registered user'); strout('Q: [Q]uit using Email and return to the Main Menu'); strout('?: Repeat these commands'); oncethrough:=isexpert; end; { writecmds } p strout('K: [K]ill (erase) ALL of your messages'); strout('I: List [I]ndex of all your messages'); end; if 'U' in okcmds then strout('U: List all registered [U]sers'); if 'F' in okcmds then strout('F: [F]ile some of your mail'); if userrec.op_onlutcr; strout('Mail menu commands:'); outcr; if 'R' in okcmds then begin strout('R: [R]ead a single message (or just key the number of it, instead)'); strout('A: Read [A]ll of your messages'); strout('D: [D]elete a single message'); procedure comments; var oncethrough,qhit:boolean; root,topicroot,subjectroot:integer; level:1..3; ctemp:crecord; all_gone,is_restrict,allow_reply:boolean; procedure doerror; begin strout('ERROR...Please contact the syoit } pointer:=0; temp:=root; while (temp<>0) and (pointer0) or userrec.can_add) then begin outcr; prompt('Do you want to read replies to this file? -> '); if inpYN then setrecurs; end; end; begin { d dolog(concat(' Viewed file: ',cfile^.name)); dolog(concat(' ',cfile^.fileblock)); s:=cfile^.fileblock; if length(s) in [1..16] then printblock(cfile^.fileblock); end; { printit } procedure setrecurs; var tmproot:integer; begin call_list(levelmpt(cfile^.name); $prompt(' File <'); $prompt(cfile^.fileblock); $strout('>'); #end "else #strout(cfile^.name); prompt('Created by: '); prompt(cfile^.username); prompt(' on: '); strout(cfile^.date); outcr; doselect(sel:integer); var x:integer; s:string; procedure doit; var temp,pointer:integer; procedure printit; var s:string[255]; begin outcr; prompt('Title: '); if userrec.canop {if sysop, then show SOS fileid} "then #begin $pro#if buflev<>0 then $begin &ch:=inp; (if (ch=chr(3)) then exit(prlist) *else ,begin .while buflev=0 do; {nothing until next keypress} .ch:=inp (end #end; num:=num+1; oldtemp:=temp; temp:=cfile^.parent; end; end; { prlist } procedure %begin &s:=cfile^.username; &if length(s)<>16 then s:=concat(s,copy(blank,1,16-length(s))); &if (cfile^.username = 'SYSOP') or (cfile^.username = sysop_name) (then outcr (else strout(s); %end; 6{while buflev<>0 do if inp=chr(3) then exit(prlist);} e^.child=0 then prompt(' ') else prompt(' *'); s:=cfile^.name; if length(s)<40 then s:=copy(concat(s,blank),1,40); out(' '); out(' '); #if (level = 1) or (level = 2) {don't display user-name for topics/subjects} $then outcr # else dr; outcr; outcr; temp:=root; num:=1; while temp<>0 do begin sgcfile(temp); str(num,s); if length(s)<>5 then s:=concat(s,copy(blank,1,5-length(s))); prompt(s); # {if level = 3 then prompt(cfile^.date);} if level <> 1 then $if cfilTopic Areas available:'); 2:strout('Subjects available: ("*" means that Replies are also present)'); 3:strout('Replies available:'); end; outcr; strout(' (CONTROL-C to abort list, any other key to pause/resume list)'); end; begin { prlist } prh root=Pointer to root of note level newroot=pointer to root of subject after exit} var temp,num,oldroot:integer; procedure prlist; var num,temp,oldtemp:integer; s:string; procedure prhdr; begin outcr; case level of 1:strout('.restrict:=inpYN; prompt('Allow replies? -> '); ctemp.reply:=inpYN; end; end; { getinfo } procedure call_list(level,root,source:integer;var newroot:integer); {Parameter explanation: Level=Topic, Subject, or Reply level ompt('-> '); linein(s,true); if length(s)>40 then s:=copy(s,1,40); if s='' then s:=''; ctemp.name:=s; ctemp.username:=userrec.username; getclock(s); ctemp.date:=s; if level=1 then begin prompt('Restrict note creation? -> '); ctempstem operator'); exit(comments); end; procedure getinfo(level:integer); var s:string; begin prompt('What is the name of this '); case level of 1:prompt('topic'); 2:prompt('subject'); 3:prompt('reply'); end; strout('? (40 char. limit)'); prif level<>1 then begin printit; if level=2 then begin subjectroot:=temp; { remember subject for dating Adds } chknxt; subjectroot:=0 end; end else begin topicroot:=temp; { remember top record for dating Adds } subjectroot:=0; { flag not at reply level } is_restrict:=cfile^.restrict; allow_reply:=cfile^.reply; outcr; prompt('Topic selected: '); strout(cfile^.name); ock; if length(s) in [1..16] then clear(cfile^.fileblock); end; sgcfile(t2); cfile^.parent:=t; spcfile(t2); end; end; end; end; { dodelete } procedure doprompt; var choice:integer; procedure makecmds; proceen''t that many files in the list.') else begin sgcfile(t1); if cfile^.child<>0 then strout('Delete all files and/or replies first!') else begin t:=cfile^.parent; if level<>1 then begin s:=cfile^.filebl strout('You must delete all files and/or replies first!'); end else begin t1:=root; t:=0; while (t0) do begin t2:=t1; sgcfile(t1); t1:=cfile^.parent; t:=t+1; end; if t1=0 then strout('There ar begin sgcfile(0); cfile^.usernum:=root; spcfile(0); end else begin sgcfile(source); cfile^.child:=root; spcfile(source); end; end else gcfile(root); if cfile^.child=0 then begin t:=cfile^.parent; if level<>1 then begin s:=cfile^.fileblock; if length(s) in [1..16] then clear(cfile^.fileblock); end; root:=t; if level=1 then } procedure dodelete; var t1,t2:integer; s:string[255]; x,y,t:integer; freespace:integer; begin prompt('Enter the Index number of the file to delete? -> '); linein(s,true); x:=val(s); if x>0 then if x=1 then begin s spcfile(source); end; seek(cfile,temp); cfile^:=ctemp; put(cfile); #dolog(concat(' Added file: ',cfile^.name)); #dolog(concat(' ',cfile^.fileblock)); "end; "str(topicroot,hold_topic); "str(subjectroot,hold_subject); end; { doadd el=3) and (subjectroot<>0) then { redundant for now } begin sgcfile(subjectroot); { also update subject last entry } cfile^.date:=s; spcfile(subjectroot) end; sgcfile(source); cfile^.child:=root; end; if level=1 then begin sgcfile(0); cfile^.usernum:=root; spcfile(0); end else begin sgcfile(topicroot); { update date of last entry } getclock(s); cfile^.date:=s; spcfile(topicroot); if (levconcat('%',list); {replace with %, instead} %ctemp.fileblock:=list; $end; if root=0 then begin ctemp.parent:=0; ctemp.child:=0; root:=temp; end else begin ctemp.parent:=root; ctemp.child:=0; root:=temp; s:string[255]; begin getinfo(level); abort:=false; list:=''; if level>1 then gettext(list); if not abort then begin temp:=filefree; if level>1 then $begin %delete(list,1,14); {remove .profile/infonet/ prefix from file name} %list:=var list:alloc); begin abort:=false; s:=list; { get filename as requested } edit; if abort then exit(gettext); list:=''; setblock(list); end; procedure doadd; var temp:integer; list:alloc; (hold_topic,hold_subject:string; level of 1:prompt('select'); 2,3:prompt('read'); end; prompt(' -> '); linein(s,true); #if level=1 then dolog(concat(' Browsed topic area #',s)); x:=val(s); end else x:=sel; if x<>0 then doit; end; { doselect } procedure gettext( setrecurs; end; end; end; { doit } begin { doselect } if sel=0 then begin prompt('Enter the Index number of the '); case level of 1:prompt('topic'); 2:prompt('subject'); 3:prompt('reply'); end; prompt(' to '); casedure do1; begin cmdstr:='Q,R,I,'; if userrec.cantopic then cmdstr:=concat(cmdstr,'A,'); if userrec.candelete then cmdstr:=concat(cmdstr,'D,'); cmdstr:=concat(cmdstr,'?'); end; procedure do2; begin cmdstr:='Q,R,I,'; with userrec do if can_add then if is_restrict and can_restrict then cmdstr:=concat(cmdstr,'A,') else if not is_restrict then cmdstr:=concat(cmdstr,'A,'); if userrec.candelete then cmdstr:=concat(cmdstr,'D,'); cmdstr:=concat(cmdstr,'?'); end; procedure do3; begrent:=0; cfile^:=ctemp; spcfile(temp); end; end else exit(comments); end; { setup } begin { initialize } sgcfile(0); if cfile^.usernum<>0 then root:=cfile^.usernum else setup; end; { initialize } begin { comments } root:=0; oncethrou begin prompt('Do you wish to create a new Library section? -> '); if inpYN then begin getinfo(1); temp:=filefree; sgcfile(0); with cfile^ do usernum:=temp; root:=temp; spcfile(0); ctemp.child:=0; ctemp.pa prlist; repeat doprompt; until (qhit) or (root=0); qhit:=false; newroot:=root; end; { call_list } procedure initialize; procedure setup; var temp:integer; begin strout('No Library files currently exsist.'); outcr; if userrec.can_topic then else if can_add then doadd else begin newroot:=root; exit(call_list); end; end; 3:if userrec.can_add and allow_reply then doadd; end; end; end; pYN then begin newroot:=root; exit(call_list); end; case level of 2:if userrec.can_add then begin with userrec do if is_restrict and can_add and can_restrict then doadd 2) and ((is_restrict and can_restrict and can_add) or (not is_restrict and can_add))) or ((level=3) and allow_reply and can_add) then begin prompt('Do you want to make a new one? -> '); if not inbegin { call_list } if (root=0) then begin prompt('No '); case level of 2:prompt('subject notes'); 3:prompt('replies'); end; strout(' are available yet.'); outcr; with userrec do if ((level=1) and can_topic) or ((level=('Subject'); 3:prompt('Reply'); end; qhit:=false; choice:=getchoice(true); case ch of '?':oncethrough:=false; 'R':doselect(0); 'A':doadd; 'D':dodelete; 'I':prlist; 'Q':qhit:=true; otherwise doselect(choice) end; end; { doprompt } ply.'); end; end; strout('?: Repeat these commands'); end; end; { writecmds } begin { doprompt } makecmds; if not oncethrough then begin writecmds; oncethrough:=isexpert; end; outcr; case level of 1:prompt('Topic'); 2:prompt 2:strout('subject to this topic.'); 3:strout('reply to this subject.'); end; end; if 'D' in okcmds then begin prompt('D: [D]elete a '); case level of 1:strout('topic.'); 2:strout('subject.'); 3:strout('re$1:strout('topics in the Library'); $2:strout('subjects under this topic'); $3:strout('replies to this subject'); #end; if 'A' in okcmds then begin prompt('A: [A]dd a new '); case level of 1:strout('topic to the Library.'); to [R]eview (or just enter its number).'); 2:strout('subject file and [R]ead it (or just enter its number).'); 3:strout('reply and [R]ead it (or just enter its number).'); end; prompt('I: List an [I]ndex of the '); #case level of ; makeokcmds; end; { makecmds } procedure writecmds; begin if not oncethrough then begin oncethrough:=isexpert; outcr; strout('Q: [Q]uit and go back to the preceding menu'); prompt('R: Select a '); case level of 1:strout('topic areain cmdstr:='Q,R,I,'; with userrec do if allow_reply and can_add then cmdstr:=concat(cmdstr,'A,'); if userrec.candelete then cmdstr:=concat(cmdstr,'D,'); cmdstr:=concat(cmdstr,'?'); end; begin { makecmds } case level of 1:do1; 2:do2; 3:do3; endgh:=isexpert; initialize; if root<>0 then call_list(1,root,0,root) else begin sgcfile(0); cfile^.usernum:=0; spcfile(0); end; end; { comments } { "printcontents" provides the Library's "index" function } procedure printcontents; var lim,pge,lines,topic_num,subject_num,reply_num:integer; (out:text; procedure prhdr; begin "pge:=pge+1; "page(out); "writeln(out,'Sysop''s Library Table of Contents - page# ',pge); "writeln(out); "lines:=2; "end; {prhdr}   procedure p end end; if (temp<>0) and (temp=cfile^.child) then begin strout('Damage detected. Fix in progress...'); cfile^.child:=0; spcfile(temp); sgcfile(0); cfile^.parent:=0; spcfile(0); sgcfile(temp); end; begin )prompt(' '); )strout(cfile^.fileblock); 'end %else 'outcr; if buflev<>0 then begin ch:=inp; if (ch=chr(3)) or (ch=chr(25)) or (ch=chr(26)) then exit(printcontents) else begin while buflev=0 do; ch:=inp #if s[39] = '-' then delete(s,39,1); #if s[40] = '-' then delete(s,40,1); prompt(s); {display title} #if ((level>1) and userrec.canop) {if sysop, then display SOS filename} %then { for subjects and replies} ' record from the library index file} s:=cfile^.name; {get title of file} if length(s)<40 then s:=copy(concat(s,blank),1,40); #if s[37] = '-' then delete(s,37,1); {remove - after titles} #if s[38] = '-' then delete(s,38,1); =subject_num+1; 'reply_num:=0; 'str(subject_num,s_cntr); 'prompt(concat(' ',s_cntr,' - ')); &end; $3:begin 'reply_num:=reply_num+1; 'str(reply_num,s_cntr); 'prompt(concat(' ',s_cntr,' - ')); &end; #end; sgcfile(temp); {read as,s_cntr:string; ( begin temp:=root; while (temp<>0) and (buflev=0) do begin #case level of $1:begin 'topic_num:=topic_num+1; 'subject_num:=0; 'reply_num:=0; 'str(topic_num,s_cntr); 'prompt(concat(s_cntr,' - ')); &end; $2:begin 'subject_num: cfile^.parent:=0; spcfile(0); sgcfile(temp); end; temp:=cfile^.parent; if cfile^.child<>0 then printroot(level+1,cfile^.child); end;  end; { printroot } procedure listroot(level,root:integer); var temp,sp:integer; t:=0; spcfile(0); sgcfile(temp); end; if (cfile^.parent=temp) and (temp<>0) then begin strout('Damage detected. Fix in progress...'); seek(cfile,temp); cfile^.parent:=0; put(cfile); sgcfile(0); begin while buflev=0 do; ch:=inp end end; if (temp<>0) and (temp=cfile^.child) then begin strout('Damage detected. Fix in progress...'); cfile^.child:=0; spcfile(temp); sgcfile(0); cfile^.parene^.fileblock); 'end %else 'writeln(out); #lines:=lines+1; #if lines>lim then prhdr; {check for page overflow} if buflev<>0 then begin ch:=inp; if (ch=chr(3)) or (ch=chr(25)) or (ch=chr(26)) then exit(printcontents) else#if s[40] = '-' then delete(s,40,1); write(out,s,' '); {print title} #if ((level>1) and userrec.canop) {if sysop, then print SOS filename} %then { for subjects and replies} 'begin )writeln(out,cfilbrary index file} s:=cfile^.name; {get title of file} if length(s)<40 then s:=copy(concat(s,blank),1,40); #if s[37] = '-' then delete(s,37,1); {remove - after titles} #if s[38] = '-' then delete(s,38,1); #if s[39] = '-' then delete(s,39,1); '); &end; $2:begin 'subject_num:=subject_num+1; 'reply_num:=0; 'write(out,' ',subject_num,' - '); &end; $3:begin 'reply_num:=reply_num+1; 'write(out,' ',reply_num,' - '); &end; #end; sgcfile(temp); {read a record from the lirintroot(level,root:integer);  var temp,sp:integer; s:string; (  begin temp:=root; while (temp<>0) and (buflev=0) do begin #case level of $1:begin 'topic_num:=topic_num+1; 'subject_num:=0; 'reply_num:=0; 'write(out,topic_num,' - if (cfile^.parent=temp) and (temp<>0) then begin strout('Damage detected. Fix in progress...'); seek(cfile,temp); cfile^.parent:=0; put(cfile); sgcfile(0); cfile^.parent:=0; spcfile(0); sgcfile(temp); end; temp:=cfile^.parent; if cfile^.child<>0 then listroot(level+1,cfile^.child); end; end; { listroot } begin { printcontents } outcr; sgcfile(0); if cfile^.usernum=0 then strout('No Library files are currently available.') else strout('The Li procedure util; var oncethrough:boolean; choice:integer; procedure makecmds; begin cmdstr:=''; if userrec.password<>'' then cmdstr:='P,S,'; if (userrec.can_op)and(mpass<>'')or isalias then cmdstr:=concat(cmdstr,'C,G,H,'); cmdstr:lnopqrstuvO^Go back online} (end &else listroot(1,cfile^.usernum); {display on screen instead} end; outcr; end; end; { printcontents } (prhdr; {print first page heading} (printroot(1,cfile^.usernum); (page(out); {skip to a new page} (close(out); {close printer to free port for modem} (reset(rs232,'.rs232'); {reopen modem driver to g'); &if inpYN then 'begin (close(rs232); {close modem driver to free port for serial printer} (rewrite(out,'#6'); {open .PRINTER} (lim:=62; {set page size} (pge:=0; {init page counter} :=0; {init topic counter} $subject_num:=0; {init subject counter} $reply_num:=0; {init reply counter} if channel=7 then listroot(1,cfile^.usernum) $else %begin &prompt('Send to your printer? (Y or N): brary''s index contains approximately 1,100 files!!'); strout('It can be aborted by CONTROL-C and stop/started by any other key'); prompt(' Do you still wish to list the Library''s index? (Y or N): '); if inpYN then begin outcr; $topic_num=concat(cmdstr,'M,U,L,N,Q,?'); makeokcmds; end; procedure writecmds; begin outcr; if 'P' in okcmds then begin strout('P: Change your [P]assword'); strout('S: [S]ave UPCASE, LF, MENU and NULL parameters to user file'); end; if 'C' in okcmds then begin if is_alias then strout('C: [C]hange to operator name') else strout('C: [C]hange to username'); strout('G: Operator is [G]one'); strout('H: Operator is [H]ere') end; strout('M: Change [M]enu display parameter'); strout('U: ChangO^:N':donulls; 'M':doexpert; '?':oncethrough:=false; end; until ch='Q'; end; { util } eat makecmds; if not oncethrough then writecmds; outcr; prompt('Parameters'); choice:=getchoice(false); case ch of 'P':dopass; 'S':dosave; 'C':dochange; 'G':sysopisin:=false; 'H':sysopisin:=true; 'U':doupper; 'L':dolf; 'lls:=ord(ch)-48; out(ch); outcr; end; procedure doexpert; begin outcr; prompt('Do you always want to display full menus? (Y or N): '); isexpert:=not inpYN; outcr; end; begin { util } sgufile(usernum); userrec:=ufile^; oncethrough:=isexpert; repbegin outcr; prompt('Does your terminal require a LF after a CR? (Y or N): '); lf:=inpYN; end; procedure donulls; var ch:char; begin outcr; prompt('How many nulls do you need sent after a CR? (0-9): '); repeat ch:=inp until ch in ['0'..'9']; nunum; is_alias:=true; usernum:=x; userrec:=ufile^; end; end; end; outcr; end; { dochange } procedure doupper; begin outcr; prompt('Is your terminal display in UPPERCASE? (Y or N): '); up:=inpYN; end; procedure dolf; repeat prompt('Enter new username: '); linein(s,true); if s='' then exit(dochange); upcase(s); x:=find(s); if x=0 then strout('No such user.'); until x<>0; oprec:=userrec; opnum:=usergufile(usernum); userrec:=ufile^; isalias:=false; end else begin prompt('Enter master password: '); linein(s,false); if s<>'' then begin upcase(s); if length(s)>16 then s:=copy(s,1,16); if s=mpass then begin close(ufile,lock); reset(ufile,'.profile/infonet/users.data'); strout('Your parameters have been successfully saved.'); outcr; end; procedure dochange; var s:string; x:integer; begin outcr; if isalias then begin usernum:=opnum; s.data'); end; end else strout('Invalid password'); outcr; end; { dopass } procedure dosave; begin outcr; userrec.up:=up; userrec.lf:=lf; userrec.nulls:=nulls; userrec.isexpert:=isexpert; seek(ufile,usernum); ufile^:=userrec; put(ufile); en s1:=copy(s1,1,16); if s<>s1 then strout('Password mismatch. Try again.'); until s=s1; userrec.password:=s; seek(ufile,usernum); ufile^:=userrec; put(ufile); close(ufile,lock); reset(ufile,'.profile/infonet/usersthen begin repeat prompt('Enter new password: '); linein(s,false); upcase(s); if length(s)>16 then s:=copy(s,1,16); prompt('Re-enter new password: '); linein(s1,false); upcase(s1); if length(s1)>16th oncethrough:=isexpert; end; { writecmds } procedure dopass; var s,s1:string; begin outcr; prompt('Enter your old password: '); linein(s,false); if s<>'' then begin upcase(s); if length(s)>16 then s:=copy(s,1,16); if s=userrec.password e [U]ppercase only parameter'); strout('L: Change [L]inefeed after Carriage Return parameter'); strout('N: Set [N]ulls after CR parameter'); strout('Q: [Q]uit and return to the Main Menu'); strout('?: Repeat these commands'); outcr; wyz{|}~in writeln; write('Do you want to kick this user offline? (Y or N): '); if getYN then begin channel:=2; exit(callit); end; end else begin en write('not '); looksee:=not looksee; writeln('monitoring caller'); end; begin checkkey:=false; if keypress then begin ch:=' '; unitread(2,ch,1,,12); x:=ord(ch); case x of 178:if carrier then { OA-2 } beg{ replaces calls to keypress which had the sole function } { of exiting the program so that operator interaction } { commands could become possible. } var ch:char; x:integer; s1:string[1]; procedure notlooksee; begin if looksee thpy(d,7,2)); if x>9 then x:=x+7; d[2]:=chr(x+48); s:=concat(copy(d,1,4),t); end; procedure outback; { backup and blank a character } begin out(chr(8)); out(' '); out(chr(8)); end; function checkkey; to a clock derived name in the form: MDyyhhmmss } { where M is the month as a letter, D is the day in hex, etc. } var d:string[8]; t:string[6]; x:integer; begin date(d); timeofday(t); d[1]:=chr(val(copy(d,5,2))+64); x:=val(coe,rec); get(cfile); end; procedure spcfile; begin seek(cfile,rec); put(cfile); end; procedure sgufile; begin seek(ufile,rec); get(ufile); end; procedure spufile; begin seek(ufile,rec); put(ufile); end; procedure newfilename; { sets string 's' v:integer[10]; begin v:=0; x:=1; if s='' then val:=0 else while (x<=length(s)) and (s[x] in ['0'..'9']) do begin v:=v*10+ord(s[x])-48; x:=x+1; end; if v>32767 then val:=0 else val:=trunc(v); end; procedure sgcfile; begin seek(cfil); until ch in ['Y','N']; out(ch); outcr; inpYN:=(ch='Y'); end; function getYN; var ch:char; begin ch:=' '; repeat unitread(2,ch,1,,12); ch:=upch(ch); until ch in ['Y','N']; writeln(ch); getYN:=(ch='Y'); end; function val; var x:integer; l outputlevel=0; delay(amount); while buflev>0 do unitread(channel,ch,1,,12); for x:=1 to length(s) do begin delay(5); write(rs232,s[x]); end; if s[1]<>'+' then writeln(rs232); end; function inpYN; var ch:char; begin repeat ch:=upch(inp for procedures and functions. - Walt Pawley } procedure outcr; begin out(chr(13)) end; procedure delay; var x:integer; begin for x:=1 to amount do if checkkey then exit(program); end; procedure delayout; var x:integer; ( begin repeat unti{ This new section is used for functions of general value. The procedure } { and function declarations must be made in the section of the root module } { for "forward" declarations. Note that that area is now alphabetized } { and separated into sections channel:=2; exit(callit); end; 199:sysopisin:=false; { OA-G } 200:sysopisin:=true; { OA-H } 205:notlooksee; { OA-M } 206:begin { OA-N } outcr; outcr; strout(opnote); outcr; end; 209:checkkey:=true; { OA-Q } 216:opnote:=''; { OA-X } otherwise if length(opnote)<80 then if ch=chr(13) then writeln else b; len:=len-1; end; end; begin { linein } len:=0; dummy:=' '; s:=''; repeat ch:=inp; if ord(ch)>31 then begin if len<80 then begin len:=len+1; if b then out(ch); dummy[1]:=ch; s:=concat(s,dummy); end strout; begin prompt(s); outcr; end; procedure linein; { The boolean is true when echo is desired } var len:integer; ch:char; dummy:string[1]; procedure bs; begin if len<>0 then begin delete(s,length(s),1); if b then outback if lf then out(chr(10)); end; if looksee then if ord(ch)>31 then write(ch) else if ch=chr(13) then writeln else if ch=chr(8) then write(ch); end; procedure prompt; var x:integer; begin for x:=1 to length(s) do out(s[x]); end; procedure end; { inp } procedure out; var x:integer; ch1:char; begin while outputlevel>20 do; if up then ch:=upch(ch); unitwrite(channel,ch,1,,12); if ch=chr(13) then begin if not carrier then exit(callit); for x:=1 to nulls do out(chr(0)); end; end; end; ch:=' '; unitread(channel,ch,1,,12); if ch=chr(127) then ch:=chr(8); if ch in [' '..'Z'] then packresultcode(ch,resp) else if (ch=chr(13)) and (resp=nocarr) then begin carrierx:=false; exit(callit); end; inp:=ch;l keypress; end else begin t:=0; timeout:=0; while buflev=0 do begin if checkkey then exit(inp); timeout:=timeout+1; if timeout>10000 then begin t:=t+1; if t>1 then exit(callit); timeout:=0; var s1:string[1]; begin if length(resp)>12 then resp:=''; s1:=' '; s1[1]:=ch; resp:=concat(resp,s1); end; function inp; var x,timeout,t:integer; resp:string[20]; begin if channel=2 then begin write(chr(5)); repeat unti end; procedure upcase; var x:integer; begin if s<>'' then for x:=1 to length(s) do s[x]:=upch(s[x]); end; function carrier; begin if channel=2 then carrier:=true else carrier:=carrierx; end; procedure packresultcode(ch:char;var resp:string); r d,t:string; begin date(d); timeofday(t); s:=concat(copy(d,5,2),'/',copy(d,7,2),'/',copy(d,1,4),' ', copy(t,1,2),':',copy(t,3,2),':',copy(t,5,2)); end; function upch; begin if ch in ['a'..'z'] then upch:=chr(ord(ch)-32) else upch:=ch; dure convtname(var s:string); begin s:=concat('.profile/infonet/',s) { modified for ///'s Company use } end; { convtname } procedure transpercent; begin getpathname(s); while s[length(s)]<>'/' do delete(s,length(s),1); end; procedure getclock; va if ch=chr(13) then done:=true else else out(chr(7)); until done; out(ch); outcr; getchoice:=val(s); end; procedure makeokcmds; var x:integer; begin okcmds:=[]; for x:=1 to length(cmdstr) do okcmds:=okcmds+[cmdstr[x]]; end; proce out(ch); s1:=' '; s1[1]:=ch; s:=concat(s,s1); end else out(chr(7)) else if length(s)>0 then if ch=chr(8) then begin outback; delete(s,length(s),1); end else s:string[5]; s1:string[1]; begin s:=''; done:=false; prompt(' ('); prompt(cmdstr); prompt(') ->'); repeat ch:=upch(inp); if ch in okcmds then done:=true else if (ch in ['0'..'9']) and numok then if length(s)<5 then begin egin write(ch); s1:=' '; s1[1]:=ch; opnote:=concat(opnote,s1) end else write(chr(7)); end; end; end; function getchoice; { unified menu response getter - provides numerical input } var done:boolean; else out(chr(7)); end else case ord(ch) of 13:outcr; 8:bs; 24:repeat bs until len=0; 127:bs; end; until ch=chr(13); end; { linein } function find; var tmp,high,low,current,old:integer; begin high:=num; low:=0; current:=-1; repeat old:=current; current:=(high+low+1) div 2; sgufile(current); if ufile^.username<>s then if s31 then begin if tp<16382 then begin if (tp-lastcr)=80 then newline; buf[tp]:=ch; tp:=tp+1; out(ch); buf[tp]:=chr(13); outcr; lastcr:=tp; tp:=tp+1; end; procedure addbel; begin buf[tp]:=chr(7); out(chr(7)); end; Begin { goedit } dontdo:=false; strout('Enter your text below. Note that there is a 16,384 character limit.'); strout('Press Control-bscr } procedure backspace; begin if tp>0 then begin tp:=tp-1; if buf[tp] in [' '..'~'] then outback else if buf[tp]=chr(7) then out(chr(7)) else if buf[tp]=chr(13) then bscr; end; end; { backspace } procedure newline; begin e bscr; var x:integer; begin outcr; if tp>0 then begin x:=tp; repeat x:=x-1; until (x=0) or (buf[x]=chr(13)); lastcr:=x; if buf[x]=chr(13) then x:=x+1; while x0 then begin repeat tp:=tp-1; if buf[tp]<>chr(13) then outback; until (tp=0) or (buf[tp]=chr(13)); if tp>0 then tp:=tp+1; end; end; { ctrlx } procedurfunction outputlevel; begin if channel=2 then outputlevel:=0 else begin unitstatus(7,rssize,12); outputlevel:=rssize[1]; end; end; procedure goedit; { Accepts data into 'buf' with a limited form of editting ability } var x,tp,linecount,lasysop.'); writeln('!!! File <',list,'>, error=',i); end; close(f); end; { printblock } function buflev; begin if channel=2 then if keypress then buflev:=1 else buflev:=0 else begin unitstatus(7,rssize,12); buflev:=rssize[3]; end; end; out(chr(x)); c:=c+1; x:=block[c]; end; end else begin #str(i,i1); #dolog(concat(' !!! File <',list,'>, error = ',i1)); prompt('File <'); prompt(list); strout(' > appears to be damaged.'); strout('Please notify the S t1:=0; t2:=t2+1; if t2>2 then begin close(f); exit(callit) end end; until buflev>0; ch:=inp; until buflev=0; if checkkey then byebye; ch:=inp; if (ch=chr(3)) or (ch=chr(25)) or (ch=chr(26)) then byebye; while buflev>0 do ch:=inp; t1:=0; t2:=0; repeat t1:=t1+1; if checkkey then byebye; if t1>30000 then begin onet/',list); { force the pathname } #end; reset(f,list); i:=ioresult; c:=512; if i=0 then while (blockread(f,block,1)<>0) and (c=512) do begin c:=0; x:=block[c]; while x<>0 do begin while buflev<>0 do repeat tblock } block[512]:=0; if list[1]='%' then { test for library file or "stuff" file } #begin { modified for ///'s Company use } %delete(list,1,1); { remove the % because data is in diff. directory } %list:=concat('.profile/inf:=current else find:=0; end; { find } procedure printblock; var ch:char; f:file; x,c,i,t1,t2:integer; (i1:string; block:packed array[0..512] of 0..255; procedure byebye; begin close(f); exit(printblock); end; begin { prinodump; { This has been heavily rewritten to avoid garbling the user's text. } { The primary idea is to not let the echo hold up the response to input } { so no Xon/Xoff protocol is required. It was found that the time to } { expand a seedling file to a sapling file (512-->513 bytes) was too } { long to tolerate on a 5M ProFile, therefore 1024 bytes are pre- } { allocated to avoid this time bump. - Walt Pawley} { Added code to send a dot to remote user every time a block is please wait...'); rewrite(f,s1); %prompt('.'); x:=(editlen+511) div 512; %prompt('.'); x:=blockwrite(f,buf,x); %prompt('.'); close(f,lock); strout('done!'); %dolog(concat(' added file: ',s1)); list:=s1; end; end; eo then list:=fname else begin if editlen<>0 then begin if list='' then begin newfilename; list:=concat('.profile/infonet/',s); {modified for ///'s Company use} end; s1:=list; prompt('Now writing your file, if channel=7 then begin prompt('Do you want to dump your data from a file? (Y or N): '); if inpYN then dodump else goedit; end else goedit; end; { edit } procedure setblock; var x:integer; s1:string; f:file; begin if dontdle xfer) } { abort <--> user chose not to complete operation } begin dontdo:=false; if userrec.canop then begin prompt('Do you want to copy this from a file? (Y or N): '); if inpYN then begin copyfile; exit(edit); end end; f1,buf,1); close(f1,lock); end; close(f2); end; { copyfile } procedure edit; { To control the flow of manually editted data to the output file(s) } { two flags are generated: } { dontdo <--> nothing in edit buffer to write (some kind of fiopy from: '); linein(s2,true); reset(f2,s2); if ioresult<>0 then begin strout(concat('File < ',s2,' > could not be found.')); abort:=true; exit(copyfile); end else begin rewrite(f1,s1); while blockread(f2,buf,1)=1 do x:=blockwrite({ Transfers any disk file to an infonet data file, 's'. } var s1,s2:string; f1,f2:file; x:integer; begin dontdo:=true; if s='' then newfilename; s1:=concat('.profile/infonet/',s); fname:=s1; prompt('Enter the name of the file to c,lock); prompt('File <'); prompt(s1); strout('> recorded.'); #dolog(concat(' transmitted file: ',s1)); end else begin abort:=true; close(f,purge); strout('File not recorded.'); end; end; { dodump } procedure copyfile; f t2>1 then begin close(f,purge); exit(callit); end; t1:=0; end; end; until done; outcr; strout('Thanks for the upload!'); if x=3 then begin if pt>0 then t1:=blockwrite(f,buf,1); fname:=s1; close(f; t1:=blockwrite(f,buf,1); pt:=pt-512; if pt>0 then moveleft(buf[512],buf,pt); end; t1:=0; t2:=0; end else begin if checkkey then exit(program); t1:=t1+1; if t1>3000 then begin t2:=t2+1; i x:=ord(buf[pt-1]); done:=(x=3) or (x=25); if done then buf[pt-1]:=chr(0); while pt>511 do begin &out ('.'); {send a . back to the caller as every block is written} &bnum:=bnum+1; &if bnum > 50 then begin (bnum:=0; (outcr; &end echo! You will see a dot for every 512 chars.'); strout(' CONTROL/C will save your file, CONTROL/Y will abort your upload'); !prompt ('Now Recording...'); repeat x:=buflev; if x>0 then begin unitread(channel,buf[pt],x,,12); pt:=pt+x; :boolean; pt,x,t1,t2,bnum:integer; begin pt:=0; t1:=0; t2:=0; bnum:=0; done:=false; dontdo:=true; if s='' then newfilename; s1:=concat('.profile/infonet/',s); rewrite(f,s1); x:=blockwrite(f,buf,2); reset(f); strout('Your upload will NOTwritten} { to the disk - Reid Trimble} { Added code to record file additions to the log file for an audit trail} { that the sysop can review each day to control what is added to the bbs} { - Ed Gooding}  var f:file; s1:string; donend; { setblock } O^d)O^aout('Talk disconnected'); looksee:=savelooksee; end; {$endc} v>0 then ch:=inp; if ch=chr(27) then done:=true else begin if ord(ch)>31 then write(ch) else if ch=chr(13) then writeln else if ch=chr(8) then write(ch); out(ch) end; end; writeln('Talk disconnected'); outcr; stroksee; exit(chat) end; strout('answer.'); writeln('Chat in progress. Press ESCAPE to exit'); done:=false; while not done do begin ch:=chr(0); write(chr(5)); while ch=chr(0) do if keypress then unitread(2,ch,1,,12) else if bufle if not carrier then exit(callit); if x>=20 then begin strout('I''m sorry, the Sysop is not here now.'); looksee:=savelooksee; exit(chat) end; if ch=chr(155) then begin #strout('I''m sorry, the Sysop is not here now.'); looksee:=savelo:exit(callit); { OA-TAB } 13:done:=true; end end else begin write(chr(7)); out(chr(7)); out('.'); y:=0; while (not keypress) and (y<600) do y:=y+1; x:=x+1; end; end; TAB to hang up on caller!'); dolog(' tried to chat with sysop'); x:=0; while (not done) and (x<20) and carrier do begin if keypress then begin unitread(2,ch,1,,12); case ord(ch) of 155:done:=true; { OA-ESC } 137(chr(7)); strout('I''ll ring him anyway, just in case.'); write(chr(7)); end; ch:=' '; done:=false; prompt('Beeping SYSOP. Stand by'); writeln('User--> ',userrec.username,' wants to "chat".'); writeln('Press CR to chat, OA-ESC to ignore, OA- {$ifc chat} procedure chat; var x,y:integer; (logmsg:string; savelooksee,done:boolean; begin savelooksee:=looksee; looksee:=false; if not sysopisin then begin write(chr(7)); strout('The SYSOP told me he is not here now.'); writeO^H writeln('Cleaning...Stand by'); fillchar(map,sizeof(map),chr(0)); cleanusers; cleanclass; rebuild; end; { cleanup } begin if not map[x] then begin writeln('Record ',x,' is free.'); sgcfile(x); cfile^.parent:=t; t:=x; spcfile(x); end; end; sgcfile(0); cfile^.parent:=t; spcfile(0); end; begin { cleanup } ne(cfile^.child); end; end; begin { cleanclass } sgcfile(0); cleanline(cfile^.usernum); end; { cleanclass } procedure rebuild; var x,y,z,t,l:integer; begin sgcfile(0); cfile^.parent:=0; y:=cfile^.child; spcfile(0); t:=0; for x:=1 to y do =cfile^.parent; end; get(ufile); end; end; procedure cleanclass; procedure cleanline(root:integer); var x:integer; begin x:=root; while x<>0 do begin map[x]:=true; sgcfile(x); x:=cfile^.parent; if cfile^.child<>0 then cleanli procedure cleanup; var map:packed array[0..10000] of boolean; x,y,z,t:integer; procedure cleanusers; begin sgufile(1); while not eof(ufile) do begin x:=ufile^.link; while x<>0 do begin map[x]:=true; sgcfile(x); x: begin if s='' then val:=0 else begin v:=0; for x:=1 to length(s) do v:=v*10+(ord(s[x])-48); val:=v; end; end; begin okchars:=['0'..'9']; str(s,x); editstr(s,5); x:=val(s); end; procedure readfile; var usrfile:file of user; eer; dummy:string[1]; begin dummy:=' '; s:=''; if i=0 then s:='0' else while i<>0 do begin rem:=i mod 10; i:=i div 10; dummy[1]:=chr(rem+48); s:=concat(dummy,s); end; end; function val(s:string):integer; var v,x:integer; n write(ch); dummy[1]:=ch; s:=concat(s,dummy); end; end; until ord(ch) in [2,13,27]; end; procedure editint(var x:integer); var s:string; tchars:set of char; procedure str(var s:string;i:integer); var rem:integ,chr(8),chr(24),chr(27),chr(13)]; case ord(ch) of 2:if allowb then exitch:=ch else ch:=chr(0); 8:bs; 24:ctrlx; 13:exitch:=ch; 27:if allowesc then exitch:=ch else ch:=chr(0); otherwise if length(s)0 then begin in ['Y','N',chr(2),chr(27),chr(13)]; case ord(ch) of 2:if allowb then exitch:=ch else ch:=chr(0); 13:exitch:=ch; 27:if allowesc then exitch:=ch else ch:=chr(0); otherwise begin b:=(ch='Y'); writebool(b);write(chr(re writebool(b:boolean); begin case b of true:write('YES'); false:write('NO '); end; end; procedure editbool(var b:boolean); var ch:char; begin ch:=' '; writebool(b);write(chr(8),chr(8),chr(8)); repeat repeat ch:=upch(inp); until ch gotoxy(40-length(s) div 2,line); write(s); end; function upch(ch:char):char; begin if ch in ['a'..'z'] then upch:=chr(ord(ch)-32) else upch:=ch; end; function inp:char; var ch:char; begin ch:=' '; unitread(2,ch,1,,12); inp:=ch; end; proceduname,masterpass:string[16]; num:integer; {the following are from the edit procedures} exitch:char; allowb,allowesc,upcase:boolean; okchars:set of char; procedure center(s:string;line:integer); begin lf,up:boolean; end; usrlst=record usr:user; next:^usrlst; end; listtype=^usrlst; var list:^usrlst; changes:boolean; cls:char; op phone:string[20]; isnet:boolean; mailalc,used,link:integer; canop,canmail,canclass,cantopic,canadd, isexpert,canlist,canrestrict,oponly,candelete:boolean; nulls:0..30; {$i-} {$v-} Program usrutl; uses chainstuff; const filename='.profile/infonet.stuff/USERS.DATA'; (bbs_name='Glenwood Farm'; clcnt=28; type user=packed record username,password:string[16]; name:string[40]; ndp:^usrlst; x:integer; begin list:=nil; {clear user list}; reset(usrfile,filename); if not (ioresult in [0,10]) then begin writeln('ERROR OPENING FILE USERS.DATA'); writeln('PROGRAM STOPPED.'); exit(program); end; if ioresult=0 then begin num:=usrfile^.link; opname:=usrfile^.username; masterpass:=usrfile^.password; for x:=1 to num do begin get(usrfile); if ioresult<>0 then begin writeln('ERROR READING FILE USERS.DATA.'); writ repeat gotoxy(53,17); allowb:=true; allowesc:=true; upcase:=true; tm:=rec.nulls; editint(tm); rec.nulls:=tm; if exitch=chr(27) then exit(editusername); if exitch=chr(2) then exit(editnulls); if rec.nulls>9 then begin ); allowb:=true; allowesc:=true; b:=rec.lf; editbool(b); rec.lf:=b; if exitch=chr(27) then exit(editusername); if exitch=chr(2) then exit(editlf); editup; until false; end; procedure editnulls; var tm:integer; begin repeat editup; begin gotoxy(38,19); allowb:=true; allowesc:=true; b:=rec.up; editbool(b); rec.up:=b; if exitch=chr(2) then exit(editup); if exitch=chr(27) then exit(editusername); exit(editusername); end; procedure editlf; begin repeat gotoxy(41,18tebool(candelete); gotoxy(48,16); writebool(isexpert); gotoxy(53,17); writeln(nulls); gotoxy(41,18); writebool(lf); gotoxy(38,19); writebool(up); end; end; procedure editusername; var b:boolean; s:string; procedure writebool(oponly); gotoxy(40,10); writebool(canlist); gotoxy(27,11); writebool(canclass); gotoxy(33,12); writebool(cantopic); gotoxy(35,13); writebool(canadd); gotoxy(46,14); writebool(canrestrict); gotoxy(35,15); wri1,3); writeln(username); gotoxy(11,4); writeln(password); gotoxy(19,5); writeln(name); gotoxy(22,6); writebool(canop); gotoxy(20,7); writebool(canmail); gotoxy(18,8); writeln(mailalc); gotoxy(30,9); nu prompts)?:'); writeln('How many NULLS does user need sent after each ?:'); writeln('Does user need a after every ?:'); writeln('Is their terminal in UPPERCASE only?:'); end; procedure printscreen; begin with rec do begin gotoxy(1rary?:'); writeln('Can they create Library topics?:'); writeln('Can they add to Library subjects?:'); writeln('Can they add to restricted Library subjects?:'); writeln('Can they delete Library subjects?:'); writeln('Is user an expert (doesn''t need me writeln('User''s full name:'); writeln('Is User an operator?:'); writeln('Can they use mail?:'); writeln('Mail allocation:'); writeln('Can they mail only to SYSOP?:'); writeln('Can they list registered system users?:'); writeln('Can they use the Libhile (t<>nil) and (u.username<>t^.usr.username) do t:=t^.next; check:=(t<>nil); end; end; procedure doedit(var rec:user); var ch:char; procedure drawscreen; begin write(cls); gotoxy(0,3); writeln('Username:'); writeln('Password:'); t1:=t1^.next; end; t3:=t2^.next; t2^.next:=temp; temp^.next:=t1; end; end; end; function check(u:user):boolean; var b:boolean; t:listtype; begin if list=nil then check:=false else begin t:=list; w begin num:=num+1; t1:=list; if temp^.usr.usernamenil) and (t1^.usr.username9'); for tm:=1 to 5000 do; gotoxy(53,17); write(' '); end; until rec.nulls in [0..9]; editlf; until false; end; procedure editexpert; begin repeat gotoxy(48,16); allowb:=true; allowesc:=true; b:=rec.isexpert; editbool(b); rec.isexpert:=b; if exitch=chr(27) then exit(editusername); if exitch=chr(2) then exit(editexpert); editnulls; until false; end; procedure editdelete; begin repeat gotoxy(35,15); al write(chr(1)); ch:=' '; repeat drawscreen; printscreen; editusername; if exitch=chr(27) then exit(doedit); gotoxy(0,23); write('All correct? (Y or N): '); repeat ch:=upch(inp) until ch in ['Y','N']; until ch='Y'; end; procedure adduser; repeat gotoxy(11,3); allowb:=false; allowesc:=true; upcase:=true; okchars:=[' '..'~']; s:=rec.username; editstr(s,16); rec.username:=s; if exitch=chr(27) then exit(editusername); editpassword; until false; end; begin repeat gotoxy(11,4); allowb:=true; allowesc:=true; upcase:=true; s:=rec.password; editstr(s,16); rec.password:=s; if exitch=chr(27) then exit(editusername); if exitch=chr(2) then exit(editpassword); editname; until false; end; begin 19,5); s:=rec.name; allowb:=true; upcase:=false; okchars:=[' '..'~']; editstr(s,40); rec.name:=s; if exitch=chr(27) then exit(editusername); if exitch=chr(2) then exit(editname); editop; until false; end; procedure editpassword; begin gotoxy(22,6); allowb:=true; allowesc:=true; b:=rec.canop; editbool(b); rec.canop:=b; if exitch=chr(27) then exit(editusername); if exitch=chr(2) then exit(editop); editmail; until false; end; procedure editname; begin repeat gotoxy(gotoxy(20,7); allowb:=true; allowesc:=true; b:=rec.canmail; editbool(b); rec.canmail:=b; if exitch=chr(27) then exit(editusername); if exitch=chr(2) then exit(editmail); editalc; until false; end; procedure editop; begin repeat tm:integer; begin repeat gotoxy(18,8); allowb:=true; allowesc:=true; editint(rec.mailalc); if exitch=chr(27) then exit(editusername); if exitch=chr(2) then exit(editalc); editonly; until false; end; procedure editmail; begin repeat begin repeat gotoxy(30,9); allowb:=true; allowesc:=true; b:=rec.oponly; editbool(b); rec.oponly:=b; if exitch=chr(27) then exit(editusername); if exitch=chr(2) then exit(editonly); editlist; until false; end; procedure editalc; var begin repeat gotoxy(40,10); allowb:=true; allowesc:=true; b:=rec.canlist; editbool(b); rec.canlist:=b; if exitch=chr(27) then exit(editusername); if exitch=chr(2) then exit(editlist); editclass; until false; end; procedure editonly; gin repeat gotoxy(27,11); allowb:=true; allowesc:=true; b:=rec.canclass; editbool(b); rec.canclass:=b; if exitch=chr(27) then exit(editusername); if exitch=chr(2) then exit(editclass); edittopic; until false; end; procedure editlist; in repeat gotoxy(33,12); allowb:=true; allowesc:=true; b:=rec.cantopic; editbool(b); rec.cantopic:=b; if exitch=chr(27) then exit(editusername); if exitch=chr(2) then exit(edittopic); editadd; until false; end; procedure editclass; bein repeat gotoxy(35,13); allowb:=true; allowesc:=true; b:=rec.canadd; editbool(b); rec.canadd:=b; if exitch=chr(27) then exit(editusername); if exitch=chr(2) then exit(editadd); editrestrict; until false; end; procedure edittopic; beg gotoxy(46,14); allowb:=true; allowesc:=true; b:=rec.canrestrict; editbool(b); rec.canrestrict:=b; if exitch=chr(27) then exit(editusername); if exitch=chr(2) then exit(editrestrict); editdelete; until false; end; procedure editadd; beglowb:=true; allowesc:=true; b:=rec.candelete; editbool(b); rec.candelete:=b; if exitch=chr(27) then exit(editusername); if exitch=chr(2) then exit(editdelete); editexpert; until false; end; procedure editrestrict; begin repeat var temp,mrk:^usrlst; checked:boolean; xx:integer; ch:char; begin repeat mark(mrk); new(temp); with temp^.usr do begin username:=''; password:='NOPASSWORD'; name:=''; mailalc:=10; used:=0; link:=0; canop:=false; canmail:=true; #canlist:=true; canclass:=true; cantopic:=false; canadd:=true; oponly:=false; candelete:=false; canrestrict:=false; isexpert:=false; nulls:=0; up:=false; lf:=true; end; repeat doedit(temp write('Enter master password -> '); s:=masterpass; editstr(masterpass,16); if exitch=chr(27) then masterpass:=s; changes:=true;  end; procedure savefile; var usrfile:file of user; t:listtype; x:integer; begin if num<>0s:=true; end; procedure setpass; var s:string; begin center(concat(bbs_name,' - Sysop Utilities'),1); center('Change master password',2); okchars:=([' '..'~']); upcase:=true; allowesc:=true; allowb:=false; gotoxy(0,5); nge "operator only" mail name',2); gotoxy(0,5); write('Enter operator name for "operator only" mail -> '); allowesc:=true; upcase:=true; allowb:=false; s:=opname; okchars:=([' '..'~']); editstr(opname,16); if exitch=chr(27) then opname:=s; change.username:=s; dodelete(usr); num:=num-1;{4-Jul-1984} usr.username:=s1; new(t1); t1^.usr:=usr; addlist(t1); "changes:=true; end; end; procedure changeop; var s:string; begin center(concat(bbs_name,' - Sysop Utilities'),1); center('Cha gotoxy(0,4); writeln('User not found.'); end; until t1<>nil; usr:=t1^.usr; oldalc:=usr.mailalc; doedit(usr); if exitch=chr(27) then exit(edituser); changes:=true; if (s=usr.username) then t1^.usr:=usr else begin s1:=usr.username; usr]); upcase:=true; allowb:=false; allowesc:=true; s:=''; editstr(s,16); writeln; if exitch=chr(27) then exit(edituser); t1:=list; while (t1<>nil) and (t1^.usr.username<>s) do t1:=t1^.next; if t1=nil then begin write(chr(28)); ring; t1:listtype; begin center(concat(bbs_name,' - Sysop Utilities'),1); center('Edit a registered user''s account record',2); repeat gotoxy(0,5); write('Enter the name of the user that you want to edit -> '); okchars:=([' '..'~'ST DELETE ALL OF THEIR MAIL FIRST'); for x:=1 to 5000 do; exit(deleteuser); end; dodelete(t1^.usr); $changes:=true; num:=num-1; end; until b; end; procedure edituser; var usr:user; oldalc:integer; s,s1:st while (t1^.usr.username<>s) and (t1<>nil) do t1:=t1^.next; writeln; b:=true; if t1=nil then begin writeln('User not found'); b:=false; end else begin if t1^.usr.link<>0 then begin gotoxy(0,5); writeln('YOU MUcount',2); okchars:=([' '..'~']); upcase:=true; allowb:=false; allowesc:=true; write(cls); gotoxy(0,7); repeat s:=''; write('Which User should I delete? -> '); editstr(s,16); if exitch=chr(27) then exit(deleteuser); t1:=list; NKNOWN.'); exit(program); end; t2^.next:=t1^.next; end; end; procedure deleteuser; var s:string; b:boolean; t1,t2,t3:listtype; x:integer; begin center(concat(bbs_name,' - Sysop Utilities'),1); center('Delete an ac t1:=list; if t1^.usr.username=u.username then begin list:=t1^.next; end else begin while (t1<>nil) and (t1^.usr.username<>u.username) do begin t2:=t1; t1:=t1^.next; end; if t1=nil then begin writeln('FATAL ERROR, CAUSE U until not checked; addlist(temp); "changes:=true; gotoxy(30,23); write('Add another user to the system? (Y or N): '); repeat ch:=upch(inp) until ch in ['Y','N']; until ch='N'; end; procedure dodelete(u:user); var t1,t2,t3:listtype; begin^.usr); if exitch=chr(27) then begin release(mrk); exit(adduser); end; checked:=check(temp^.usr); if checked then begin gotoxy(40,23); write('USER ALREADY EXISTS'); for xx:=1 to 5000 do; end; then begin write(cls); writeln('Now saving file...',num,' users.'); rewrite(usrfile,filename); if ioresult<>0 then begin writeln('ERROR OPENING FILE USERS.DATA'); writeln('PROGRAM STOPPED.'); exit(program); end; with usrfile^ do begin username:=opname; password:=masterpass; link:=num; end; put(usrfile); t:=list; for x:=1 to num do begin usrfile^:=t^.usr; put(usrfile); t:=t^.next; end; close(usrfile,lock); endNotes from the authors of the current revisions to the Infonet BBS system: ========================================================================== These program enhancement notes were written by Ed Gooding and Walt Pawley, the two individuals who have ; changes:=false; opname:='OPERATOR'; masterpass:=''; num:=0; readfile; domenu; if changes then savefile; write(chr(28)); end. writeln('Q: [Q]uit this program to the Pascal Command Line'); gotoxy(0,21); write('Enter your choice -> '); repeat ch:=upch(inp) until ch in ['A','E','D','C','M','Q','R','P']; if ch<>'Q' then dobranch; until ch='Q'; end; begin cls:=chr(clcnt)e'); gotoxy(5,13); writeln('M: Change [M]aster password'); gotoxy(5,15); writeln(concat('R: [R]un the ',bbs_name,' bbs program')); gotoxy(5,17); "writeln('P: [P]rint a listing of all registered users'); gotoxy(5,19); ]dd a new user to the bbs system'); gotoxy(5,7); writeln('E: [E]dit an existing user''s account record'); gotoxy(5,9); writeln('D: [D]elete an existing user''s account record'); gotoxy(5,11); writeln('C: [C]hange the "operator only" mail nam if changes then savefile; setchain('.profile/infonet.stuff/infonet'); exit(program); end; 'P':print; end; end; begin repeat write(chr(28)); "center(concat(bbs_name,' - Sysop Utilities'),1); gotoxy(5,5); writeln('A: [A temp:=temp^.next; end; if toscr then foot; end; end; procedure domenu; var ch:char; procedure dobranch; begin writeln(chr(28)); case ch of 'A':adduser; 'E':edituser; 'D':deleteuser; 'C':changeop; 'M':setpass; 'R':begin n(ch); toscr:=ch='N'; if toscr then begin rewrite(out,'.console'); lim:=22; end else begin rewrite(out,'#6'); lim:=64; end; pge:=0; prhdrs; while temp<>nil do begin dodetail; lines:=lines+1; if lines>lim then begin foot; prhdrs; end; end; begin temp:=list; write(chr(28)); gotoxy(0,5); write('Send output to printer? -> '); repeat ch:=upch(inp) until ch in ['Y','N',chr(27)]; if ch<>chr(27) then begin writel; var s:string; begin with temp^.usr do begin s:=username; if length(s)<16 then s:=copy(concat(s,blank),1,16); write(out,s,' '); s:=password; if length(s)<16 then s:=copy(concat(s,blank),1,16); writeln(out,s,' ',name); end; writeln(out,'Users listing page# ',pge); writeln(out); lines:=2; end; procedure foot; begin if toscr then gotoxy(0,23); write('Press RETURN to continue '); repeat ch:=inp until ch=chr(13); end; procedure dodetail; const blank=' '; end; procedure print; var temp:listtype; lim,pge,lines:integer; out:text; toscr:boolean; ch:char; procedure prhdrs; begin pge:=pge+1; if toscr then write(chr(28)) else page(output); made modifications to this version of the Infonet BBS program, submitted to the Public Domain by Sun Remarketing in Logan, Utah. Walt got a copy of the original Sun release, and made many fine enhancements, which are documented in the second set of notes, the list. I also enhanced the routine to allow the Sysop to print this list to a printer, so I could have a listing laying here on the desk to refer to when people had questions about certain files. I also numbered the entries to correspond withI never got around to implementing. - modified the Index function, which displays every file in the BBS in a hierarchical type of display to indent Subjects under Topics, and Replies under Subjects, in an outline format. This made it easier to followe. If the file was not found, the program would know that it was being used for the first time by a new Sysop, and would execute a routine that would prompt the new Sysop for the above info and store it in this file. This is one of those changes h the various source code files that comprise this program. A better way to accomplish this would be to create a "system control file" that contained this type of constant information. .ff When the program started, it would attempt to open this filhed the BBS name, Sysop name, and Sysop's voice phone number as constants at the very front of the INFONET.TEXT source file. This will allow subsequent user's of the program to quicky customize those basic features, without having to dig down throug was a valid user BEFORE it allowed you to write the message. As received, the program would allow you to key a long message to a user, only to tell you when you tried to save the message that you mis-spelled the receiving party's name. - establis felt that they were too cryptic for the casual BBS user, so I expanded the text on most of the options. Over the last three years, I have installed the following enhancements: - changed the Send Mail function so that the program ensured that the Sendee The vendor refused to help me, so I dumped the program in favor of Infonet, since the Infonet source code had been released to the Public Domain. After getting the program to work at 2400 baud, I then customized all of the menus displayed to callers. Il duplex. The first change I made was to support my 2400 baud modem. This is the reason that I dumped the old Let's Talk BBS program that I originally used to run ///'s Company. I bought the modem and then found out that Let's Talk would not talk to it.s efforts in restructuring and reorganizing the source code. It made my job a lot easier in applying my enhancements. If you would like to see some of these changes, you can call ///'s Company at 804-747-8752, 300/1200/2400 baud, 7 bits, odd parity, fulun my ///'s Company BBS, which is online 24 hours a day, 7 days a week. I can honestly say that the program has never crashed, so I have confidence in the changes that Walt and I have applied over the last several years. I would like to acknowledge Walt'otes follow this introduction, and precede Walt's notes, since Ed's changes are the latest in this version of Infonet. As of 08/29/91 I downloaded Walt Pawley's enhanced version of Infonet from Compuserve in early 1988 and have been using it since to rdated "As of 03/21/88". These changes were made in order to support his North Umpqua Midnight Oil BBS. Ed downloaded Walt's version from Compuserve, and over the last three years has further enhanced the program for use by his ///'s Company BBS. Ed's n their choice numbers when online. This allows one to find the appropriate prompt reply before signing on, and speeds access to the desired file(s). - significantly expanded the log file function. Originally, the program only logged the fact that a caller had logged on and then off. Since I was not here watching callers most of the time, I expanded this function to show what files the caller viewed, what files they added by keying or trans- mitting, who they sent mail to, which mail they rearitten by Harold Stuart of Sun Remarketing and modified by Walt Pawley of Wump Research & Company. While this program (or its successors) are in use 24-hours per day at (503) 672-0453, there is no assurance that it is fully debugged, or that it will operaime before actually rewriting the User File. ============================================================================== As of 03/21/88 This note is to describe operational and program changes made to the public domain version of Infonet originally wn you tried to exit the Sysop Utilities. This was time consuming and frustrating if you were trying to get somewhere else fast. I changed the program to set a logic switch if the Sysop actually changed anything. This switch was checked at exit tgic error where the User File was rewritten whether you actually made any updates or not. If you previously invoked this program and accessed the add or edit routines, but did not actually change anything, the program would update the User File whee to change this constant and re-compile the program if you want to see your BBS name in the menu when this program runs. I also greatly expanded the menus and cleaned up some formatting to make it a little more user friendly. I also corrected a loy. I still might make this change in the future, time permitting. .ff - made some changes to the USRUTIL.TEXT source code file for the Sysop Util- ities. I added a constant to the front of the program to contain the name of the BBS. You will hav, then copy the files from .PROFILE/INFONET to them, and then delete the files in the .PROFILE/INFONET directory. It would be wise to make a backup before implementing this enhancement. If your BBS is not that large, you may not find this necessare appropriate sub-directory. For example, the file D189112513's path is currently .PROFILE/INFONET/D189112513. This enhancement would change the path to .PROFILE/INFONET/D/D189112513. Obviously, you would have to create all these sub-directoriesce files would have to be modified to insert the appropriate sub-directory between the device name and file name before searching for the file. The program logic would simply copy the first letter of the file name and insert it in the pathname as th(A through L). The program creates its own file names for the email and data files. The first letter of each file name corresponds to the month that the file was created (A=January, B=February, etc.). The COMMENTS.TEXT and possibly MAIL.TEXT sourned to store data files only, both library and email files. This significantly sped up launching the program, logging on, and viewing files. I had intended to further modify the program to fragment the INFONET sub- directory into 12 sub-directories o sub-directories. INFONET.STUFF was created and referred to in the program to store the greeting files, the Log File, the User Data File, the Index File, and the BBS and Sysop Utilities program files. The original INFONET sub-directory was retaien to store all files in one sub-directory. This included the program files, User File, Index File, and all data files. As ///'s Company grew to over 1,200 data files, this significantly slowed down performance. I then modified the program to use twd (not the contents, however), and whether they attempted to chat with me. This allowed me to see which parts of the BBS were the most interesting to callers, and whether they needed to talk to me about something. - the program was originally writtte with any particular combination of equipment. The typical user of this BBS will notice few differences in the regular Infonet menus. One major change was to allow the input of numbers on Mail and Classified menus so that a selection could be accomplished in one step. At 300 baud, the two step selection process is ponderous. There is no indication to the user that he can do this, so a note somewhere is probably a good idea. Flow control was implemented WITHOUT Xon/Xoff. Xon/Xoff work just fine thougd the modem, you don't have to log off with the L command and then go through the startup procedure from USRUTIL. Instead, choose P (Phone), which will switch "channel" back to 7 and go back to waiting for the phone to ring. .ff I use a Hayes Smartmodem d let you log in. This is a lot faster than the old method of going through USRUTIL so you could type an R there just to change "channel" from 7 to 2. Likewise, when you are using the system from the console and want to log off and return control towarance, but you can). When you want to quit running the BBS, use OA-Q (Quit). This is not necessary if all you really wanted to do was get on the BBS from the ///'s keyboard. Instead, type OA-2 (for channel:=2) and the program will switch to local mode ang to the user. He can still ring you. If you are like me, you probably don't really know whether you are in or out anyway, so you can call in and use the G and H commands from the utility menu (I'm not sure why you'd want to use the H command from a distorce if the user is busy seeing text float by. The "chat" facility has been reinstated and seems to work. You can let the user know that you are in or out by using OA-G (Gone) or OA-H (Here). All this really does, at present, is change the calling dialocessary. OA-X (Xxxx...) will erase the contents of "opnote". Also handy to help the uninitiated is the ability to monitor the output from the /// to the user on the ///'s CRT. This function is toggled by OA-M (Monitor). It may take a bit to come into fy CR's so the user can see the whole line. The user will NOT be reprompted if he's at a menu, so you may need to send another line telling him to go ahead where he was interrupted. This function can be useful to lead the really confused by the hand if neacter string, called "opnote", that you can enter data into from the ///'s keyboard at almost any time. A single line of text. You can send it to a logged-in user by typing OA-N (Note capitalization counts here). The note will be preceded and followed b exit the program. The original idea was to keep errant, possibly juvenile or canine, fingers from blowing things up. But as long as it was going to look at the keystroke, anyway, it might as well be able to do some other things too. There is an 80 charThat part of "dump"'s problems was eliminated by not echoing the data back to the user during a "dump". .ff From the operator's perspective there are a number of changes and additions. The major one was requiring a specific input on the ///'s keyboard toose to the time it's actually typed, only a small number of characters are allowed to accumulate in the output buffer. This caused problems in the "dump" method of putting data on the system because the user's input would get ahead of the echoed output. s change. At first, it did not seem to work. The reason was that the RS232 driver's output buffer would get filled very rapidly and for short messages this would be the whole thing before the CNTL-C got entered. So, to keep the response to the CNTL-C clxt flow and the user will think something is wrong. Again, a note is recommended as a means of minimizing problems with this. One exception to the "any character" is CNTL-C. It aborts the flow of text. An interesting problem was uncovered because of thih because any user character recieved during text dumping will toggle the flow. The user can just hit the space bar and stop the text and hit it again to start it up again. One disadvantage of this approach is that the lazy hand can interfere with the te1200 and occasionally it seems to vanish into hyperspace for no apparent reason. It's probably something I'm doing wrong, but I have yet to figure out what it is. Anyway, whenever you set the BBS up to respond to the modem, you want to make sure that the BBS responds with a message, "Waiting for phone calls" on the ///'s CRT. This means that the modem responded to the initialization process correctly. If you don't see this message, the initialization process will repeat and the /// will beep at you. Yoone is answered. They refer to "North Umpqua Midnight Oil". I suspect you'll want to put in your own thing. (Umpqua is a river) The "other problem" with the "dump" function is that when the /// is converting a seedling file (one with less than 513 bytesested procedure identification comments useful. I was completely lost until I put them in. There is a built in "title" for the BBS in two places. One is displayed on the ///'s CRT when the program is started and the other is sent to the user when the phin the various "makecmds" subroutines. The variables had to be made global with my simplistic approach, so I also made a single menu response getter function. This is where the ability to put numbers into a menu response arose. .ff I hope you find the nsimply be tossed. All the menus are built both as strings and as sets of char. Since the sets of char contain the same codes as the strings, there is now a single subroutine that builds them from strings. This just about halved the number of statements file name is a simply encoded date and time. NOTE: You must have a clock to run this code successfully! There's bunch of giggery-pokery with file names at various points in the program that I did not take the time to analyse. I suspect most of it can te for the clock's funny behavior) instead of trying several chosen at random. When putting data on the BBS now, the filename is output for the user's reference. It could be handy if there is some sort of problem and you are trying to track it down. TheThe file name choosing function was replaced, also. There was nothing all that terrible about the one that was used, but I felt that it was better to compute one file name that would be unique (except maybe for leap years on Mar 1, or however you compensainputting information to the BBS. As near as I could tell, this was done to compensate for knowing what the file name was ahead of time. So some small changes were made to the regular data input code to allow for this and the stuff in Hello was tossed. nsiderably. Some particularly funny looking names are just contractions of the repetitive sequence of calls they replace, like: sqcfile <--> Seek(); Get(CFILE...). One real big cut was the Hello file section. It practically replicated all the code for is and I keep forgetting). The original had several code structures that were replicated (or nearly so) in various parts of the program. These have been turned into procedures and functions to save space. In several cases, it also simplified the code coa bit better. In case you need to space it out a bit use the CR key. Not being a compleat Pascal'er, I'm sure that this thing can stand a lot of work. But it seems to work the way it's supposed to (of course, I'm the only one who knows what that really p the modem from responding to calls. Of course, if your modem is not Hayes compatible, you'll have to work all this out for yourself anyway. There is a lot more stuff on the ///'s CRT, even when not monitoring. This should help you see what's going on n-autoanswer state. The answering of calls is done by detecting the "RING" response and specifically going off hook. One advantage of this approach is that when you are mucking about with your /// and the BBS is down, you don't have to do anything to keeu can turn the modem off and back on again and this usually brings the modem back from its etherial wanderings. Once the modem does respond properly, there is a timeout interval at which it will be reinitialized "just in case". The modem is put into a no) to a sapling file (one with more than 512 bytes but less than 128K+1) the system has a lot of work to do and a 5M ProFile won't let it happen fast enough to keep up with 1200 baud data input flow. This problem was side-stepped by writing two blocks to the disk and then resetting the file before letting the user send any data. When your users start putting tree files on your system, you'll have to solve this problem again for yourself. In addition to this little trick, the program minimizes trips througINFONET BBS contact try the program itself at (503) 672-0453 virtually anytime. .ffledge the aid and encouragement of Dr. Wm. Roady. This work would not have been done without it. While I have not asked him, I suspect that if you CompuServe and have questions or comments he'd be willing to relay them. In the event you want more directit. I couldn't see any real good reason for it, so this one doesn't have any. You will probably notice that the USRUTIL program has not been touched. There are some things I'd like to do with it, but it will have to wait for a while. I'd like to acknowh SOS by soaking up hunks of serial input to a buffer rather than taking one byte at a time and writing them to the file. If you are going to run at 2400 (or faster) I'd be curious to know how you fare. The Sun released Infonet had some assembly code in