351 lines
12 KiB
Plaintext
351 lines
12 KiB
Plaintext
{*****************************************************************************
|
||
* T E L E G A R D - X *
|
||
* =================== *
|
||
* *
|
||
* Modification History *
|
||
* ==================== *
|
||
* 08/20/91 - 0.90 - Rls - Original Version. *
|
||
* Sad - Original Version. *
|
||
* *
|
||
* NOTE: TeleGard-X originated from TeleGard 2.5i which was originally *
|
||
* written by Eric Oman, and Martin Pollard. *
|
||
* *
|
||
*****************************************************************************}
|
||
{$A+,B+,D-,E+,F+,I+,L-,N-,O+,R-,S+,V-}
|
||
{$M 60000,0,45000} { Memory Allocation Sizes }
|
||
|
||
Program TeleGard-X;
|
||
Uses
|
||
Crt, Dos, OverLay, InitP, Sysop1, Sysop2, Sysop3,
|
||
Sysop4, Sysop5, Sysop6, Sysop7, Sysop8, Sysop9, Sysop10,
|
||
Sysop11, Mail0, Mail1, Mail2, Mail3, Mail4, Mail5,
|
||
Mail6, Mail9, File0, File1, File2, File3, File4,
|
||
File5, File6, File7, File8, File9, File10, File11,
|
||
File12, File13, File14, Archive1, Archive2, Archive3, Misc1,
|
||
Misc2, Misc3, Misc4, MiscX, CUser, Doors, Menus2,
|
||
Menus3, Menus4, MyIO, Logon1, Logon2, NewUsers, WfcMenu,
|
||
Menus, FvType, TimeJunk, TmpCom, MsgPack, Common, Common1,
|
||
Common2, Common3, ExecSwap; {* MiniTerm, Window2, NewCom *}
|
||
|
||
{$O MsgPack } {$O Common1 } {$O Common2 } {$O Common3 } {$O InitP }
|
||
{$O WfcMenu } {$O FvType } {$O TimeJunk } {$O Sysop1 } {$O Sysop2 }
|
||
{$O Sysop21 } {$O Sysop2a } {$O Sysop2b } {$O Sysop2c } {$O Sysop2d }
|
||
{$O Sysop2e } {$O Sysop2f } {$O Sysop2fa } {$O Sysop2g } {$O Sysop2h }
|
||
{$O Sysop2i } {$O Sysop2s } {$O Sysop2z } {$O Sysop3 } {$O Sysop4 }
|
||
{$O Sysop5 } {$O Sysop6 } {$O Sysop7 } {$O Sysop7m } {$O Sysop8 }
|
||
{$O Sysop9 } {$O Sysop10 } {$O Sysop11 } {$O Mail0 } {$O Mail1 }
|
||
{$O Mail2 } {$O Mail3 } {$O Mail4 } {$O Mail5 } {$O Mail6 }
|
||
{$O Mail9 } {$O File0 } {$O File1 } {$O File2 } {$O File3 }
|
||
{$O File4 } {$O File5 } {$O File6 } {$O File7 } {$O File8 }
|
||
{$O File9 } {$O File10 } {$O File11 } {$O File12 } {$O File13 }
|
||
{$O File14 } {$O Archive1 } {$O Archive2 } {$O Archive3 } {$O Logon1 }
|
||
{$O Logon2 } {$O NewUsers } {$O Misc1 } {$O Misc2 } {$O Misc3 }
|
||
{$O Misc4 } {$O MiscX } {$O CUser } {$O Doors } {$O ExecBat }
|
||
{$O MyIO } {$O Menus2 } {$O Menus3 } {$O Menus4 }
|
||
|
||
Const
|
||
OvrMaxSize = 60000;
|
||
BBSMaxHeapSpace = 40000;
|
||
|
||
{$I LcBbs.Pas}
|
||
|
||
Var
|
||
ExitSave : Pointer;
|
||
ExecFirst : Boolean;
|
||
NewMenuCmd: String;
|
||
|
||
Procedure ErrorHandle;
|
||
{*****************************************************************************
|
||
* Note: if error occurs IN THIS PROCEDURE, *
|
||
* it is NOT executed again! That way an infinite loop is *avoided*.... *
|
||
*****************************************************************************}
|
||
Var
|
||
T:Text;
|
||
F:File;
|
||
S:String[80];
|
||
VidSeg:Word;
|
||
X,Y:Integer;
|
||
C:Char;
|
||
Begin
|
||
ExitProc:=ExitSave;
|
||
If (ErrorAddr<>Nil) then
|
||
Begin
|
||
chdir(start_dir);
|
||
if (textrec(sysopf).mode=fmoutput) then
|
||
begin
|
||
writeln(sysopf,#3#8+'*>>'+#3#7+' Runtime error '+cstr(exitcode)+
|
||
' at '+date+' '+time+#3#8+' <<*'+#3#5+
|
||
' (Check ERR.LOG in main BBS dir)');
|
||
flush(sysopf); close(sysopf);
|
||
end;
|
||
if (textrec(trapfile).mode=fmoutput) then
|
||
begin
|
||
writeln(trapfile,'*>> Runtime error '+cstr(exitcode)+' at '+date+' '+
|
||
time+' <<*');
|
||
flush(trapfile); close(trapfile);
|
||
end;
|
||
|
||
assign(t,'err.log');
|
||
{$I-} append(t); {$I+}
|
||
if (ioresult<>0) then
|
||
begin
|
||
rewrite(t);
|
||
append(t);
|
||
writeln(t,'<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
|
||
writeln(t,'Critical Error Log file - Contains screen images at instant of Error.');
|
||
writeln(t,'The "<22>" character shows the cursor position at time of error.');
|
||
writeln(t,'Note: You may periodically delete this file with no harm to the system,');
|
||
writeln(t,'but note the following information:');
|
||
writeln(t,'<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
|
||
{*****
|
||
writeln(t,'Please notify Eric Oman that you have encountered a Critical Error.');
|
||
writeln(t,'You will need to send this file to him, along with a short message');
|
||
writeln(t,'stating - briefly - what events led up to the Critical Error, and whether');
|
||
writeln(t,'or not the error was repeatable, and under what circumstances.');
|
||
writeln(t);
|
||
writeln(t,'Eric can be reached at: * The Pointe BBS 313-885-1779');
|
||
writeln(t,' Electric Eye ][ BBS 313-776-8928');
|
||
writeln(t,' The Ozone BBS 313-689-2876');
|
||
writeln(t,'( * -- Best chance ) Warp Speed BBS 313-544-0405');
|
||
*****}
|
||
writeln(t,'<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
|
||
writeln(t);
|
||
end;
|
||
writeln(t);
|
||
if (serialnumber<>0) then
|
||
s:=' ('+cstr(serialnumber)+vercs+')'
|
||
else
|
||
s:='';
|
||
writeln(t,'<27>><3E> RT #'+cstr(exitcode)+' at '+date+' '+time+' BBS-Ver: '+ver+s);
|
||
if (useron) then begin
|
||
if (spd<>'KB') then s:='at '+spd+' baud' else s:='Locally';
|
||
writeln(t,'<27>><3E> User "'+allcaps(thisuser.name)+' #'+cstr(usernum)+
|
||
'" was on '+s);
|
||
end;
|
||
writeln(t,'<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <<3C>- Screen Image: -<2D>> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
|
||
if (mem[$0000:$0449]=7) then vidseg:=$B000 else vidseg:=$B800;
|
||
for y:=1 to 25 do
|
||
begin
|
||
s:='';
|
||
for x:=1 to 80 do
|
||
begin
|
||
c:=chr(mem[vidseg:(160*(y-1)+2*(x-1))]);
|
||
if (c=#0) then c:=#32;
|
||
if ((x=wherex) and (y=wherey)) then c:=#178;
|
||
if ((x<>80) or ((x=80) and (c<>#32))) then s:=s+c;
|
||
end;
|
||
writeln(t,s);
|
||
end;
|
||
writeln(t,'<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>*<2A><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
|
||
close(t);
|
||
|
||
assign(f,'critical.err'); rewrite(f); close(f); setfattr(f,dos.hidden);
|
||
|
||
sprint(#3#8+'*>>'+#3#7+' System error occured at '+date+' '+time+#3#8+' <<*');
|
||
term_ready(TRUE); remove_port; {removeint(modemr.comport);}
|
||
writeln('*>> System error '+cstr(exitcode)+' at '+date+' '+time+' <<*');
|
||
|
||
if (exiterrors<>-1) then halt(exiterrors) else halt(254);
|
||
{* CRITICAL ERROR ERRORLEVEL *}
|
||
end;
|
||
end;
|
||
|
||
Procedure MenuExec;
|
||
Var
|
||
Dt : LDateTimeRec;
|
||
Cmd,s : String;
|
||
I : Integer;
|
||
Aa,Abort,Next,Done:Boolean;
|
||
Begin
|
||
If (ExecFirst) then
|
||
Begin
|
||
ExecFirst:=FALSE;
|
||
Cmd:=NewMenuCmd;
|
||
NewMenuCmd:='';
|
||
End Else MainMenuHandle(Cmd);
|
||
|
||
if ((copy(cmd,1,2)='\\') and (thisuser.sl=255)) then begin
|
||
domenucommand(done,copy(cmd,3,length(cmd)-2),newmenucmd);
|
||
if (newmenucmd<>'') then cmd:=newmenucmd else cmd:='';
|
||
end;
|
||
|
||
If (Cmd='|') then
|
||
Begin
|
||
nl; sprint(#3#3+verline(1)); sprint(#3#3+verline(2)); nl;
|
||
pdt2dt(sitedatetime,dt);
|
||
sprint(#3#3+'Release date: '+#3#5+tch(cstr(dt.month))+'/'+
|
||
tch(cstr(dt.day))+'/'+cstr(dt.year)+' '+tch(cstr(dt.hour))+':'+
|
||
tch(cstr(dt.min))+':'+tch(cstr(dt.sec))+'.'+tch(cstr(dt.sec100)));
|
||
If (LicenseInfo<>'') then
|
||
Begin
|
||
nl; sprint(#3#3+'This version is licensed to:'); cl(5); prompt(' ');
|
||
aa:=allowabort; allowabort:=FALSE; abort:=FALSE; next:=FALSE;
|
||
s:=licenseinfo;
|
||
while (s<>'') do
|
||
if (pos(^J,s)<>0) then
|
||
begin
|
||
printa1(copy(s,1,pos(^J,s)-1),abort,next);
|
||
s:=copy(s,pos(^J,s)+1,length(s)-pos(^J,s));
|
||
nl; prompt(' '); cl(5);
|
||
end else
|
||
begin
|
||
printa1(s,abort,next); s:=''; nl;
|
||
end;
|
||
allowabort:=aa;
|
||
end;
|
||
lastcommandgood:=TRUE;
|
||
end else
|
||
if ((cmd='=') and (cso)) then showmenucmds
|
||
else
|
||
if (cmd<>'') then
|
||
begin
|
||
newmenucmd:='';
|
||
repeat domenuexec(cmd,newmenucmd) until (newmenucmd='');
|
||
end;
|
||
end;
|
||
|
||
Var
|
||
OvrPath,VerType : String;
|
||
I,RCode : Integer;
|
||
NeedToHangup : Boolean;
|
||
SyStatF : File of systatrec;
|
||
Begin
|
||
exitsave:=exitproc;
|
||
exitproc:=@errorhandle;
|
||
|
||
MaxHeapSpace:=BBSMaxHeapSpace;
|
||
checksnow:=TRUE; directvideo:=FALSE;
|
||
|
||
useron:=FALSE; usernum:=0;
|
||
getdir(0,start_dir);
|
||
|
||
assign(systatf,'status.dat');
|
||
{$I-} reset(systatf); {$I+}
|
||
if (ioresult<>0) then
|
||
begin
|
||
writeln;
|
||
writeln('Unable to find STATUS.DAT data file. This file is absolutely');
|
||
writeln('*REQUIRED* to even load the BBS. If you cannot find your');
|
||
writeln('STATUS.DAT data file, re-create one using the INIT package.');
|
||
if (exiterrors<>-1) then halt(exiterrors) else halt(254);
|
||
end else begin
|
||
{$I-} read(systatf,systat); {$I+}
|
||
close(systatf);
|
||
end;
|
||
|
||
ovrinit('BBS.OVR');
|
||
ovrpath:=fsearch('BBS.OVR',getenv('PATH'));
|
||
if (ovrresult<>ovrok) then
|
||
begin
|
||
clrscr; writeln('Critical error: Overlay manager error.'); halt(1);
|
||
end;
|
||
if (systat.useems) then
|
||
begin
|
||
ovrinitems; if (ovrresult=ovrok) then overlayinems:=TRUE;
|
||
end;
|
||
ovrsetbuf(ovrmaxsize); ovrsetretry(ovrmaxsize div 2);
|
||
|
||
initexecswap2:=initexecswap;
|
||
execwithswap2:=execwithswap;
|
||
shutdownexecswap2:=shutdownexecswap;
|
||
|
||
findvertypeout(ovrpath,vercs,vertype,vertypes,serialnumber,licenseinfo,sitedatetime);
|
||
ver:=ver+' '+vertype;
|
||
|
||
init;
|
||
|
||
if (packbasesonly) then
|
||
begin
|
||
wfcmdefine; doshowpackbases; thisuser.ac:=thisuser.ac-[pause]; nl;
|
||
sprint(#3#5+'Message bases have been packed.');
|
||
cursoron(TRUE); halt(0);
|
||
end;
|
||
mailread:=FALSE; smread:=FALSE;
|
||
|
||
needtohangup:=wascriterr; { hang up if critical error last call! }
|
||
|
||
repeat
|
||
write_msg:=FALSE;
|
||
sysopon:=not systat.localsec;
|
||
wantout:=not systat.localscreensec;
|
||
checksnow:=systat.cgasnow;
|
||
|
||
wfcmenus(needtohangup);
|
||
needtohangup:=FALSE;
|
||
|
||
useron:=FALSE; usernum:=0;
|
||
if (not doneday) then
|
||
begin
|
||
if (getuser) then newuser;
|
||
if (not hangup) then
|
||
begin
|
||
macok:=TRUE;
|
||
if (not hangup) then logon;
|
||
if (not hangup) then
|
||
begin
|
||
with thisuser do
|
||
begin
|
||
newdate:=laston;
|
||
if (not mbaseac(lastmsg)) then lastmsg:=1;
|
||
if (not fbaseac(lastfil)) then lastfil:=1;
|
||
board:=lastmsg; fileboard:=lastfil;
|
||
end;
|
||
batchtime:=0.0; numbatchfiles:=0; numubatchfiles:=0; hiubatchv:=0;
|
||
newcomptables;
|
||
|
||
menustackptr:=0; for i:=1 to 8 do menustack[i]:='';
|
||
|
||
last_menu:=systat.allstartmenu+'.MNU';
|
||
|
||
if (not exist(systat.menupath+last_menu)) then
|
||
begin
|
||
sysoplog('"'+systat.menupath+last_menu+'" is MISSING. Loaded "MAIN.MNU" instead.');
|
||
last_menu:='main.mnu';
|
||
end;
|
||
curmenu:=systat.menupath+last_menu; readin;
|
||
|
||
if (novice in thisuser.ac) then chelplevel:=2 else chelplevel:=1;
|
||
end;
|
||
|
||
newmenucmd:=''; i:=1;
|
||
while ((i<=noc) and (newmenucmd='')) do
|
||
begin
|
||
if (cmdr[i].ckeys='FIRSTCMD') then
|
||
if (aacs(cmdr[i].acs)) then newmenucmd:='FIRSTCMD';
|
||
inc(i);
|
||
end;
|
||
execfirst:=(newmenucmd='FIRSTCMD');
|
||
while (not hangup) do menuexec; {*** main BBS loop ***}
|
||
end;
|
||
|
||
if (quitafterdone) then
|
||
begin
|
||
elevel:=exitnormal; hangup:=TRUE; doneday:=TRUE; needtohangup:=TRUE;
|
||
end;
|
||
logoff;
|
||
if (not doneday) then sl1(#3#3+'Logoff '+#3#5+'['+dat+']');
|
||
|
||
if (textrec(sysopf1).mode=fmoutput) then
|
||
begin
|
||
{$I-} close(sysopf1); {$I+}
|
||
if (ioresult<>0) then writeln('Errors closing SLOGxxxx.LOG');
|
||
end;
|
||
|
||
if ((com_carrier) and (not doneday)) then
|
||
if (spd<>'KB') then needtohangup:=TRUE;
|
||
if (enddayf) then endday;
|
||
enddayf:=FALSE;
|
||
end;
|
||
until (doneday);
|
||
|
||
if (needtohangup) then hangupphone;
|
||
reset(sysopf); close(sysopf);
|
||
term_ready(TRUE); remove_port; {removeint(modemr.comport);}
|
||
|
||
if (exist('bbsdone.bat')) then shelldos(FALSE,'bbsdone.bat',rcode);
|
||
|
||
textcolor(7); clrscr; textcolor(14);
|
||
WriteLn('[> TeleGard-X - Exited with ErrorLevel ',elevel,' at '+date+' '+time);
|
||
halt(elevel);
|
||
end.
|