{*****************************************************************************

* 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,'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');

writeln(t,'Critical Error Log file - Contains screen images at instant of Error.');

writeln(t,'The "²" 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,'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');

{*****

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,'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');

writeln(t);

end;

writeln(t);

if (serialnumber<>0) then

s:=' ('+cstr(serialnumber)+vercs+')'

else

s:='';

writeln(t,'¯>¯ 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,'¯>¯ User "'+allcaps(thisuser.name)+' #'+cstr(usernum)+

'" was on '+s);

end;

writeln(t,'®®®®®®®®®®®®®®®®®®®®®®®®®®®® <®- Screen Image: -¯> ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯');

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,'®®®®®®®®®®®®®®®®®®®®®®®®®®®®®®®®®®®®®®®*¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯');

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.