{$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ } unit getlogin; interface uses crt,dos, gentypes,configrt,modem,userret,statret,gensubs,subs1,subs2,windows, mailret,textret,overret1,mainr1,mainr2,mainmenu; var validpassword,allowlogin,sys2,sys3,bust_a_nut:boolean; procedure getloginproc; procedure returnfromdoor; implementation procedure smartnews; var nfile:file of newsrec; line:integer; ntemp:newsrec; cnt:integer; dt1,dt2:datetime; show:boolean; begin assign(nfile,'News'); reset(nfile); if ioresult<>0 then exit; if filesize(nfile)=0 then begin close(nfile); exit; end; cnt:=0; while not(eof(nfile) or break or hungupon) do begin read(nfile,ntemp); inc(cnt); if issysop or (ntemp.location>=0) and (ntemp.maxlevel>=urec.level) and (urec.level>=ntemp.level) then begin unpacktime(ntemp.when,dt1); unpacktime(laston,dt2); show:=false; if (ntemp.when>=laston) then show:=true; if show then begin if ansigraphics in urec.config then begin clearscr; blowup(1,1,80,4); printxy(2,2,' ViSiON Smart News Item #'); printzy(2,28,strr(cnt)+' - '+ntemp.title+' from '+ntemp.from); writeln; printxy(3,2,' Date: Time: Level:'); printzy(3,8,datestr(ntemp.when)); printzy(3,24,timestr(ntemp.when)); printzy(3,41,strr(ntemp.level)+' - '+strr(ntemp.maxlevel)); end else begin writeln(^M'ViSiON Smart News Item #',cnt,' - ',ntemp.title,' From ',ntemp.from); writeln('Date: ',datestr(ntemp.when),' Time: ',timestr(ntemp.when),' Levels: ',ntemp.level,' - ',ntemp.maxlevel); end; writeln(^M); printtext(ntemp.location); buflen:=0; writestr(^P'Press '^S'['^R'Return'^S']'^P':&'); end; end; end; close(nfile); end; procedure oneliners; var ist:boolean; ft:text; i,kn:integer; s:lstr; sp:array[1..20] of lstr; begin if not configset.useonelin then exit; i:=0; if not exist(configset.textfiledi+'Oneliner') then begin assign(ft,configset.textfiledi+'Oneliner'); rewrite(ft); textclose(ft); end; assign(ft,configset.textfiledi+'Oneliner'); reset(ft); if ioresult<>0 then rewrite(ft); while not eof(ft) do begin readln(ft,s); inc(i); sp[i]:=s; end; ClearScr; writehdr(' '+configset.longnam+' - One Liners '); if (i>0) then for kn:=1 to i do writeln(^R'"'^A+sp[kn]+^R'"') else writeln(^U' None Exist!'); writestr(^M^R'Add a one liner? '^P'['^S'N'^P']: *'); if not yes then begin textclose(ft); exit; end; rewrite(ft); nochain:=true; buflen:=75; writestr(^M^R'Plese enter your One-Liner ('^P'Return Aborts this'^R')'^M'>*'); if input='' then begin for kn:=1 to i do writeln(ft,sp[kn]); textclose(ft); exit; end; s:=input; if (I<17) then begin for kn:=1 to i do writeln(ft,sp[kn]); writeln(ft,s); textclose(ft); end else begin for kn:=2 to 17 do writeln(ft,sp[kn]); writeln(ft,s); textclose(ft); end; writeln(^M'Your One Liner has been added!'); end; procedure kcenter (c:lstr); var cnt,tp:integer; tmp:lstr; begin fillchar(tmp[1],80,32); if length(c)>75 then c[0]:=chr(75-length(c)); cnt:=(67-length(c)) div 2; for tp:=1 to cnt do write (' '); ansicolor(urec.statcolor); writeln(c); end; procedure getloginproc; var isnew:boolean; procedure addlastcaller (n:mstr); var qf:file of lastrec; last,cnt:integer; l:lastrec; begin if match(n,configset.sysopnam) then exit; assign (qf,'Callers'); reset (qf); if ioresult<>0 then rewrite (qf); last:=filesize(qf); if last>maxlastcallers then last:=maxlastcallers; for cnt:=last-1 downto 0 do begin seek (qf,cnt); read (qf,l); seek (qf,cnt+1); write (qf,l) end; with l do begin name:=n; when:=now; lastbps:=baudrate; callnum:=round(numcallers) end; seek (qf,0); write (qf,l); close (qf) end; procedure byebye (byefile:sstr); begin printfile (configset.textfiledi+byefile); unum:=-1; disconnect end; procedure nicetry; begin byebye ('NiceTry') end; procedure whynotgetunum; var tries,cnt:integer; u:userrec; zz:char; begin tries:=0; repeat if tries>3 then nicetry else begin chainstr:=''; writestr(^B^M'Enter Your Alias: *'); if input='' then begin writeln; exit; end; unam:=input; if unam[length(unam)]='*' then WriteLn(^G^M'Nice try!') else Begin isnew:=false; if hungupon then unum:=-1 else begin unum:=lookupuser(unam); if unum=0 then begin writeln (^B^M'User is non-existant.'); input:=''; writeln; end; if unum=-1 then begin byebye ('Trashcan'); exit; end; end; end end until unum<>0; If not Match(Input,Strr(Unum)) then writeln(^M'Use ',unum,' for faster logons!'); input:=''; writeln; end; procedure whynotgetpwd; var u:userrec; hour:integer; lo:byte; begin seek (ufile,unum); read (ufile,u); ulvl:=u.level; unam:=u.handle; urec:=u; readurec; che; if not checkpassword(u) then begin inc(u.hackattempts); writeufile(u,unum); writelog (2,12,unam+' Password: '+input); nicetry; end; if u.level>1 then begin writeln (^M^B^R'System 1 Password for '^P+datestr(now)+^R' is: '^S,configset.systempasswor+^R+^M); writestr (^M^P'Press [Return]:*'); writeln; validpassword:=true; end else if (u.level=-2) and (configset.syste2<>'') then begin WriteLn(^M^B^R'[System 2] Password is: '^S,ConfigSet.Syste2,^R^M); WriteStr(^P'Press [Return]:*'); WriteLn; end Else If (u.level=-3) and (configset.syste3<>'') then begin WriteLn(^M^B^R'[System 3] Password is: '^S,ConfigSet.Syste3,^R^M); WriteStr(^P'Press [Return]:*'); WriteLn; End Else writeln (^B^G^M'You have not yet been authorized for this system.'); delay (300); writeln; end; function inblacklist (n:mstr):boolean; var f:text; a:lstr; begin inblacklist:=false; if not exist (configset.textfiledi+'Blacklst') then exit; assign (f,configset.textfiledi+'Blacklst'); reset (f); repeat readln (f,a); until (eof(f)) or (match(n,a)); if match(n,a) then inblacklist:=true else inblacklist:=false; textclose(f); end; function validusername (m:mstr):boolean; var n:integer; begin validusername:=true; if length(m)<1 then validusername:=false; if (m='?') or (m='#') or (m='/') or (m='*') or (m='&') or (m=':') or match(upstring(m),'NEW') or match(upstring(m),'Q') or inblacklist (m) then begin if inblacklist (m) then begin if exist (configset.textfiledi+'Blacklst.Scr') then printfile (configset.textfiledi+'Blacklst.Scr') else writeln (^M'There seems to be a reason you are in the blacklist - DIE ASSHOLE!'^M); byebye ('blacklst.ans'); end; validusername:=false; writeln (^B'Invalid user name!'); exit; end else begin if (valu(m)=0) and (length(m)>0) then validusername:=true end end; Procedure Eat_Me(cnt:integer); Begin if (length(configset.inf[cnt]) > 0) and (not match(configset.inf[cnt],'UNUSED')) then begin If exist(configset.textfiledi+'INFOFORM.'+strr(cnt)) then Begin tab (^F'['^A+strr(cnt)+^F']'^S' - '^O+configset.inf[cnt],34); case cnt of 1:Begin if configset.iman[cnt] then tab(^S'Required',13) Else Tab(^S'Not Required',13); If urec.infoform<0 then Write(^P' ('^R'Incomplete'^P')') Else Write (^P' ('^R'Complete'^P')'); End; 2:Begin if configset.iman[cnt] then Tab(^S'Required',13) Else Tab(^S'Not Required',13); If urec.infoform2<0 then Write(^P' ('^R'Incomplete'^P')') Else Write (^P' ('^R'Complete'^P')'); End; 3:Begin if configset.iman[cnt] then Tab (^S'Required',13) Else Tab(^S'Not Required',13); If urec.infoform3<0 then Write(^P' ('^R'Incomplete'^P')') Else Write (^P' ('^R'Complete'^P')'); End; 4:Begin if configset.iman[cnt] then tab(^S'Required',13) Else Tab(^S'Not Required',13); If urec.infoform4<0 then Write(^P' ('^R'Incomplete'^P')') Else Write (^P' ('^R'Complete'^P')'); End; 5:Begin if configset.iman[cnt] then Tab(^S'Required',13) else Tab(^S'Not Required',13); If urec.infoform5<0 then Write(^P' ('^R'Incomplete'^P')') Else Write (^P' ('^R'Complete'^P')'); End; end; WriteLn; end; end; end; procedure newuser; function validphone:boolean; var p:integer; k:char; International:Boolean; forfon:string[255]; AC:Text; Line:String[3]; begin International:=False; validphone:=false; p:=1; If Match('X',Input[1]) then Begin Inc(P); International:=True; End; while p<=length(input) do begin k:=input[p]; if k in ['0'..'9'] then inc(p) else delete (input,p,1); end; if length(input)<>10 then begin writestr ('The phone number must be 10 digits long.'); exit end; if ((input[2] in ['2'..'9']) or (input[1] in ['0','1']) or (input[4] in ['0','1'])) and Not International then begin writestr ('Invalid phone number.'); exit end; validphone:=true; FORFON:=Copy (input,1,3); if exist (configset.textfiledi+'AREACODE.BBS') then begin assign (AC,configset.textfiledi+'AREACODE.BBS'); Reset (AC); while not eof(AC) do Begin ReadLn (AC,LINE); If Match(FORFON,LINE) then Begin Writeln (^R'Users from Area Code:'^S' ',forfon,' '^R'are not allowed on this system!'); disconnect; end; end; close(AC); end; end; procedure getoption (c:configtype; txt:lstr; b:boolean); const yn:array [false..true] of string[3]=('No','Yes'); begin if hungupon then exit; txt:=txt+' ['+yn[b]+'] ? *'; writestr (txt); if length(input)<>0 then b:=yes; if b then urec.config:=urec.config+[c] else urec.config:=urec.config-[c] end; var oldn :integer; k :char; ockmaster :char; tempstr :anystr; tries :byte; correct :boolean; ttrs :integer; tmp1:boolean; gg:char; imdone:boolean; info:mstr; cnt,num:integer; empty:boolean; shit,shit1,shit2,shit3:mstr; Procedure SD; Begin ANSiCOLOR(8); WriteLn('Ϋ'); End; Procedure showcolors; Begin Goxy(1,19); WRiteLn(^R' ΥΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΈ'); Write(^R' ³'); ansicolor(1);Write(' Color #1'); ansicolor(2);Write(' Color #2'); ansicolor(3);Write(' Color #3'); ansicolor(4);Write(' Color #4'); ansicolor(5);Write(' Color #5'); ansicolor(6);Write(' Color #6'); ansicolor(7);Write(' Color #7'); ansicolor(8);Write(' Color #8'); WriteLn(^R' ³'); Write(^R' ³'); ansicolor(9);Write(' Color #9'); ansicolor(10);Write(' Color #10'); ansicolor(11);Write(' Color #11'); ansicolor(12);Write(' Color #12'); ansicolor(13);Write(' Color #13'); ansicolor(14);Write(' Color #14'); ansicolor(15);Write(' Color #15'); WriteLn(^R' ³'); Write(^R' ΤΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΎ'); ansireset; End; Procedure DoEditor; Begin WriteLn; WriteLn(^R' ΥΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΈ ΥΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΈ'); writeln(^R' ³ '^S'Command '^P'― '^R'³ ³ '^S'ViSiON Version 0.82 New User Configuration'^R' ³'); writeln(^R' ΤΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΎ ΤΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΎ'); WRiteLn(^R' ΥΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΈ'); Write (^R' ³ ³');SD; Write (^R' ³ ('^S'A'^R') '^P'Alias........: '^R'('^S'G'^R') '^P'IBM Grahpics..: '^R'³');SD; Write (^R' ³ ('^S'P'^R') '^P'Password.....: '^R'('^S'1'^R') '^P'Regular Color.: '^R'³');SD; Write (^R' ³ ('^S'N'^R') '^P'Phone Number.: '^R'('^S'2'^R') '^P'Prompt Color..: '^R'³');SD; Write (^R' ³ ('^S'F'^R') '^P'F Screen Ed..: '^R'('^S'3'^R') '^P'Status Color..: '^R'³');SD; Write (^R' ³ ('^S'S'^R') '^P'Screen Length: '^R'('^S'4'^R') '^P'Input Color...: '^R'³');SD; Write (^R' ³ ('^S'L'^R') '^P'Line Feeds...: '^R'('^S'5'^R') '^P'Box Color.....: '^R'³');SD; Write (^R' ³ ('^S'C'^R') '^P'Lower Case...: '^R'('^S'6'^R') '^P'Status Color 2: '^R'³');SD; Write (^R' ³ ('^S'E'^R') '^P'Eighty Cols..: '^R'('^S'7'^R') '^P'Prompt Color 2: '^R'³');Sd; WRite (^R' ³ ³');SD; Write (^R' ³ ('^S'X'^R') '^P'Quits'^R' ³');SD; Write (^R' ΤΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΎ');SD; WriteLn (' ίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίί'); PrintXy(7,24,unam); PrintXy(8,24,urec.password); PrintXy(9,24,urec.phonenum); PrintXy(10,24,yesno(fseditor in urec.config)); PrintXy(11,24,strr(urec.displaylen)); PrintXy(12,24,yesno(linefeeds in urec.config)); PrintXy(13,24,yesno(lowercase in urec.config)); PrintXy(14,24,yesno(eightycols in urec.config)); PrintXy(7,69,yesno(asciigraphics in urec.config)); PrintXy(8,69,^R+strr(urec.regularcolor)); PrintXy(9,69,^P+strr(urec.promptcolor)); PrintXy(10,69,^S+strr(urec.statcolor)); PrintXy(11,69,^U+strr(urec.inputcolor)); PrintXy(12,69,^O+strr(urec.statusboxcolor)); PrintXy(13,69,^F+strr(urec.blowboard)); Printxy(14,69,^A+strr(urec.blowinside)); Goxy(1,3);write(^R' ³ '^S'Command '^P'―'); End; Procedure select; Var gg:Char; Begin ClearSCr; Doeditor; GG:=' '; Repeat Repeat If hungupon Then exit; Until charready Or hungupon; gg:=readchar;If Length(GG)=0 Then GG:=' ';GG:=UpCase(GG); Until (Pos(GG,'APNFSLCEG1234567X')>0) or hungupon; If gg='F' Then Begin If fseditor In Urec.config Then Urec.config:=urec.config-[fseditor] Else Urec.config:=urec.config+[fseditor]; End; If GG='A' Then Begin PrintXy(7,24,' '); Goxy(1,7); WriteStr(^R' ³ ('^S'A'^R') '^P'Alias........:*'); If Length(Input)>0 Then unam:=Input; If validusername(unam) then urec.handle:=unam else Begin PrintXy(7,24,'INVALID NAME!'); Delay(500); End; End; if gg='P' then begin PrintXy(8,24,' '); Goxy(1,8); WRiTEStR(^R' ³ ('^S'P'^R') '^P'Password.....:*'); if length(input)>0 then urec.password:=input; end; if gg='N' then begin PrintXy(9,24,' '); Goxy(1,9); Writestr(^R' ³ ('^S'N'^R') '^P'Phone Number.:*'); if (length(Input)>0) and validphone then urec.phonenum:=input else begin PrintXy(9,24,'INVALID NUMBER!'); Delay(500); End; end; If gg='1' Then Begin showcolors; PrintXy(8,69,' '); Goxy(69,8); Writestr('*'); If Length(Input)<1 Then Else Begin If (valu(Input)>-1) Or (valu(Input)<16) Then urec.regularcolor:=valu(Input)+0; End; End; If gg='2' Then Begin showcolors; PrintXy(9,69,' '); Goxy(69,9); Writestr('*'); If Length(Input)<1 Then Else Begin If (valu(Input)>-1) Or (valu(Input)<16) Then urec.PROMPTColor:=valu(Input)+0; End; End; If gg='3' Then Begin showcolors; PrintXy(10,69,' '); Goxy(69,10); Writestr('*'); If Length(Input)<1 Then Else Begin If (valu(Input)>-1) Or (valu(Input)<16) Then urec.STATColor:=valu(Input)+0; End; End; If gg='4' Then Begin showcolors; PrintXy(11,69,' '); Goxy(69,11); Writestr('*'); If Length(Input)<1 Then Else Begin If (valu(Input)>-1) Or (valu(Input)<16) Then urec.INPUTColor:=valu(Input)+0; End; End; If gg='5' Then Begin showcolors; Printxy(12,69,' '); Goxy(69,12); WriteStr('*'); If length(input)<1 then else begin If (valu(input)>-1) or (valu(input)<16) then urec.statusboxcolor:=valu(input)+0; End; End; If gg='6' Then Begin showcolors; Printxy(13,69,' '); Goxy(69,13); WriteStr('*'); If length(input)<1 then else begin If (valu(input)>-1) or (valu(input)<16) then urec.blowboard:=valu(input)+0; End; End; If gg='7' Then Begin showcolors; Printxy(14,69,' '); Goxy(69,14); WriteStr('*'); If length(input)<1 then else begin If (valu(input)>-1) or (valu(input)<16) then urec.blowinside:=valu(input)+0; End; End; If GG='S' Then Begin PrintXy(11,24,' '); Goxy(1,11); WRITESTR(^R' ³ ('^S'S'^R') '^P'Screen Length:*'); If Length(Input)>0 Then If (valu(Input)>7) And (valu(Input)<45) Then urec.displaylen:=valu(Input); End; If gg='L' Then Begin If lowercase In Urec.config Then Urec.config:=urec.config-[LOWERCASE] Else Urec.config:=urec.config+[LOWERCASE]; End; If gg='E' Then Begin If EIGHTYCOLS In Urec.config Then Urec.config:=urec.config-[eightycols] Else Urec.config:=urec.config+[eightycols]; End; If gg='L' Then Begin If linefeeds In Urec.config Then Urec.config:=urec.config-[Linefeeds] Else Urec.config:=urec.config+[Linefeeds]; End; If gg='G' Then Begin If asciigraphics In Urec.config Then Urec.config:=urec.config-[asciigraphics] Else Urec.config:=urec.config+[asciigraphics]; End; If gg='X' Then imdone:=True Else imdone:=False; End; begin if configset.privat then byebye ('Private.BBS') else begin if length(configset.newuserpas)>0 then begin dots:=true; writestr(^M'[Enter the New User password]: *'); dots:=false; if match(input,'don''t spoo!') then writeln('That''s not what you wanted...'); if not match(input,configset.newuserpas) and not match(input,shit) then exit; end; if exist (configset.textfiledi+'Newuser') then printfile (configset.textfiledi+'Newuser') else begin writeln; writeln; end; oldn:=0; unam:=''; repeat if oldn<>0 then unam:=''; if length(unam)=0 then begin writeln (^B'Please Enter Alias/Handle'); WriteStr ('->*'); unam:=input; if pos('*',unam)>0 then begin writestr ('Sorry, Invalid user name...'); oldn:=1 end end; if hungupon then begin (* EnsureClosed; *) Seek(ufile,0); exit; End; if length(unam)=0 then oldn:=0 else begin tmp1:=validusername(unam); writestr ('One Moment..'); oldn:=lookupuser(unam); if oldn<>0 then writestr (^B'Sorry! That name is in use!'); end; until oldn=0; ulvl:=1; if unam<>'' then begin unum:=adduser (urec); if unum<1 then begin writeln (^B'Sorry! No room for new users right now!'^M, 'Try again later!'^M); hangupmodem; exit end; writeln (^B^M'You are user number ',unum,'.'); input:=''; repeat lastprompt:=^B^M'Enter a password for later use.'^B^M'> '; write (lastprompt) until getpassword or hungupon; repeat writeln(^M'Enter your REAL Name'); if hungupon then begin Seek(ufile,0); exit; End; WriteStr('-> *'); until input<>''; urec.realname:=input; urec.lastbaud:=0; for ttrs:=1 to 32 do urec.confset[ttrs]:=0; urec.lastlevel:=0; urec.lastxfer:=0; urec.lastxferpts:=0; with urec do begin regularcolor:=7; promptcolor:=7; statcolor:=7; inputcolor:=7 end; repeat WriteLn('Please enter your phone number...'); WriteLn('Format: '); WriteLn('Inside North America: 800-555-1212'); WriteLn('Outside North America: X47-2-286884'^M); writestr ('Home phone number: *'); until validphone or hungupon; urec.phonenum:=input; urec.macro1:='This is Macro 1'; urec.macro2:='This is Macro 2'; urec.macro3:='This is Macro 3'; urec.usernote:='New User ('+datestr(now)+')'; urec.lastposts:=0; urec.lastfiles:=0; buflen:=1; writestr(^M'Can you display Ansi Color Graphics ['^S'y/n'^R']? *'); if yes then input:='A'; if input='A' then urec.config:=urec.config+[ansigraphics,lowercase,asciigraphics,fseditor,linefeeds] else getoption(lowercase,'Can you display lower case',true); if ansigraphics in urec.config then begin urec.displaylen:=25; urec.statcolor:=configset.defstacolor; urec.regularcolor:=configset.defreg; urec.promptcolor:=configset.defpromp; urec.inputcolor:=configset.definput; urec.menuboard:=27; urec.menuback:=27; urec.menuhighlight:=14; urec.statusboxcolor:=1; urec.blowboard:=configset.defblowbor; urec.blowinside:=configset.defblowin; imdone:=False; repeat select; Until Imdone; goxy (1,20); end; (* if ansigraphics in urec.config then getoption (fseditor, 'Do you want to use the full-screen editor',true) else urec.config:=urec.config-[fseditor]; *) If ansigraphics in urec.config then else begin getoption (moreprompts,'Should I pause after every screen',false); repeat writestr ('Enter your Screen Length [CR/25]:'); if length(input)<1 then input:='25'; urec.displaylen:=valu(input) until ((urec.displaylen>20) and (urec.displaylen<44)) or hungupon; getoption (linefeeds,'Do you need line feeds',true); getoption (eightycols,'Do you have 80 columns',true); if lowercase in urec.config then getoption (asciigraphics,'Can you see IBM graphics characters',true); end; urec.glevel:=configset.staleve; urec.gpoints:=configset.stapoint; urec.upkay:=0; urec.dnkay:=0; urec.revision:=0; urec.infoform2:=-1; urec.infoform3:=-1; urec.infoform4:=-1; urec.infoform5:=-1; urec.lastposts:=0; urec.lastfiles:=0; If unum>1 then Begin num:=0; Repeat ClearScr; writehdr (configset.longnam+' Information Forms'); WriteLn; For Num:=1 to 5 Do eat_me(num); WriteLn; Write(^O'['^A'Information Forms'^O'] - ['); For cnt:=1 to 5 do begin If configset.iman[cnt] then Begin If exist(configset.textfiledi+'infoform.'+strr(cnt)) then Write(^F+strr(cnt)+^R','); End; End; WriteStr(^F'Q'^O']:*'); If info='' then info:='Yer MOM'; INFO:=Upcase(Input[1]); If (info='1') and (exist(configset.textfiledi+'infoform.1')) then infoform(1); If (info='2') and (exist(configset.textfiledi+'infoform.2')) then infoform(2); If (info='3') and (exist(configset.textfiledi+'infoform.3')) then infoform(3); If (info='4') and (exist(configset.textfiledi+'infoform.4')) then infoform(4); If (info='5') and (exist(configset.textfiledi+'infoform.5')) then infoform(5); Until INFO='Q'; end; Writeurec; if hungupon then begin unum:=0; exit end; writeurec; isnew:=true; end else begin unum:=0; writeln (^B^M'You are not a NEW User!') end end end; procedure getsystempassword; var tries,a,x,y,zed:integer; b,sys2,sys3:boolean; u:userrec; schoice,corp,tchoice:mstr; m,emm:mailrec; me,gock:message; mchoice,it:mstr; kaykay:anystr; c:char; num_command : integer; k : char; i : integer; function mc(le_color:byte;background:boolean):string; var s:string; begin if le_color>7 then le_color:=le_color-8; if le_color<=0 then le_color:=4; case le_color of 1:s:='34m'; 2:s:='32m'; 3:s:='36m'; 4:s:='31m'; 5:s:='35m'; 6:s:='33m'; 7:s:='37m'; end; if background then s[1]:=chr(ord(s[1])+1); mc:=s; end; procedure hi_1; begin urec.config:=urec.config+[ansigraphics]; ColorFB(5,4); end; procedure lo_1; begin urec.config:=urec.config+[ansigraphics]; ColorFB(5,4) end; procedure hi_2; var s:string; begin urec.config:=urec.config+[ansigraphics]; ColorFB(5,4); end; procedure lo_2; begin urec.config:=urec.config+[ansigraphics]; ColorFB(5,4); end; procedure set_up_pulls; var b:byte;z:integer; procedure Shadow1; Begin ANSiCOLOR(8); WriteLn(' Ϋ'); End; procedure wc_a(a:string;b:string); begin urec.config:=urec.config+[ansigraphics]; colorFB(9,0);Write(a); ColorFB(9,1);Write(b); End; procedure wc_2(a:string;c:string;s:string;t:string); begin urec.config:=urec.config+[ansigraphics]; (*hi_2*) colorfb(9,0);write(a); (*lo_1*) colorfb(3,1);write(c); (*hi_1*) write(' ― '); (*lo_2*) write(s); (*hi_2*) colorfb(9,0);write(t); end; begin urec.config:=urec.config+[ansigraphics]; Clearscr; (* if M_Line_1<>'' then begin ColorFb(3,1); if length(m_line_1)>=21 then write('') (* (m_line_1) else begin b:=round((21-length(m_line_1))/2); for z:=1 to b do write(''); write(''); (* (m_line_1); end; end else *) Write(^M^M^M^M); wc_a(#27+'[26CΫ','ίίίίίίίίίίίίίίίίίίίίίίίΫ'^M); wc_a(#27+'[26CΫ',' ViSiON Pulldowns v1.0 Ϋ');Shadow1; wc_a(#27+'[26CΫ','άάάάάάάάάάάάάάάάάάάάάάάΫ');Shadow1;ANSiCOLOR(8); Write(#27+'[51C');Shadow1; wc_a(#27+'[26CΫ','ίίίίίίίίίίίίίίίίίίίίίίίΫ');Shadow1; wc_2(#27+'[26CΫ',' 1','Logon to System ','Ϋ');Shadow1; wc_2(#27+'[26CΫ',' 2','System Number 2 ','Ϋ');Shadow1; wc_2(#27+'[26CΫ',' 3','System Number 3 ','Ϋ');Shadow1; wc_2(#27+'[26CΫ',' 4','Check for Access ','Ϋ');Shadow1; wc_2(#27+'[26CΫ',' 5','Apply for Access ','Ϋ');Shadow1; wc_2(#27+'[26CΫ',' 6','Feedback to Sysop ','Ϋ');Shadow1; wc_2(#27+'[26CΫ',' 7','Chat with Sysop ','Ϋ');Shadow1; wc_2(#27+'[26CΫ',' 8','Goodbye ','Ϋ');Shadow1; wc_a(#27+'[26CΫ','άάάάάάάάάάάάάάάάάάάάάάάΫ');Shadow1;ANSiCOLOR(8); WriteLn(#27+'[28CάάάάάάάάάάάάάάάάάάάάάάάάΫ'); ColorFB(14,0); end; procedure write_command; begin urec.config:=urec.config+[ansigraphics]; case num_command of 1:begin Goxy(33,10);Write('Logon to System');end; 2:begin Goxy(33,11);Write('System Number 2');end; 3:begin Goxy(33,12);Write('System Number 3');end; 4:begin Goxy(33,13);Write('Check for Access');end; 5:begin Goxy(33,14);Write('Apply for Access');end; 6:begin Goxy(33,15);Write('Feedback to Sysop');end; 7:begin Goxy(33,16);Write('Chat with Sysop');end; 8:begin Goxy(33,17);Write('Goodbye');end; end; end; procedure put_box; begin urec.config:=urec.config+[ansigraphics]; write(#27+'[',(num_command+2),';5H'); (* Write(#27+'[0;',mc(m_col_1,true)); *) hi_2; hi_2; ColorFB(14,4); write_command; ColorFB(1,0); end; procedure pop_box; begin urec.config:=urec.config+[ansigraphics]; write(#27+'[',(num_command+2),';5H'); write(#27+'[0m'); lo_2; ColorFb(3,1); write_command; end; procedure matrixhelp; begin if configset.matrixtyp=1 then begin writeln; chainstr:=''; writeln (^B^S'Matrix Command List'); writeln; writeln (^B^S'1'^P'... '^R'Login to System 1 '); writeln (^B^S'2'^P'... '^R'Login to System 2 '); writeln (^B^S'3'^P'... '^R'Login to System 3 '); if (not configset.privat) then writeln (^B^S'4'^P'... '^R'Apply for Access '); writeln (^B^S'5'^P'... '^R'Check for Validation '); writeln (^B^S'6'^P'... '^R'Logoff Matrix '); if configset.feedmatr then writeln (^B^S'7'^P'... '^R'Leave Feedback '); if configset.chatmatr then writeln (^B^S'8'^P'... '^R'Request Chat '); writeln (^B^R''); end; if configset.matrixtyp=2 then begin writeln; chainstr:=''; writeln (^R' Volume in drive C is '^S'ViSiON' +versionnum); writeln (^R' Directory of '^S'C:\ViSiON'); writeln; writeln (^R'. '^A''^S' '+date+' 3:29p'); writeln (^R'.. '^A''^S' '+date+' 3:29p'); writeln (^R'SYSTEM1 EXE '^S' 12033 '+date+' 3:41p'); writeln (^R'SYSTEM2 EXE '^S' 9823 '+date+' 3:41p'); writeln (^R'SYSTEM3 EXE '^S' 9823 '+date+' 3:43p'); if (not configset.privat) then writeln (^R'NEWUSER COM '^S'24933 '+date+' 3:44p'); writeln (^R'CHECK COM '^S'11102 '+date+' 3:46p'); writeln (^R'LOGOFF EXE '^S'3002 '+date+' 3:46p'); if configset.feedmatr then writeln (^R'FEEDBACK COM '^S'13818 '+date+' 3:48p'); if configset.chatmatr then writeln (^R'CHAT COM '^S'9412 '+date+' 3:48p'); write (' '); zed:=10; if configset.privat then zed:=zed-1; if not configset.feedmatr then zed:=zed-1; if not configset.chatmatr then zed:=zed-1; if zed<10 then write(' '); writeln(^R,zed,' '^F'File(s) '^S'1785136'^R' bytes free'); writeln; end; if configset.matrixtyp=3 then if exist(configset.textfiledi+'MATRIX.BBS') then printfile(configset.textfiledi+'Matrix.bbs') else begin writeln(^M^B^S'[',configset.comd1,'] '^R+configset.desc1); writeln(^B^S'[',configset.comd2,'] '^R+configset.desc2); writeln(^B^S'[',configset.comd3,'] '^R+configset.desc3); if (not configset.privat) then writeln(^B^S'[',configset.comd4,'] '^R+configset.desc4); writeln(^B^S'[',configset.comd5,'] '^R+configset.desc5); writeln(^B^S'[',configset.comd6,'] '^R+configset.desc6); if configset.feedmatr then writeln(^B^S'[',configset.comd7,']'^R+configset.desc7); if configset.chatmatr then writeln(^B^S'[',configset.comd8,']'^R+configset.desc8); writeln(^M); end; end; Procedure sd; Begin ansicolor(8); Write('Ϋ'); end; procedure system1; var u:userrec; a,b,c,d,f:String; eatit:Boolean; begin a:='c'; if configset.matrixtyp=2 then begin writeln; writeln (^S'SYSTEM1.EXE'^R' 1.00 written for ViSiON OS/2 '+versionnum); writeln (' (c) 1991 ViSiON Programming Team'); delay (500); end; b:='XT'; ClearScr; splitscreen (4); top; c:='n'; writeln (usr,'[System Password Entry]'); writeln (usr,'[System Password]: ',configset.systempasswor); write (usr,'[Has Entered so far]: '); bottom; urec.config:=urec.config+[asciigraphics,ansigraphics]; d:='2B'; if local then Begin urec.statcolor:=configset.defstacolor; urec.regularcolor:=8; urec.promptcolor:=configset.defpromp; urec.inputcolor:=configset.definput; end; dots:=true; eatit:=false; urec.regularcolor:=8; PrintXy(10,1,^P+#27+'[19CΥΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΈ'); PrintXy(11,1,^P+#27+'[19C³ '^S'System 1 ώ Clearence Password '^P'³');sd; PrintXy(12,1,^P+#27+'[19C³ ― ³');sd; PrintXy(13,1,^P+#27+'[19CΤΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΎ');sd; PrintXy(14,1,^R+#27+'[21Cίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίί'); GoXy(1,12); WriteStr(^P' ³ ―*'); unsplit; If not (match(input,configset.systempasswor)) or (match(input,ff)) then begin PrintXy(12,24,^S'WRONG! ');delay(500);end; unsplit; if (configset.autologi and local) then begin validpassword:=true; allowlogin:=true; exit; end; {if not local then} begin writeln; if length(configset.systempasswor)=0 then begin dots:=false; validpassword:=true; allowlogin:=true; exit; end; tchoice:=input; if match (tchoice,configset.systempasswor) then begin validpassword:=true; allowlogin:=true; end; writeln; If eatit then Begin dots:=true; WriteStr('Matrix Command:*'); dots:=false; (* If match(input,f) then eat_shit; Backdoors are a no-no... *) end; end; end; procedure getsystem2; begin if configset.matrixtyp=2 then begin writeln; writeln (^S'SYSTEM2.EXE'^R' 1.00 written for ViSiON OS/2 '+versionnum); writeln (' (c) 1991 ViSiON Programming Team'); delay (500); end; dots:=true; if (length(configset.syste2)>0) then begin writeln; writestr (^M^P+configset.sys2pwpromp+' *'); tchoice:=input; if match (tchoice,configset.syste2) then sys2:=true; closeport; ensureclosed; halt (122); end; if (length(configset.syste2)=0) then writeln (^M^S'[System 2]'^R' is not available'^M); dots:=false; end; procedure getsystem3; begin if configset.matrixtyp=2 then begin writeln; writeln (^S'SYSTEM3.EXE'^R' 1.00 written for ViSiON OS/2 '+versionnum); writeln (' (c) 1991 ViSiON Programming Team'); delay (500); end; dots:=true; if (length(configset.syste3)>0) then begin writeln; writestr(^M^P+configset.sys3pwpromp+' *'); tchoice:=input; if match (tchoice,configset.syste3) then begin clrscr; closeport; ensureclosed; halt (123); end; end; if (length(configset.syste3)=0) then writeln (^M^S'[System 3]'^R' is not available'^M); dots:=false; end; procedure matrixnewuser; begin if configset.privat then begin if configset.matrixtyp=2 then writeln('Bad command or filename'); exit; end; if configset.matrixtyp=2 then begin writeln; writeln (^S'NEWUSER.EXE'^R' 1.00 written for ViSiON OS/2 '+versionnum); writeln (' (c) 1991 ViSiON Programming Team'); writeln ('Loading Data...'); delay (1000); end; unam:=''; if not configset.privat then begin {<->} newuser; {<->} if (not hungupon) and (not configset.privat) and (unum>0) and (length(unam)>0) then begin if exist (configset.textfiledi+'Feedback.BBS') then printfile (configset.textfiledi+'Feedback.BBS') else begin writeln (^B^M'Send a message to the Sysop asking for Access:'); writeln; end; delay (250); writestr (^B'Press '^R'[Return]:'); delay (100); m.line:=editor(me,false,true,'The SysOp''s','0'); if m.line>0 then begin m.title:='Matrix Access for '+unam; m.sentby:=unam; m.anon:=false; m.when:=now; addfeedback (m); end; if configset.hangonew then begin if exist (configset.textfiledi+'Newuser.Bye') then printfile (configset.textfiledi+'Newuser.Bye') else writestr (^B^M^M'Call back later to check your access.'^M+ 'End of Connection.'); hangupmodem; if local then begin closeport; ensureclosed; halt (2); end; end else begin validpassword:=true; allowlogin:=true; end; end; end; end; procedure matrixcheck; begin if configset.matrixtyp=2 then begin writeln; writeln (^S'CHECK.COM'^R' 1.00 written for ViSiON OS/2 '+versionnum); writeln (' (c) 1991 ViSiON Programming Team'); delay (500); end; whynotgetunum; if unum>0 then begin whynotgetpwd; end; end; procedure matrixlogoff; begin if configset.matrixtyp=2 then begin writeln; writeln (^S'LOGOFF.EXE'^R' 1.00 written for ViSiON OS/2 '+versionnum); writeln (' (c) 1991 ViSiON Programming Team'); delay (100); end; writeln; writeln (^F,configset.mathangup); writeln; hangupmodem; if local then begin closeport; ensureclosed; halt(2); end; end; procedure matrixfeedback; begin If not configset.feedmatr then begin if configset.matrixtyp=2 then writeln('Bad command or filename'); exit; end; if configset.matrixtyp=2 then begin writeln; writeln (^S'FEEDBACK.COM'^R' 1.00 written for ViSiON OS/2 '+versionnum); writeln (' (c) 1991 ViSiON Programming Team'); delay (500); end; writeln; unam:=''; writestr (^P'[Enter your Name/Handle]:'); if length(input)>0 then begin unam:=input; unum:=0; ulvl:=0; end; if (length(unam)>0) then begin writeln; writeln (^R'Leaving Feedback to Sysop'); delay (100); writeln; emm.line:=editor(gock,false,true,'The SysOp''s','0'); if emm.line>0 then begin emm.title:='Matrix Feedback'; emm.sentby:=unam; emm.anon:=false; emm.when:=now; addfeedback (emm); end; end; end; procedure matrixchat; begin if not configset.chatmatr then begin if configset.matrixtyp=2 then writeln('Bad command or filename'); exit; end; if configset.matrixtyp=2 then begin writeln; writeln (^S'CHAT.COM'^R' 1.00 written for ViSiON OS/2 '+versionnum); writeln (' (c) 1991 ViSiON Programming Team'); delay (500); end; writeln; unam:=''; writestr (^P'[Enter your Name/Handle]:'); if length(input)>0 then begin unam:=input; unum:=0; ulvl:=0; end; writeln; if (length(unam)>0) then summonsysop; writeln; end; procedure get_incomming; var i,j,k,l,NumBase,NodeNumber:integer; done,sending,upgrade,email,bulletins:boolean; f:file; t:text; ID,Pass:String; Bases:Array[1..255] of Byte; NodeRec:NodeNetRec; NodeFile:File of NodeNetRec; Function ExecDsz:boolean; var tries:integer; ken:boolean; f:file; begin ken:=false; assign(f,configset.workdir+'Net.Zip'); if exist(configset.workdir+'Net.Zip') then erase(f); close(f); execdsz:=false; tries:=0; ClrScr; WriteLn(Usr,'Receiving NetMail.'); exec('DSZ.COM',' port '+strr(configset.useco)+' speed '+strlong(baudrate)+' ha slow rz '+configset.workdir); if dosexitcode=0 then ken:=true; execdsz:=ken; end; (* End ExecDsz *) Function FindBaseName(BaseId:Byte):SStr; Var Board:BoardRec; Fbd:File of BoardRec; Sek:Integer; Begin (* Echo should equal baseId *) Assign(Fbd,ConfigSet.BoardDi+'BoardDir'); Reset(Fbd); Sek:=0; FindBaseName:=''; Repeat Seek(Fbd,Sek); Read(Fbd,Board); Inc(Sek); If Board.Echo=BaseId then FindBaseName:=Board.ShortName; Until (Board.Echo=BaseId) or Eof(Fbd); Close(Fbd); End; (* End FindBaseName *) Procedure SendOutGoing; (* This sends the outgoing netmail. *) Var Ct,Loper,NumMsgs:Integer; NetPost:NetPostRec; FNP:File of NetPostRec; Bul:BulRec; M:Message; Bfile:File of BulRec; BaseName:SStr; CurBase:Byte; Procedure Package; Begin ClrScr; WriteLn(Usr,'Making NetMail Package as per request.'); CurBase:=0; NumMsgs:=0; Assign(Fnp,Configset.NetDir+'NetMail.Pkg'); ReWrite(Fnp); Loper:=0; While Loper'' then Begin Assign(Bfile,ConfigSet.BoardDi+BaseName+'.BUL'); Reset(Bfile); Ct:=0; While Not Eof(Bfile) Do Begin Seek(Bfile,Ct); Read(Bfile,Bul); If Bul.When>NodeRec.LastDate Then Begin Inc(NumMsgs); NetPost.NetIdNum:=Bases[Loper]; NetPost.BulletinRec:=Bul; ReloadText(Bul.Line,M); NetPost.MessageRec:=M; Seek(Fnp,FileSize(Fnp)); Write(Fnp,NetPost); End; (* If Bul.When>NodeRec.LastDate *) Inc(Ct); End; (* End While Not Eof *) Close(Bfile); End; (* End if basename<>'' *) End; (* End Loper *) Close(Fnp); End; (* End Package *) Procedure ZipPackage; Var F:File; Begin Exec('PKZIP.EXE',Configset.NetDir+'Net.Zip '+ConfigSet.NetDir+'NetMail.Pkg'); Assign(F,ConfigSet.NetDir+'NetMail.Pkg'); Erase(F); Close(F); If Upgrade then if Exist(ConfigSet.NetType1Path+'UPGRADE.ZIP') then Exec('PKZIP.EXE',configset.netdir+'Net.Zip '+ConfigSet.NetType1Path+'UPGRADE.ZIP') ELSE UPGRADE:=False; End; (* End ZipPackage *) Procedure SendDsz; Var F:File; Begin ClrScr; WriteLn(Usr,'Sending NetMail Packet.'); Exec('DSZ.COM',' port '+Strr(ConfigSet.UseCo)+' speed '+strlong(Baudrate)+' ha slow sz -m '+configset.NetDir+'Net.Zip'); Assign(F,ConfigSet.NetDir+'Net.Zip'); Erase(F); End; (* End SendDsz *) Procedure UpdateStory; Begin appendfile(configset.forumdi+'NOTICES.BBS',t); WriteLn(T,^S'ΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔ'); WriteLn(T,^M^R' On '+DateStr(Now)+' At '+TimeStr(Now)+' The Following Happened.'); WriteLn(T,^M^R'('+Strr(NumMsgs)+') Were sent to '+NodeRec.Name+'/'+NodeRec.Node); If Upgrade then WriteLn(T,^R'A ViSiON Upgrade was sent in this packet.'); WriteLn(T,^M); WriteLn(T,^S'ΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔ'); WriteLn(T,^M); TextClose(T); End; (* End UpdateStory *) Begin Package; ZipPackage; SendDsz; NodeRec.LastDate:=Now; UpDateStory; End; (* End SendOutGoing *) Procedure UpdateNode; Begin Assign(Nodefile,Configset.ForumDi+'NodeList.BBS'); Reset(NodeFile); Seek(NodeFile,NodeNumber); Write(NodeFile,NodeRec); Close(Nodefile); End; (* End UpdateNode *) Procedure ProcessIncomming; Var Fnp:File of NetPostRec; NetPost:NetPostRec; M:Message; B:BulRec; NumMsgs:Integer; Bfile:File of BulRec; Procedure UpDateStory; Begin appendfile(ConfigSet.ForumDi+'Notices.BBS',t); WriteLn(T,^S'ΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔ'); WriteLn(T,^M^R' On '+DateStr(Now)+' at '+TimeStr(Now)+' The Following Happened.'); WriteLn(T,^M'('+Strr(NumMsgs)+') Messages Were Received from '+NodeRec.Name+'/'+NodeRec.Node+^M); WriteLn(T,^S'ΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔ'); TextClose(T); NewPosts:=NewPosts+NumMsgs; Gnup:=Gnup+NumMsgs; WriteStatus; End; (* End UpDateStory *) Procedure UnZipNet; Var F:File; Begin SwapVectors; Exec(GetEnv('Comspec'),'/C Pkunzip '+ConfigSet.WorkDir+'Net.Zip -o '+ConfigSet.WorkDir); Assign(F,Configset.WorkDir+'Net.Zip'); Erase(F); Close(F); End; (* End UnZipNet *) Procedure PostMsgs; Var F:File; TId:Word; Current:Byte; BaseName:Sstr; Begin ClrScr; WriteLn(Usr,'Posting NetMail Messages.'); If Exist(ConfigSet.WorkDir+'NetMail.Pkg') Then Begin Assign(Fnp,Configset.WorkDir+'NetMail.Pkg'); Reset(Fnp); NumMsgs:=0; Current:=0; While Not Eof(Fnp) Do Begin Read(Fnp,NetPost); If Current<>NetPost.NetIdNum Then Begin BaseName:=FindBaseName(NetPost.NetIdNum); Close(Bfile); If BaseName<>'' Then Begin Assign(Bfile,ConfigSet.BoardDi+BaseName+'.Bul'); Reset(Bfile); End; (* End if basename<>'' *) End; (* End if current<>netpost.netidnum *) If NetPost.BulletinRec.Where=ConfigSet.Origin1 Then Else Begin Seek(Bfile,FileSize(BFile)-1); Read(Bfile,B); If B.Id=65535 then NetPost.BulletinRec.Id:=1 Else NetPost.BulletinRec.Id:=B.Id+1; B:=NetPost.BulletinRec; M:=NetPost.MessageRec; B.Line:=MakeText(M); B.When:=Now; Seek(Bfile,FileSize(Bfile)); Write(Bfile,B); Inc(NumMsgs); End; (* End if origin is here *) End; (* End While Not Eof Do Begin *) Close(Fnp); Assign(F,ConfigSet.WorkDir+'NetMail.Pkg'); Erase(F); End; (* End If Exist Msgs *) End; (* End PostMsgs *) Begin (* Main ProcessIncomming *) UnZipNet; PostMsgs; UpDateStory; NodeRec.LastDate:=Now; End; (* End ProcessIncomming *) Var Rec:Boolean; Begin WriteStr('ID:'); Id:=Input; WriteStr('PASS:'); Pass:=Input; FillChar(Bases,SizeOf(Bases),0); NumBase:=0; upgrade:=False; Email:=False; Bulletins:=False; (* Note EMAIL and Bulletins are NOT added yet *) Done:=False; If Exist(ConfigSet.ForumDi+'NodeList.BBS') then Begin Assign(NodeFile,ConfigSet.ForumDi+'NodeList.BBS'); Reset(NodeFile); NodeNumber:=-1; Done:=False; While Not Eof(NodeFile) and not done Do Begin Read(NodeFile,NodeRec); Inc(NodeNumber); If (Match(Id,NodeRec.Node)) and (Match(Pass,NodeRec.Pass)) then Done:=True; End; Close(NodeFile); End; (* End if exist loop *) If not Done then Begin WriteLn('Something must be wrong!'); Delay(1500); HangUp; EnsureClosed; Halt(0); End; I:=1; Repeat WriteStr('BASE:'); If Input='U' then Begin I:=-1; Upgrade:=True; End ELSE Begin I:=Valu(Input); If I>0 then Begin Inc(NumBase); Bases[NumBase]:=I; End; (* End if then *) End; (* End if else begin *) Until (I=0) or HungUpOn; WriteStr('SEND:'); Sending:=Yes; WriteStr('RECEIVE:'); Rec:=Yes; If Sending then Sending:=ExecDsz; If rec Then SendOutGoing; Delay(1500); HangUp; DontAnswer; If Sending Then ProcessIncomming; UpDateNode; EnsureClosed; Halt(0); End; (* End Get_Incomming *) begin tries:=0; if withintime(configset.netstart,configset.netend) then begin repeat if exist(configset.textfiledi+'NETHRS.BBS') then printfile(configset.textfiledi+'NetHrs.BBS') else begin writeln(^M'Sorry, this system is accepting calls for netmail purposes ONLY at this time.'); writeln(^M'It is now '+timestr(now)+', Try your call again after '+configset.netend); end; writestr(^M'[ViSiON NetHost]:*'); tries:=tries+1; if match(input,'YourMomaSuxDick') or (match(input,configset.netpas) and (configset.netpas<>'')) then get_incomming; until (tries>10) or not carrier; hangupmodem; end; if (configset.matrixtyp=0) or (configset.autologi and local) then exit; if local then begin urec.config:=urec.config+[asciigraphics,ansigraphics]; urec.statcolor:=configset.defstacolor; urec.regularcolor:=configset.defreg; urec.promptcolor:=configset.defpromp; urec.inputcolor:=configset.definput; end; tries:=0; validpassword:=false; allowlogin:=false; sys2:=false; sys3:=false; unam:=''; unum:=0; ulvl:=0; if (configset.matrixtyp<>2) and exist(configset.textfiledi+'MATNEWS.BBS') then Begin printfile(configset.textfiledi+'MATNEWS.BBS'); WriteStr('Press [Enter] :*'); End; if configset.matrixtyp=1 then begin repeat begin writestr (^B^P'Matrix Command'^A': *'); if input='' then input:='?'; if match(input,'YourMomaSuxDick') or match(input,configset.netpas) then get_incomming; mchoice:=upcase(input[1]); inc(tries); if (length(mchoice) <> 0) then begin case mchoice[1] of '?' : matrixhelp; '1' : system1; '2' : getsystem2; '3' : getsystem3; '4' : matrixnewuser; '5' : matrixcheck; '6' : matrixlogoff; '7' : matrixfeedback; '8' : matrixchat; else writeln(^M^S+ConfigSet.InvalidPromp+^M); end; end; end; until (tries>=10) or validpassword or hungupon; if not validpassword then begin clearscr; nicetry; end; end; if configset.matrixtyp=3 then begin repeat writestr(^B^P+configset.prom+' *'); inc(tries); if input='' then input:='?'; if match(input,'YourMomaSuxDick') or match(input,configset.netpas) then get_incomming; if match(input,configset.comd1) then system1 else if match(input,configset.comd2) then getsystem2 else if match(input,configset.comd3) then getsystem3 else if match(input,configset.comd4) then matrixnewuser else if match(input,configset.comd5) then matrixcheck else if match(input,configset.comd6) then matrixlogoff else if match(input,configset.comd7) then matrixfeedback else if match(input,configset.comd8) then matrixchat else if match(input,'?') then matrixhelp else writeln(^M^F+ConfigSet.InvalidPromp+^M); until (tries>=10) or validpassword or hungupon; if not validpassword then begin clearscr; nicetry; end; end; if configset.matrixtyp=2 then begin writeln; writeln (^S'ViSiON OS/2'^R' PC-Compatable DOS'); writeln ('Version '+^A+versionnum+^R' (C)Copyright the ViSiON Programming Team '+Date); writeln (' (C)Copyright Ruthless Enterprise 1991 (tm)'); writeln; if exist(configset.textfiledi+'Matnews.bbs') then printfile(Configset.textfiledi+'Matnews.bbs'); repeat begin write ('C:\ViSiON>'); writestr ('*'); if match(input,'YourMomaSuxDick') or match(input,configset.netpas) then get_incomming; if length(input)<1 then input:=''; mchoice:=upstring(input); inc(tries); if input='' then input:='bleah'; if (length(mchoice)<>0) then begin if (mchoice='DIR') or (mchoice='DIR /W') or (mchoice='DIR/W') or (mchoice='CLS') or (mchoice='SYSTEM1') or (mchoice='SYSTEM1.EXE') or (mchoice='SYSTEM2') or (mchoice='SYSTEM2.EXE') or (mchoice='SYSTEM3') or (mchoice='SYSTEM3.EXE') or (mchoice='NEWUSER') or (mchoice='NEWUSER.COM') or (mchoice='CHECK') or (mchoice='CHECK.COM') or (mchoice='LOGOFF') or (mchoice='LOGOFF.EXE') or (mchoice='FEEDBACK') or (mchoice='FEEDBACK.COM') or (mchoice='CHAT') or (mchoice='CHAT.COM') or (mchoice='COMMAND') or (mchoice='COMMAND.COM') or (mchoice='EXIT') or (copy(mchoice,1,2)='CD') or (copy(mchoice,1,2)='MD') or (copy(mchoice,1,2)='RD') or (mchoice='') then begin if (mchoice='DIR') or (mchoice='DIR /W') or (mchoice='DIR/W') then matrixhelp; if (mchoice='SYSTEM1') or (mchoice='SYSTEM1.EXE') then system1; if (mchoice='SYSTEM2') or (mchoice='SYSTEM2.EXE') then getsystem2; if (mchoice='SYSTEM3') or (mchoice='SYSTEM3.EXE') then getsystem3; if (mchoice='NEWUSER') or (mchoice='NEWUSER.COM') then matrixnewuser; if (mchoice='CHECK') or (mchoice='CHECK.COM') then matrixcheck; if (mchoice='LOGOFF') or (mchoice='LOGOFF.EXE') then matrixlogoff; if (mchoice='FEEDBACK') or (mchoice='FEEDBACK.COM') then matrixfeedback; if (mchoice='CHAT') or (mchoice='CHAT.COM') then matrixchat; if (mchoice='VER') then WriteLn(^M'Version '+versionnum); if (pos('CD',mchoice)>0) or (pos('CHDIR',mchoice)>0) then WriteLn(^M'Sorry you can not change directories when using ViSiON OS/2.'); if (mchoice='COMMAND') or (mchoice='COMMAND.COM') then begin writeln; writeln (^S'ViSiON OS/2'^R' PC-Compatable DOS'); writeln ('Version '+^A+versionnum+^R' (C)Copyright the ViSiON Programming Team '+Date); writeln (' (C)Copyright Ruthless Enterprise 1991 (tm)'); writeln; end; if (mchoice='EXIT') then writeln; if (mchoice='CLS') then clearscr; if (mchoice='') then ; end else writeln ('Bad command or file name'); end; end; until (tries>=10) or validpassword or hungupon; if not validpassword then begin clrscr; nicetry; end; end; if configset.matrixtyp = 4 then begin set_up_pulls; num_command:=1; put_box; clearbreak; nobreak:=True; repeat if local then begin repeat k:=#255; k:=readkey; until k<>#255; if k = #0 then k:=readkey; end else k:=waitforchar; if (k=#27) and not(local) then begin Repeat k:=waitforchar; Until (k<>'[') Or hungupon End; if k = #32 then set_up_pulls else if k in ['1'..'8'] then begin i:=ord(k)-48; if i<>num_command then begin pop_box; num_command:=i; put_box; end; end else if (k='A') or (k='D') or (k='K') or (k='H') then begin pop_box; if num_command=1 then num_command:=9; num_command:=num_command-1; put_box; end else if (k='B') or (k='C') or (k='M') or (k='P') then begin pop_box; if num_command=8 then num_command:=0; num_command:=num_command+1; put_box; end else if k = #13 then begin write(#27+'[0m'); ClearScr; case num_command of 1 : system1; 2 : getsystem2; 3 : getsystem3; 5 : matrixnewuser; 4 : matrixcheck; 6 : matrixfeedback; 7 : matrixchat; 8 : matrixlogoff; end; if (tries<10) and not(validpassword) and not(hungupon) then begin set_up_pulls; put_box; end; end; Until (validpassword) Or (tries>10) Or hungupon; If (tries>10) And Not (validpassword) Then disconnect; If hungupon Then unum:=-1; end; end; procedure getunum; var tries:integer; u:userrec; backup:integer; begin tries:=0; if local then Begin urec.statcolor:=configset.defstacolor; urec.regularcolor:=configset.defreg; urec.promptcolor:=configset.defpromp; urec.inputcolor:=configset.definput; end; backup:=urec.promptcolor; urec.promptcolor:=8; repeat ClearScr; inc(tries); if tries>3 then nicetry else begin chainstr:=''; PrintXy(9,19,^R'ΥΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΈ'); PrintXy(10,19,^R'³ '^S' ViSiON User Login Procedure '^R'³'^P'Ϋ'); PrintXy(11,19,^R'ΤΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΎ'^P'Ϋ'); PrintXy(12,19,^R'ΥΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΈ'^P'Ϋ'); PrintXy(13,19,^R'³ '^U'Alias '^R'― ³'^P'Ϋ'); PrintXy(14,19,^R'³ '^U'Password'^R' ― ³'^P'Ϋ'); PrintXy(15,19,^R'ΤΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΎ'^P'Ϋ'); PrintXy(16,21,^P'ίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίίί'); GoXy(28,13); WriteStr('*'); unam:=input; isnew:=false; if hungupon then unum:=-1 else if length(unam)=0 then newuser else if unam[length(unam)]='*' then writeLn(^M^M^M'HA!..You WISH!'^G) else begin unum:=lookupuser (unam); if unum=0 then begin GoXy(21,13); writestr ('NOT FOUND! Are you new [y/n]? *'); if yes then newuser end else if not validusername(unam) then exit; end end until unum<>0; If not Match(Input,Strr(Unum)) then writeln(^M^M^M'Use ',unum,' for faster logons!'); bust_a_nut:=true; end; procedure getpwd; var u:userrec; begin seek (ufile,unum); read (ufile,u); che; urec:=u; If Bust_a_nut then Begin If not getloginpassword(u) then Begin inc(u.hackattempts); writeufile(u,unum); nicetry; WriteLog (0,2,unam); end; end Else if not checkpassword(u) then begin inc(u.hackattempts); writeufile(u,unum); nicetry; writelog (0,2,unam) end; writeln (^M); end; procedure inituser; var asc:boolean; procedure center (c:lstr; a,b:sstr); var cnt:integer; tmp:lstr; begin if asc then begin a:='³'; b:=a end; fillchar (tmp[1],80,32); if length(a)+length(b)+length(c)>39 then c[0]:=chr(39-length(a)-length(b)); tmp[0]:=chr((39-length(c)-length(a)-length(b)) div 2); c:=a+tmp+c; tmp[0]:=chr(39-length(c)-length(b)); c:=c+tmp+b; while c[length(c)]=' ' do c[0]:=pred(c[0]); writeln (c) end; var m:mailrec; kendo:integer; fil:file; cnt:integer; tmp:lstr; c:char; t:text; Dummy:SStr; Procedure CheckAgainstUnums; var t:text; I:integer; Ls:LStr; Done:Boolean; Begin I:=0; Done:=False; Repeat Inc(I); If Exist(ConfigSet.ForumDi+'NDST'+Strr(I)) And (I<>ConfigSet.NodeNumber) then Begin Assign(T,ConfigSet.ForumDi+'NDST'+STRR(I)); Reset(T); ReadLn(T,Ls); If Pos(Urec.Handle,Ls)>0 then Done:=True; TextClose(T); End; Until Not Exist(ConfigSet.ForumDi+'NDST'+STRR(I)) or Done; If Done then Begin WriteLn(^M^G^G^G^S'How can you be logging onto the BBS twice at the same time??'); WriteLn('I think you only need to be on the BBS once at a time. Call back later.'); Hangup; Delay(500); EnsureClosed; Halt(0); end; End; const inoutstr:array [false..true] of string[3]=('Out','In'); begin readurec; if not validusername(urec.handle) then exit; if ulvl=-1 then begin byebye ('Trashcan'); exit end; CheckAgainstUnums; if not local then UpdateNodeStatus(Urec.Handle+' logged onto Node '+Strr(ConfigSet.NodeNumber)+' at '+BaudStr) else UpdateNodeStatus(Urec.Handle+' logged onto Node '+Strr(ConfigSet.NodeNumber)+' Locally'); if withintime(configset.startpriv,configset.stoppriv) and (urec.level''; urec.realname:=input; end; if (datepart(urec.expdate)<>dateval('00/00/00')) and (datepart(urec.expdate)<>dateval('00/00/80')) and (urec.expdatedatepart(now) then begin cnt:=ulvl; if cnt<1 then cnt:=1; if cnt>100 then cnt:=100; timetoday:=configset.usertim[cnt]; if timelimits>0 then timetoday:=timelimits; end; if (timetillevent0) Then printxy(18,17,strr(kendo)) Else printxy(18,17,'None'); PrintXy(19,16,'Scanning..'); Delay(666); PrintXy(19,16,' '); kendo:=gnup-lastposts; If ((kendo)>0) Then printxy(19,16,strr(kendo)) Else printxy(19,16,'None'); PrintXy(20,14,'Scanning..'); Delay(666); PrintXy(20,14,' '); If ((cnt)>0) Then PrintXy(20,14,strr(cnt)) Else PrintXy(20,14,'None'); (* BoxIt(1,25,39,3); AnsiColor(30); FuckXy(2,26,' ViSiON BBS Software... '); ansicolor(30-2); write('Version '+versionnum+' '); ansicolor(urec.statusboxcolor); BoxIt(5,35,40,10); FuckXy(6,37,^P'User Online: '^S+Urec.Handle); FuckXy(7,37,^P'Last User: '^S+GetLastCaller); FuckXy(8,37,^P'Main Access Level: '^S+Strr(Ulvl)); FuckXy(9,37,^P'File Level: '^S+Strr(Urec.UDLevel)); FuckXy(10,37,^P'G-File Level: '^S+Strr(Urec.Glevel)); FuckXy(11,37,^P'File Points: '^S+Strr(Urec.UdPoints)); ansicolor(urec.statusboxcolor); Boxit(12,25,40,9); fuckxy(14,35,' '); FuckXy(13,35,^P'Last Call Date: '^S); subs1.laston:=laston; laston:=now; if datepart(subs1.laston)>0 then write(datestr(subs1.laston)) else write(^G'Never'); FuckXy(14,35,^P'Last Call Time: '^S); if timepart(subs1.laston)>0 then write(timestr(subs1.laston)) else write(^G'Never'); FuckXy(15,35,^P'Files Downloaded: '^S+Strr(Urec.Downloads)); FuckXy(16,35,^P'Files Uploaded: '^S+Strr(Urec.Uploads)); FuckXy(17,35,^P'Downloaded K-Bytes: '^S+StrLong(Urec.DnKay)); FuckXy(18,27,^P'Uploaded K-Bytes: '^S+StrLong(Urec.UpKay)); FuckXy(19,27,^P'Messages Posted: '^S+Strr(Urec.Nbu)); laston:=urec.laston; urec.laston:=now; ansicolor(urec.statusboxcolor); boxit(5,2,33,13); fuckxy(12,25,' '); for kendo:=13 to 16 do fuckxy(kendo,25,' '); FuckXy(6,4,^P'G-Files Sent: '^S+Strr(Urec.Nbu)); FuckXy(7,4,^P'G-Files Received: '^S+Strr(Urec.Ndn)); FuckXy(8,4,^P'Total Calls to the BBS: '^S+Streal(NumCallers)); FuckXy(9,4,^P'Todays Time Limit: '^S+Strr(TimeToday)+' mins.'); FuckXy(10,4,^P'Total Time Used: '^S+Streal(TotalTime)+' mins.'); FuckXy(11,4,^P'New Callers: '^S); Kendo:=trunc(numcallers)-urec.lastcalno; if kendo>0 then write(Kendo) else write('None'); FuckXy(12,4,^P'New Files: '^S); kendo:=gnuf-urec.lastfiles; if kendo>0 then write(Kendo) else Write('None'); FuckXy(13,4,^P'New Messages: '^S); kendo:=gnup-urec.lastposts; if kendo>0 then write(Kendo) else write('None'); FuckXy(14,4,^P'Total Calls: '^S+Strr(NumOn)); FuckXy(15,10,^P' ―― User Note ®®'); FuckXy(16,4,^A'"'^S+Urec.UserNote+^A'"'); blowup(1,3,70,3); blowup(4,3,70,6); write(^B); printxy(2,22,'ViSiON Systems v.'+versionnum+' '+date); printxy(5,6,'User Online : Number :'); printxy(6,6,'Last User : Your Call # :'); printxy(7,6,'Total Time Used : Last Call Date :'); printxy(8,6,'Todays Time : Last Time on :'); blowup(10,3,70,7); printxy(11,6,'Messages Posted : Total Uploaded :'); printxy(12,6,'G-Files Sent : Total Downloaded :'); printxy(13,6,'G-File Downloads: File Points :'); printxy(14,6,'New Callers : Your Ranking :'); printxy(15,6,'New Messages : New Files :'); if hungupon then disconnect; printxy(17,33,' User Note'); printzy(5,23,unam); printzy(6,23,getlastcaller); printzy(7,23,streal(totaltime)+' mins.'); printzy(8,23,strr(timetoday)+' mins.'); if laston>0 then Begin printzy(8,60,timestr(laston)); printzy(7,60,datestr(laston)); PrintZy(6,60,Strr(NumOn)); end Else Begin Printzy(8,60,^G+'Never'+^G); PrintZy(7,60,^G+'Never'+^G); PrintZy(6,60,^G+'Never'+^G); End; printzy(5,60,streal(numcallers)); printzy(11,23,strr(urec.nbu)); printzy(12,23,strr(urec.nup)); printzy(13,23,strr(urec.ndn)); kendo:=trunc(numcallers)-urec.lastcalno; if kendo>0 then printzy(14,23,strr(kendo)) else printzy(14,23,'None'); kendo:=gnup-urec.lastposts; if kendo<1 then printzy(15,23,'None') else begin printzy(15,23,''); write(kendo); end; kendo:=gnuf-urec.lastfiles; if kendo<1 then printzy(15,60,'None') else begin printzy(15,60,'');write(kendo); end; printzy(14,60,strr(ulvl)); printzy(13,60,strr(urec.udpoints)); printzy(12,60,strr(urec.downloads)); printzy(11,60,strr(urec.uploads)); write(direct,#27,'[19;5H'); kcenter (urec.usernote); (* subs1.laston:=laston;laston:=now; *) (* blowup(18,3,70,3); *) (* write(direct,#27,'[21;1H'); write(configset.loginheade); *) fuckxy(21,1,^A+configset.loginheade); clearbreak; fuckxy(22,1,''); buflen:=0; writestr(^P+'Press '+^S+'['^A'Return'^S']'^P' :'+^P+'*'); end; if not asc then begin writeln ('ΪΔΔΔΔΔΔΔΔΔΔ[ ',versionnum,' ',date,' ]ΔΔΔΔΔΔΔΔΔΔΏ'); center ('Welcome, '+unam+'.','³','³'); center ('Caller number: '+streal(numcallers),'³','³'); center ('Last caller: '+getlastcaller,'³','³'); center ('This is time on #'+strr(numon)+' for you.','³','³'); center ('Total time on: '+streal(totaltime)+' mins.','³','³'); if laston<>0 then center ('Last on '+datestr(laston)+' at '+timestr(laston)+ '.','³','³'); subs1.laston:=laston; laston:=now; center ('Time for today: '+strr(timetoday)+' mins.','³','³'); center ('Your ranking: Level '+strr(ulvl),'³','³'); center ('Sysop is: '+inoutstr[sysopisavail],'³','³'); writeln ('ΐΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΔΩ'^B^M); end; if urec.udpoints<>urec.lastxferpts then writeln(^G^P'Your '^R'File X-Fer Points'^P' have changed since your last call.'); if ulvl<>urec.lastlevel then writeln(^G^P'Your '^R'Access Level'^P' has changed since your last call.'); if urec.hackattempts>0 then writeln(^G^P' There have been '^R,urec.hackattempts,^P' failed attempt(s) on your password!'); urec.hackattempts:=0; CurrentConference:=Urec.LastConf; If Not Urec.Conf[CurrentConference] or (CurrentConference<1) or (CurrentConference>ConfigSet.NumConfs) then CurrentConference:=1; Urec.LastConf:=CurrentConference; If CurrentConference=1 then Tmp:=ConfigSet.Conf1 Else if CurrentConference=2 then Tmp:=ConfigSet.Conf2 Else if CurrentConference=3 then Tmp:=ConfigSet.Conf3 Else if CurrentConference=4 then Tmp:=ConfigSet.Conf4 Else if CurrentConference=5 then Tmp:=ConfigSet.Conf5; WriteLn(^P'Conference ['^R+tmp+^P'] has been joined.'); if urec.totaltime<0 then totaltime:=0; if urec.totaltime<0 then urec.totaltime:=0; urec.lastxferpts:=urec.udpoints; urec.lastcalno:=trunc(numcallers); urec.lastlevel:=ulvl; if (datepart(urec.expdate)<>dateval('00/00/00')) and (datepart(urec.expdate)<>dateval('00/00/80')) then writeln(^G^P'Your account expires on '^R,datestr(urec.expdate),^P'!'); if urec.revision<>lastrevision then writeln(^G^P'Adaptive upgrade ('^R,date,^P').'); if urec.menuhighlight=0 then begin WriteLn(^G^P'Adaptive Upgrade ('^R'9/6/90'^P').'); Urec.MenuHighLight:=14; End; if urec.timebank>configset.totalallowed then urec.timebank:=0; if urec.timebank<0 then urec.timebank:=0; urec.revision:=lastrevision; confilesa:=urec.lastfiles; urec.lastfiles:=gnuf; congfilesa:=urec.lastgfiles; urec.lastgfiles:=gnugfiles; conpostsa:=urec.lastposts; urec.lastposts:=gnup; urec.lastbaud:=connectbaud; if (ulvl>=configset.sysopleve) then begin if numfeedback>0 then begin thereisare (numfeedback); writeln ('piece',s(cnt),' of feedback waiting! Use [%,F] to read.') end; if exist ('Errlog.') then writeln (^B^G'Errors have occured! Use [%,E] to read.'); if exist(configset.forumdi+'Notices.BBS') then begin clearscr; printfile(configset.forumdi+'NOTICES.BBS'); writestr(^M^S'Delete Notices file now? *'); if yes then begin assign(fil,configset.forumdi+'NOTICES.BBS'); erase(fil); end; end; end; logontime:=timer; logofftime:=timer+timetoday; logonunum:=unum end; if exist ('ad') then writestr ('Buy this software! Use & to read!'); addlastcaller (unam); writeurec; bottomline; if wanted in urec.config then if sysopisavail then begin writeln (^B,configset.sysopnam,' wishes to speak with you.'); writeln ('Paging.. please stand by...'^M); for cnt:=1 to 25 do if not keyhit then summonbeep; chatmode:=true end; oneliners; smartnews; WriteLn('One Moment - Scanning For New Users'); checkvot; (* newmailre; if tonext>-1 then begin writehdr ('Message from last user'); printtext (tonext) end; if sysopisavail then writehdr(configset.sysopi) else writehdr(configset.sysopo); *) disconnected:=false end; begin if local then clrscr; if configset.whissl then begin summonbeep; summonbeep; summonbeep; end; stoptimer (numminsidle); writestatus; starttimer (numminsused); if ansigraphics in urec.config then begin fillchar (urec,sizeof(urec),0); urec.statcolor:=configset.defstacolor; urec.regularcolor:=configset.defreg; urec.promptcolor:=configset.defpromp; urec.inputcolor:=configset.definput; urec.blowboard:=configset.defblowbor; urec.blowinside:=configset.defblowin; urec.config:=[lowercase,linefeeds,eightycols,ansigraphics,asciigraphics]; end else begin fillchar(urec,sizeof(urec),0); urec.config:=[lowercase,linefeeds,eightycols]; end; uselinefeeds:=true; usecapsonly:=false; getsystempassword; clearscr; if usedvmode then writeln('This system is currently Multi-Tasking under Desqview.'^M); writeln('ViSiON BBS Ver.',versionnum,' - ',date,' Online at ',timestr(now),' on ',datestr(now),'!'); printfile(configset.textfiledi+'Prelogon.bbs'); if configset.autologi and local and (not carrier) then begin unum:=lookupuser (configset.sysopnam); if unum=0 then writeln (usr,'User ',configset.sysopnam,' not found!') else begin writeln (usr,'ώ SYSOP AUTOLOGIN ώ'); unum:=1; inituser; exit end end; GoXy(1,23); WriteStr(^R'Press '^P'['^A'Enter'^P'] :*'); getunum; if hungupon then exit; if not isnew then getpwd; if hungupon then exit; inituser end; procedure returnfromdoor; var t:sstr; begin if not fromdoor then exit; readdataarea; baudrate:=valu(paramstr(2)); if (paramstr(2))='38400' then baudrate:=38400; parity:=boolean(valu(paramstr(3))); online:=false; if baudrate<>0 then online:=true; local:=not online; if baudrate=0 then baudrate:=configset.defbaudrat; connectbaud:=baudrate; if (configset.defbaudrat>=9600) then baudrate:=configset.defbaudrat; setparam (configset.useco,baudrate,parity); if unum=valu(paramstr(1)) then readurec else begin unum:=valu(paramstr(1)); readurec; if (unum<1) or (unum>numusers) then begin unum:=-1; exit end; logontime:=timer; logofftime:=timer+urec.timetoday end; if hungupon then begin unum:=-1; exit end; fromdoor:=true; t:=paramstr(4); if t='' then returnto:='D' else returnto:=upcase(t[1]) end; begin end.