telegard/initp.pas

586 lines
16 KiB
ObjectPascal

{$A+,B+,E+,F+,I+,L+,N-,O+,R-,S+,V-}
unit initp;
interface
uses
crt, dos,
{rcg11172000 no overlay under Linux.}
{overlay,}
myio,
common;
procedure readp;
procedure initp1;
procedure init;
implementation
const
openedyet:boolean=FALSE;
procedure scroll_clear(t:integer);
var i,j,k:integer;
begin
case t of
1:for i:=0 to 1 do
for j:=1 to 5 do
for k:=1 to 5 do
begin
window(1,(k-1)*5+1,80,k*5);
textcolor(7);
textbackground(i);
gotoxy(1,5);
writeln;
end;
2:for i:=1 downto 0 do
for j:=1 to 5 do
for k:=1 to 5 do
begin
window(1,(k-1)*5+1,80,k*5);
textcolor(7);
textbackground(i);
gotoxy(1,j);
clreol;
end;
end;
window(1,1,80,25);
end;
procedure tanim;
var s:array[1..5] of string;
i,j:integer;
begin
s[1]:=' °±²²²²²²²² °±²²²²²² °±²² °±²²²²²² °±²²²²²² °±²²²²² °±²²²²²² °±²²²²²² ';
s[2]:=' °±²² °±²² °±²² °±²² °±²² °±²² °±²² °±²² °±²² °±²² °±²²';
s[3]:=' °±²² °±²²²²² °±²² °±²²²²² °±²² °±²² °±²²²²²²² °±²²²²²² °±²² °±²²';
s[4]:=' °±²² °±²² °±²² °±²² °±²² °±²² °±²² °±²² °±²² °±²² °±²² °±²²';
s[5]:=' °±²² °±²²²²²² °±²²²²²²² °±²²²²²² °±²²²²²² °±²² °±²² °±²² °±²² °±²²²²²² ';
textbackground(1); textcolor(15); clrscr;
(*
for i:=30 downto 0 do begin
gotoxy(1,20);
for j:=1 to 5 do writeln(copy(s[j],(i)*(j-1),length(s[j])));
end;
for i:=18 downto 2 do begin
gotoxy(1,i);
for j:=1 to 5 do writeln(s[j]);
writeln(s[5]);
end;
for i:=24 downto 7 do begin
gotoxy(1,i);
clreol;
end;
*)
gotoxy(1,2);
for j:=1 to 5 do writeln(s[j]);
end;
procedure readp;
var filv:text;
d:astr;
a,count:integer;
function sc(s:astr; i:integer):char;
begin
s:=allcaps(s); sc:=s[i];
end;
procedure wpar(s:astr);
begin
writeln(' '+s);
end;
function atoi(s:astr):word;
var i,code:integer;
begin
val(s,i,code);
if code<>0 then i:=0;
atoi:=i;
end;
begin
cursoron(FALSE); exteventtime:=0;
answerbaud:=0; quitafterdone:=FALSE; returna:=FALSE; nightly:=FALSE;
{minitermonly:=FALSE;} localioonly:=FALSE;
a:=0;
while (a<paramcount) do begin
inc(a);
if ((sc(paramstr(a),1)='-') or (sc(paramstr(a),1)='/')) then
case sc(paramstr(a),2) of
'B':answerbaud:=atoi(copy(paramstr(a),3,length(paramstr(a))-2));
'E':if (length(paramstr(a))>=4) then begin
d:=allcaps(paramstr(a));
case d[3] of
'E':exiterrors:=value(copy(d,4,length(d)-3));
'N':exitnormal:=value(copy(d,4,length(d)-3));
end;
end;
'K':localioonly:=TRUE;
{'M':minitermonly:=TRUE;}
'N':nightly:=TRUE;
'P':packbasesonly:=TRUE;
'Q':quitafterdone:=TRUE;
'X':exteventtime:=atoi(copy(paramstr(a),3,length(paramstr(a))-2));
end;
end;
textcolor(15); textbackground(1); gotoxy(1,2);
tanim;
gotoxy(6,10); writeln('Initializing file');
textbackground(7); textcolor(0);
gotoxy(6,11); repeat write(' ') until wherex>=76;
textbackground(1);
gotoxy(6,15); textcolor(14); write('Command parameters specified:');
writeln;
textcolor(15);
if (paramcount=0) then wpar('None');
if (exitnormal<>255) then wpar('Normal exit Errorlevel = '+cstr(exitnormal));
if (exiterrors<>254) then wpar('Critical Error exit Errorlevel = '+cstr(exiterrors));
if (nightly) then wpar('Execute Nightly Event');
if (localioonly) then wpar('Local I/O ONLY');
if (answerbaud>0) then wpar('Answer at '+cstr(answerbaud)+' baud');
if (exteventtime>0) then wpar('External event in '+cstr(exteventtime)+' minute(s)');
if (quitafterdone) then wpar('Quit after user logoff');
{if (minitermonly) then wpar('MiniTerm only');}
if (packbasesonly) then wpar('Pack message bases only');
allowabort:=TRUE;
end;
procedure initp1;
var filv:text;
{systatf:file of systatrec;}
evf:file of eventrec;
fstringf:file of fstringrec;
modemrf:file of modemrec;
fidorf:file of fidorec;
fp:file;
wind:windowrec;
v:verbrec;
sx,sy,numread,i:integer;
errs,npatch:boolean;
s:astr;
procedure showmem;
var i,p:longint;
begin
exit;
textbackground(1); textcolor(15); gotoxy(20,13);
p:=40-(((40*memavail) div MaxHeapSpace)+1);
for i:=1 to 40 do
if (p>i+1) then begin
inc(i); write('Û');
end else
if (p>i) then write('Ý');
gotoxy(49,13); write(memavail,' bytes left');
end;
procedure show_initfile(s:astr);
function nocaps(s:astr):astr;
var i:integer;
begin
for i:=1 to length(s) do
if (s[i] in ['A'..'Z']) then s[i]:=chr(ord(s[i])+32);
nocaps:=s;
end;
begin
textbackground(7); textcolor(0);
gotoxy(6,11); repeat write(' ') until wherex>=76;
gotoxy(6,11);
if (copy(s,length(s),1)<>'!') then s:=systat.gfilepath+s
else s:=copy(s,1,length(s)-1);
{rcg11182000 this caps call is confusing with a case-sensitive filesystem.}
{write(caps(s));}
write(s);
textbackground(1);
showmem;
errs:=FALSE; npatch:=FALSE;
end;
procedure openwmsgs;
begin
openedyet:=TRUE;
setwindow(wind,6,15,75,23,15,1,7); clrscr;
sx:=1; sy:=1;
end;
procedure wmsgs(s:astr);
var x,y:integer;
begin
{rcg1118 this doesn't work without savescreen() and such in common.pas...}
{
x:=wherex; y:=wherey;
if (not openedyet) then openwmsgs;
textbackground(1); textcolor(15);
window(8,16,73,22);
gotoxy(sx,sy); writeln(s); sx:=wherex; sy:=wherey;
window(1,1,80,25); gotoxy(x,y);
}
writeln('STUB: initp.pas; wmsgs(''' + s + ''')...');
end;
procedure inmsgs(sh:astr; var s:astr; len:integer);
var x,y:integer;
begin
x:=wherex; y:=wherey;
wmsgs(sh);
textbackground(1); textcolor(15);
window(8,16,73,22);
gotoxy(sx,sy);
infielde(s,len);
window(1,1,80,25); gotoxy(x,y);
end;
function existdir(fn:astr):boolean;
var srec:searchrec;
begin
{rcg11182000 dosism.}
{while (fn[length(fn)]='\') do fn:=copy(fn,1,length(fn)-1);}
while (fn[length(fn)]='/') do fn:=copy(fn,1,length(fn)-1);
findfirst(fexpand(sqoutsp(fn)),anyfile,srec);
existdir:=(doserror=0) and (srec.attr and directory=directory);
end;
procedure abend(s:astr);
begin
wmsgs('*'+s+'* -- Aborting');
window(1,1,80,25); gotoxy(1,24); delay(3000);
halt(exiterrors);
end;
procedure findbadpaths;
var s,s1,s2:astr;
i:integer;
begin
infield_out_fgrd:=15;
infield_out_bkgd:=1;
infield_inp_fgrd:=0;
infield_inp_bkgd:=7;
with systat do
for i:=1 to 8 do begin
case i of 1:s1:='GFILES'; 2:s1:='MSGS'; 3:s1:='MENUS'; 4:s1:='TFILES';
5:s1:='AFILES'; 6:s1:='LOG'; 7:s1:='TEMP'; 8:s1:='SWAP';
end;
case i of
1:s:=gfilepath; 2:s:=msgpath;
3:s:=menupath; 4:s:=tfilepath;
5:s:=afilepath; 6:s:=trappath;
7:s:=temppath; 8:s:=swappath;
end;
if (not existdir(s)) then begin
cursoron(TRUE);
wmsgs('');
wmsgs('');
wmsgs(s1+' path is currently "'+s+'"');
wmsgs('This path is bad or missing.');
repeat
wmsgs('');
s2:=s; inmsgs('New '+s1+' path: ',s2,60); s2:=allcaps(sqoutsp(s2));
if (s=s2) or (s2='') then abend('Illegal pathname error')
else begin
if (s2<>'') then
{rcg11182000 dosism}
{if (copy(s2,length(s2),1)<>'\') then s2:=s2+'\';}
if (copy(s2,length(s2),1)<>'/') then s2:=s2+'/';
if (existdir(s2)) then
case i of
1:gfilepath:=s2; 2:msgpath:=s2;
3:menupath:=s2; 4:tfilepath:=s2;
5:afilepath:=s2; 6:trappath:=s2;
7:temppath:=s2; 8:swappath:=s2;
end
else begin
wmsgs('');
wmsgs('That path does not exist!');
end;
end;
until (existdir(s2));
cursoron(FALSE);
end;
end;
end;
begin
gotoxy(6,10); writeln('Initializing file');
textbackground(7); textcolor(0);
gotoxy(6,11); repeat write(' ') until wherex>=76;
textbackground(1); textcolor(15);
gotoxy(6,13); writeln('Record space ÞúúúúúúúúúúúúúúúúúúúúÝ');
wantout:=TRUE;
ldate:=daynum(date);
ch:=FALSE; lil:=0; thisuser.pagelen:=20; buf:=''; chatcall:=FALSE;
spd:=''; lastname:=''; ll:=''; chatr:=''; textcolor(0);
cursoron(FALSE); textcolor(0);
(*
show_initfile(start_dir+'\status.dat!');
assign(systatf,'status.dat');
{$I-} reset(systatf); {$I+}
errs:=(ioresult<>0);
if (errs) then begin
wmsgs('Unable to find STATUS.DAT data file. This file is absolutely');
wmsgs('*REQUIRED* to even load the BBS. If you cannot find your');
wmsgs('STATUS.DAT data file, re-create one using the INIT package.');
wmsgs('');
delay(1000); abend('Cannot find STATUS.DAT');
end else begin
{$I-} read(systatf,systat); {$I+}
errs:=(ioresult<>0);
close(systatf);
end;
*)
{rcg11182000 DOSism.}
{if (exist(start_dir+'\critical.err')) then begin }
{ assign(filv,start_dir+'\critical.err'); erase(filv);}
if (exist(start_dir+'/critical.err')) then begin
assign(filv,start_dir+'/critical.err'); erase(filv);
wmsgs('*** Critical error during last BBS execution! ***');
wmsgs('[>>> Updating STATUS.DAT <<<]');
inc(systat.todayzlog.criterr);
savesystat;
wascriterr:=TRUE;
end;
findbadpaths;
assign(fp,'msgtmp');
{$I-} reset(fp); {$I+}
if (ioresult=0) then begin close(fp); erase(fp); end;
show_initfile(systat.trappath+'sysop.log!');
assign(sysopf,systat.trappath+'sysop.log');
{$I-} append(sysopf); {$I+}
if (ioresult<>0) then begin
wmsgs('Bad or missing SYSOP.LOG - creating...');
rewrite(sysopf);
writeln(sysopf);
end;
assign(sysopf1,systat.trappath+'slogxxxx.log');
showmem;
first_time:=TRUE;
sl1(#3#7+'---------------> '+#3#5+'System booted on '+dat+#3#7+' <---------------');
show_initfile('modem.dat');
assign(modemrf,systat.gfilepath+'modem.dat');
reset(modemrf); read(modemrf,modemr); close(modemrf);
show_initfile('string.dat');
assign(fstringf,systat.gfilepath+'string.dat');
reset(fstringf); read(fstringf,fstring); close(fstringf);
show_initfile('fidonet.dat');
assign(fidorf,systat.gfilepath+'fidonet.dat');
{$I-} reset(fidorf); {$I+}
if (ioresult<>0) then begin
wmsgs('Bad or missing FIDONET.DAT - creating...');
rewrite(fidorf);
with fidor do begin
zone:=0; net:=0; node:=0; point:=0;
for i:=1 to 50 do origin[i]:=chr(0);
origin:=copy(stripcolor(systat.bbsname),1,50);
text_color:=1; quote_color:=3; tear_color:=9; origin_color:=5;
skludge:=TRUE; sseenby:=TRUE; sorigin:=FALSE;
scenter:=TRUE; sbox:=TRUE; mcenter:=TRUE;
for i:=1 to sizeof(res) do res[i]:=0;
end;
write(fidorf,fidor);
end else read(fidorf,fidor);
close(fidorf);
show_initfile('names.lst');
assign(sf,systat.gfilepath+'names.lst');
{$I-} reset(sf); {$I+}
if (ioresult<>0) then abend('Bad or missing NAMES.LST');
close(sf);
showmem;
show_initfile('user.lst');
assign(uf,systat.gfilepath+'user.lst');
reset(uf);
if (filesize(uf)>1) then begin
seek(uf,1);
read(uf,thisuser);
end else
thisuser.slogseperate:=FALSE;
reset(sf);
if (systat.numusers<>filesize(sf)) then begin
wmsgs('User count does not match with names list - fixing...');
wmsgs('(NAMEFIX should be used, just to be safe)');
systat.numusers:=filesize(sf);
savesystat;
end;
(* if (systat.numusers>filesize(uf)-1) then begin
wmsgs('NAMES.LST does not match up with USER.LST');
wmsgs('NAMEFIX should be ran!');
sysoplog(#3#7+'NAMES.LST does not match up with USER.LST');
sysoplog(#3#8+'NAMEFIX should be ran!');
end;*)
close(sf);
close(uf);
(* show_initfile('macro.lst');
assign(macrf,systat.gfilepath+'macro.lst');
{$I-} reset(macrf); {$I+}
if (ioresult<>0) then begin
wmsgs('Missing MACRO.LST - creating...');
rewrite(macrf);
end;
close(macrf);*)
show_initfile('verbose.dat');
assign(verbf,systat.gfilepath+'verbose.dat');
{$I-} reset(verbf); {$I+}
if (ioresult<>0) then rewrite(verbf);
close(verbf); reset(verbf);
{$I-} seek(verbf,0); read(verbf,v); {$I+}
if (ioresult<>0) then begin
wmsgs('Bad or missing VERBOSE.DAT - creating...');
rewrite(verbf);
v.descr[1]:='';
write(verbf,v);
end;
close(verbf);
show_initfile('protocol.dat');
assign(xf,systat.gfilepath+'protocol.dat');
reset(xf); close(xf);
show_initfile('events.dat');
new(events[0]);
with events[0]^ do begin
active:=nightly;
description:='Telegard Nightly Events';
etype:='D';
execdata:='night.bat';
busytime:=15;
exectime:=240; {* 4:00am *}
busyduring:=TRUE;
duration:=1;
execdays:=127; {* SMTWTFS *}
monthly:=FALSE;
end;
assign(fp,systat.gfilepath+'events.dat');
assign(evf,systat.gfilepath+'events.dat');
{$I-} reset(fp,1); {$I+}
if (ioresult<>0) then begin
wmsgs('Bad or missing EVENTS.DAT - creating...');
rewrite(evf); numevents:=1; new(events[1]);
with events[1]^ do begin
active:=FALSE;
description:='A NEW Telegard Event';
etype:='D';
execdata:='event.bat';
busytime:=5;
exectime:=0;
busyduring:=TRUE;
duration:=1;
execdays:=0;
monthly:=FALSE;
end;
write(evf,events[1]^);
end else begin
numevents:=0;
repeat
inc(numevents);
new(events[numevents]); (* DEFINE DYNAMIC MEMORY! *)
blockread(fp,events[numevents]^,sizeof(eventrec),numread);
if ((numread<>sizeof(eventrec)) and (numread<>0)) then npatch:=TRUE;
showmem;
until (numread<>sizeof(eventrec)) or (eof(fp));
end;
close(fp);
if (npatch) then begin
wmsgs('Errors in EVENTS.DAT - patching...');
rewrite(evf);
for i:=1 to numevents do write(evf,events[i]^);
close(evf);
end;
show_initfile('boards.dat');
assign(fp,systat.gfilepath+'boards.dat');
assign(bf,systat.gfilepath+'boards.dat');
reset(fp,1); numboards:=0;
repeat
inc(numboards);
blockread(fp,memboard,sizeof(boardrec),numread);
if ((numread<>sizeof(boardrec)) and (numread<>0)) then npatch:=TRUE;
showmem;
until (numread<>sizeof(boardrec)) or (eof(fp));
close(fp);
if (npatch) then
wmsgs(^G'Errors in BOARDS.DAT - run FIX for BOARDS.DAT...'^G);
show_initfile('uploads.dat');
assign(fp,systat.gfilepath+'uploads.dat');
assign(ulf,systat.gfilepath+'uploads.dat');
reset(fp,1); maxulb:=-1;
repeat
inc(maxulb);
blockread(fp,memuboard,sizeof(ulrec),numread);
if ((numread<>sizeof(ulrec)) and (numread<>0)) then npatch:=TRUE;
showmem;
until (numread<>sizeof(ulrec)) or (eof(fp));
close(fp);
if (npatch) then
wmsgs(^G'Errors in UPLOADS.DAT - run FIX for UPLOADS.DAT...'^G);
(* show_initfile('email.dat');
assign(mailfile,systat.gfilepath+'email.dat');*)
show_initfile('shortmsg.dat');
assign(smf,systat.gfilepath+'shortmsg.dat');
{ show_initfile(systat.trappath+'chat.msg!');
assign(cf,systat.trappath+'chat.msg');}
cfo:=FALSE;
if (openedyet) then removewindow(wind);
textbackground(0); textcolor(7); clrscr;
end;
procedure init;
var rcode:integer;
begin
if (daynum(date)=0) then begin
clrscr;
writeln('Please set the date & time, it is required for operation.');
halt(exiterrors);
end;
hangup:=FALSE; incom:=FALSE; outcom:=FALSE;
echo:=TRUE; doneday:=FALSE;
checkbreak:=FALSE;
slogging:=TRUE; trapping:=FALSE;
readingmail:=FALSE; sysopon:=FALSE; inmsgfileopen:=FALSE;
beepend:=FALSE;
wascriterr:=FALSE;
checksnow:=systat.cgasnow;
directvideo:=not systat.usebios;
readp; initp1;
(* setuprs232(modemr.comport,4,0,8,1);
installint(modemr.comport); {installint(2);}*)
iport;
if (exist('bbsstart.bat')) then shelldos(FALSE,'bbsstart.bat',rcode);
end;
end.