(*****************************************************************************) (*> <*) (*> Telegard Bulletin Board System - Copyright 1988,89,90 by <*) (*> Eric Oman, Martin Pollard, and Todd Bolitho - All rights reserved. <*) (*> <*) (*> Program name: INIT.PAS <*) (*> Program purpose: Initialization program for new systems <*) (*> <*) (*****************************************************************************) program init; {$A+,B+,E+,F+,I+,L+,N-,O+,R-,S+,V-} {$M 50000,0,1024} { Declared here suffices for all Units as well! } uses crt, dos, myio, timejunk; {$I rec25.pas} var systatf:file of systatrec; systat:systatrec; modemf:file of modemrec; modemr:modemrec; fstringf:file of fstringrec; fstring:fstringrec; uf:file of userrec; u:userrec; sf:file of smalrec; sr:smalrec; bf:file of boardrec; br:boardrec; uff:file of ulrec; ufr:ulrec; xp:file of protrec; xpr:protrec; zf:file of zlogrec; zfr:zlogrec; brdf:file; mixf:file; tref:file; (* mailfile:file of mailrec; mr:mailrec;*) lcallf:file of lcallers; lcall:lcallers; tfilf:file of tfilerec; tfil:tfilerec; verbf:file of verbrec; vr:verbrec; vdata:file of vdatar; vd:vdatar; smf:file of smr; sm:smr; ulff:file of ulfrec; ulffr:ulfrec; evf:file of eventrec; evr:eventrec; macrf:file of macrorec; macr:macrorec; fidorf:file of fidorec; fidor:fidorec; curdir:string; path:array[1..8] of string; found:boolean; dirinfo:searchrec; i,j,k:integer; c:char; function syn(b:boolean):astr; begin if (b) then syn:='Yes' else syn:='No '; end; function yn:boolean; var c:char; b:boolean; begin repeat c:=upcase(readkey) until c in ['Y','N',^M]; case c of 'Y':b:=TRUE; else b:=FALSE; end; write(syn(b)); yn:=b; end; function pynq(s:string):boolean; begin textcolor(4); write(s); textcolor(11); pynq:=yn; end; procedure prt(s:string); begin textcolor(9); write(s); end; procedure star(s:string); begin textcolor(9); write('þ '); textcolor(11); cwrite(s); writeln; end; function freek(d:integer):longint; var lng:longint; begin lng:=diskfree(d); freek:=lng div 1024; end; function exdrv(s:astr):byte; begin {rcg11172000 always 'C' under Linux...} { s:=fexpand(s); exdrv:=ord(s[1])-64; } exdrv := 3; end; function leapyear(yr:integer):boolean; begin leapyear:=(yr mod 4=0) and ((yr mod 100<>0) or (yr mod 400=0)); end; function value(s:astr):longint; var i,j:integer; begin val(s,i,j); if (j<>0) then begin s:=copy(s,1,j-1); val(s,i,j) end; value:=i; if (s='') then value:=0; end; function days(mo,yr:integer):integer; var d:integer; begin d:=value(copy('312831303130313130313031',1+(mo-1)*2,2)); if ((mo=2) and (leapyear(yr))) then inc(d); days:=d; end; function daycount(mo,yr:integer):integer; var m,t:integer; begin t:=0; for m:=1 to (mo-1) do t:=t+days(m,yr); daycount:=t; end; function daynum(dt:astr):integer; var d,m,y,t,c:integer; begin t:=0; m:=value(copy(dt,1,2)); d:=value(copy(dt,4,2)); {rcg11182000 hahahaha...a Y2K bug. :) } {rcg11272000 Let's make sure the values coming in here are four } {digits in the first place, which should save us some hacks elsewhere...} {y:=value(copy(dt,7,2))+1900;} {rcg11272000 my adds...} y:=value(copy(dt,7,4)); {rcg11272000 end my adds...} for c:=1985 to y-1 do if (leapyear(c)) then inc(t,366) else inc(t,365); t:=t+daycount(m,y)+(d-1); daynum:=t; if y<1985 then daynum:=0; end; function tch(s:astr):astr; begin if (length(s)>2) then s:=copy(s,length(s)-1,2) else if (length(s)=1) then s:='0'+s; tch:=s; end; function time:astr; var h,m,s:string[3]; hh,mm,ss,ss100:word; begin gettime(hh,mm,ss,ss100); str(hh,h); str(mm,m); str(ss,s); time:=tch(h)+':'+tch(m)+':'+tch(s); end; function date:string; var {rcg11272000 unused variable.} {r:registers;} {rcg11272000 Y2K-proofing.} {y,m,d:string[3];} m,d:string[3]; y:string[5]; yy,mm,dd,dow:word; begin getdate(yy,mm,dd,dow); {rcg11272000 Y2K-proofing.} {str(yy-1900,y); str(mm,m); str(dd,d);} str(yy,y); str(mm,m); str(dd,d); date:=tch(m)+'/'+tch(d)+'/'+y; end; procedure ttl(s:string); begin writeln; textcolor(9); write('ÄÄ['); textbackground(1); textcolor(15); write(' '+s+' '); textbackground(0); textcolor(9); write(']'); repeat write('Ä') until wherex=80; writeln; end; (* FIX THIS UP *) procedure movefile(var ok,nospace:boolean; showprog:boolean; srcname,destname:astr); var buffer:array[1..16384] of byte; fs,dfs:longint; nrec,i:integer; src,dest:file; procedure dodate; var r:registers; od,ot,ha:integer; begin srcname:=srcname+#0; destname:=destname+#0; with r do begin ax:=$3d00; ds:=seg(srcname[1]); dx:=ofs(srcname[1]); msdos(dos.registers(r)); ha:=ax; bx:=ha; ax:=$5700; msdos(dos.registers(r)); od:=dx; ot:=cx; bx:=ha; ax:=$3e00; msdos(dos.registers(r)); ax:=$3d02; ds:=seg(destname[1]); dx:=ofs(destname[1]); msdos(dos.registers(r)); ha:=ax; bx:=ha; ax:=$5701; cx:=ot; dx:=od; msdos(dos.registers(r)); ax:=$3e00; bx:=ha; msdos(dos.registers(r)); end; end; begin ok:=TRUE; nospace:=FALSE; assign(src,srcname); {$I-} reset(src,1); {$I+} if (ioresult<>0) then begin ok:=FALSE; exit; end; {rcg11172000 why bother checking total disk space in a modern OS?} { dfs:=freek(exdrv(destname)); fs:=trunc(filesize(src)/1024.0)+1; if (fs>=dfs) then begin close(src); nospace:=TRUE; ok:=FALSE; exit; end else begin } assign(dest,destname); {$I-} rewrite(dest,1); {$I+} if (ioresult<>0) then begin ok:=FALSE; exit; end; repeat blockread(src,buffer,16384,nrec); blockwrite(dest,buffer,nrec); until (nrec<16384); close(dest); close(src); dodate; erase(src); {rcg11172000 why bother checking total disk space in a modern OS?} {end;} end; procedure ffile(fn:string); begin findfirst(fn,anyfile,dirinfo); found:=(doserror=0); end; procedure nfile; begin findnext(dirinfo); found:=(doserror=0); end; procedure movefile1(srcname,destpath:string); var ps,ns,es:string; ok,nospace:boolean; begin ok:=TRUE; nospace:=FALSE; fsplit(srcname,ps,ns,es); star(srcname+#3#9+' -- '+#3#11+destpath); movefile(ok,nospace,FALSE,srcname,destpath+ns+es); if (not ok) then if (nospace) then star('Move failed: Insufficient space!!'^G) else star('Move failed!!'^G); end; procedure movefiles(srcname,destpath:string); var ok,nospace:boolean; begin ffile(srcname); while found do begin movefile1(dirinfo.name,destpath); nfile; end; end; function make_path(s:string):boolean; begin {rcg11182000 dosism.} {while (copy(s,length(s),1)='\') do s:=copy(s,1,length(s)-1);} while (copy(s,length(s),1)='/') do s:=copy(s,1,length(s)-1); make_path:=TRUE; {$I-} mkdir(fexpand(s)); {$I+} if (ioresult<>0) then begin writeln; star('Error creating directory "'+fexpand(s)+'"'^G^G); make_path:=FALSE; end; end; procedure make_paths; var s:string; begin {rcg11182000 1 to 7? Swap path is excluded...} {for i:=1 to 7 do begin} for i:=1 to 8 do begin {rcg11182000 dosism.} {while copy(path[i],length(path[i]),1)='\' do} while copy(path[i],length(path[i]),1)='/' do path[i]:=copy(path[i],1,length(path[i])-1); case i of 1:s:='GFILES'; 2:s:='MSGS'; 3:s:='MENUS'; 4:s:='TFILES'; 5:s:='AFILES'; 6:s:='TRAP'; 7:s:='TEMP'; 8:s:='SWAP'; end; star(s+' path ("'+fexpand(path[i])+'")'); if (not make_path(path[i])) then halt(1); {rcg11182000 dosism.} {path[i]:=path[i]+'\';} path[i]:=path[i]+'/'; end; (* star('Creating EMAIL and GENERAL message paths'); if (not make_path(path[2]+'EMAIL\')) then halt(1); if (not make_path(path[2]+'GENERAL\')) then halt(1);*) star('Creating SYSOP and MISC file paths'); {rcg11182000 dosisms.} { if (not make_path('DLS\')) then halt(1); if (not make_path('DLS\SYSOP')) then halt(1); if (not make_path('DLS\MISC')) then halt(1); star('Creating TEMP 1, 2, and 3 file paths'); if (not make_path(path[7]+'1\')) then halt(1); if (not make_path(path[7]+'2\')) then halt(1); if (not make_path(path[7]+'3\')) then halt(1); } if (not make_path('DLS/')) then halt(1); if (not make_path('DLS/SYSOP')) then halt(1); if (not make_path('DLS/MISC')) then halt(1); star('Creating TEMP 1, 2, and 3 file paths'); if (not make_path(path[7]+'1/')) then halt(1); if (not make_path(path[7]+'2/')) then halt(1); if (not make_path(path[7]+'3/')) then halt(1); end; procedure make_status_dat; begin with systat do begin gfilepath:=path[1]; msgpath:=path[2]; menupath:=path[3]; tfilepath:=path[4]; afilepath:=path[5]; trappath:=path[6]; temppath:=path[7]; bbsname:='Telegard BBS'; bbsphone:='000-000-0000'; sysopname:='System Operator'; maxusers:=9999; lowtime:=0; hitime:=0; dllowtime:=0; dlhitime:=0; shuttlelog:=FALSE; lock300:=FALSE; sysoppw:='SYSOP'; newuserpw:=''; shuttlepw:='MATRIX'; b300lowtime:=0; b300hitime:=0; b300dllowtime:=0; b300dlhitime:=0; closedsystem:=FALSE; swapshell:=FALSE; eventwarningtime:=60; tfiledate:=date; { with hmsg do begin ltr:='A'; number:=-32766; ext:=1; end; } {* A-32767.1 is the "Greetings from Telegard" message *} for i:=1 to 20 do res1[i]:=0; sop:='s255'; csop:='s250'; msop:='s199'; fsop:='s230'; spw:='s250'; seepw:='s255'; normpubpost:='s11'; normprivpost:='s11'; anonpubread:='s100'; anonprivread:='s100'; anonpubpost:='s100'; anonprivpost:='s100'; seeunval:='s50'; dlunval:='s230'; nodlratio:='s255'; nopostratio:='s200'; nofilepts:='s255'; ulvalreq:='s21'; for i:=1 to 100 do res2[i]:=0; maxprivpost:=20; maxfback:=5; maxpubpost:=20; maxchat:=3; maxwaiting:=15; csmaxwaiting:=50; maxlines:=120; csmaxlines:=160; maxlogontries:=4; bsdelay:=20; sysopcolor:=4; usercolor:=3; minspaceforpost:=10; minspaceforupload:=100; backsysoplogs:=7; wfcblanktime:=0; linelen:=80; pagelen:=25; for i:=1 to 18 do res3[i]:=0; specialfx:=TRUE; fossil:=FALSE; allowalias:=TRUE; phonepw:=TRUE; localsec:=FALSE; localscreensec:=FALSE; globaltrap:=FALSE; autochatopen:=TRUE; autominlogon:=TRUE; bullinlogon:=TRUE; lcallinlogon:=TRUE; yourinfoinlogon:=TRUE; multitask:=FALSE; offhooklocallogon:=TRUE; forcevoting:=FALSE; compressbases:=FALSE; searchdup:=FALSE; slogtype:=0; stripclog:=FALSE; newapp:=1; guestuser:=-1; timeoutbell:=2; timeout:=5; usewfclogo:=TRUE; useems:=FALSE; usebios:=TRUE; cgasnow:=FALSE; for i:=1 to 16 do res4[i]:=0; for i:=1 to 5 do with filearcinfo[i] do case i of 1:begin active:=TRUE; ext:='ZIP'; listline:='/1'; arcline:='PKZIP -aex @F @I'; unarcline:='PKUNZIP @F @I'; testline:='PKUNZIP -t @F'; cmtline:='PKZIP -z @F'; succlevel:=0; end; 2:begin active:=FALSE; ext:='ARC'; listline:='/2'; arcline:='PKPAK a @F @I'; unarcline:='PKUNPAK @F @I'; testline:='PKUNPAK -t @F'; cmtline:='PKPAK x @F'; succlevel:=0; end; 3:begin active:=FALSE; ext:='PAK'; listline:='/2'; arcline:='PAK a @F @I'; unarcline:='PAK e @F @I'; testline:='PAK t @F'; cmtline:=''; succlevel:=-1; end; 4:begin active:=FALSE; ext:='LZH'; listline:='/4'; arcline:='LHARC a @F @I'; unarcline:='LHARC e @F @I'; testline:='LHARC t @F'; cmtline:=''; succlevel:=0; end; 5:begin active:=FALSE; ext:='ZOO'; listline:='/3'; arcline:='ZOO aP: @F @I'; unarcline:='ZOO x @F @I'; testline:='ZOO xNd @F'; cmtline:='ZOO cA @F'; succlevel:=0; end; 6:begin active:=FALSE; ext:='DWC'; listline:='DWC v @F'; arcline:='DWC a @F @I'; unarcline:='DWC x @F @I'; testline:='DWC t @F'; cmtline:=''; succlevel:=0; end; end; filearcinfo[6].ext:=''; filearccomment[1]:=bbsname+' '+bbsphone; filearccomment[2]:=''; filearccomment[3]:=''; uldlratio:=TRUE; fileptratio:=FALSE; fileptcomp:=3; fileptcompbasesize:=10; ulrefund:=100; tosysopdir:=0; validateallfiles:=FALSE; remdevice:='COM1'; maxintemp:=500; minresume:=100; maxdbatch:=20; maxubatch:=20; for i:=1 to 30 do res5[i]:=0; newsl:=20; newdsl:=20; newar:=[]; newac:=[rpostan,rvoting]; newfp:=0; autosl:=50; autodsl:=50; autoar:=[]; autoac:=[]; allstartmenu:='MAIN'; chatcfilter1:=''; chatcfilter2:=''; bulletprefix:='BULLET'; for i:=1 to 15 do res6[i]:=0; for i:=0 to 255 do begin case i of 0..9:k:=1; 10..19:k:=10; 20..29:k:=20; 30..39:k:=40; 40..49:k:=50; 50..59:k:=80; 60..69:k:=90; 70..79:k:=100; 80..89:k:=110; 90..99:k:=120; 100..199:k:=130; 200..239:k:=150; 240..249:k:=200; 250:k:=250; 251..255:k:=6000; end; timeallow[i]:=k; case i of 200..255:k:=20; 100..199:k:=15; 50..99:k:=10; 30..49:k:=5; 20..29:k:=3; else k:=1; end; callallow[i]:=k; case i of 60..255:k:=5; 20..59:k:=3; else k:=2; end; dlratio[i]:=k; case i of 60..255:k:=10; 20..59:k:=5; else k:=2; end; dlkratio[i]:=k; postratio[i]:=100; end; lastdate:=date; curwindow:=1; istopwindow:=FALSE; callernum:=0; numusers:=1; with todayzlog do begin for i:=0 to 4 do userbaud[i]:=0; active:=0; calls:=0; newusers:=0; pubpost:=0; privpost:=0; fback:=0; criterr:=0; uploads:=0; downloads:=0; uk:=0; dk:=0; end; postcredits:=0; rebootforevent:=FALSE; watchdogdoor:=FALSE; windowon:=TRUE; swappath:=path[8]; for i:=1 to 119 do res[i]:=0; end; assign(systatf,'status.dat'); rewrite(systatf); write(systatf,systat); close(systatf); end; procedure make_fidonet_dat; begin with fidor do begin zone:=0; net:=0; node:=0; point:=0; origin:=copy(systat.bbsname+' ('+systat.bbsphone+')',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; addtear:=TRUE; end; assign(fidorf,'fidonet.dat'); rewrite(fidorf); write(fidorf,fidor); close(fidorf); end; procedure make_modem_dat; var i,j:integer; begin with modemr do begin waitbaud:=1200; comport:=1; init:='ATH0Q0V0E0M0X1S0=0S2=43S10=40&C1'; answer:='ATA'; hangup:='~~~+++~~~ATH0'; offhook:='ATH1M0'; nocallinittime:=30; arq9600rate:=9600; noforcerate:=FALSE; nocarrier:=3; nodialtone:=6; busy:=7; for i:=1 to 2 do for j:=0 to 4 do begin case i of 1:case j of 0:k:=1; 1:k:=5; 2:k:=10; 3:k:=0; 4:k:=13; end; 2:case j of 0:k:=0; 1:k:=15; 2:k:=16; 3:k:=0; 4:k:=17; end; end; resultcode[i][j]:=k; end; modemr.ctschecking:=TRUE; modemr.dsrchecking:=TRUE; modemr.usexonxoff:=FALSE; modemr.hardwired:=FALSE; end; assign(modemf,'modem.dat'); rewrite(modemf); write(modemf,modemr); close(modemf); end; procedure make_string_dat; begin with fstring do begin ansiq:='Display ANSI logon? '; note[1]:='Enter your Telegard NAME or USER NUMBER'; note[2]:='* NEW USERS, enter "NEW" *'; lprompt:='Logon : '; echoc:='X'; sysopin:='^3The SysOp is probably around!'; sysopout:='^3The SysOp is NOT here, or doesn''t want to chat'; engage:='@M^3The SysOp brings you into chat!'; endchat:='^3The SysOp returns you to the BBS....@M'; wait:='^3{-^9Please Wait^3-}'; pause:='(* pause *)'; entermsg1:='Enter message now. You have ^3@X^1 lines maximum.'; entermsg2:='Enter ^3/S^1 to save. ^3/?^1 for a list of commands.'; newscan1:='^7[^5@Y ^7- ^5@W msgs^7] ^4NewScan began.@M'; newscan2:='^7[^5@Y ^7- ^5@W msgs^7] ^4NewScan complete.@M'; scanmessage:='^3[^1@Y^3]@M^5[@U] ^4Read (1-@W,,?=help) : '; automsgt:='^5AutoMessage by: '; autom:='-'; shelldos1:=#3#5+'>> '+systat.sysopname+' has shelled to DOS, please wait ...'; shelldos2:=#3#5+'>> Thank you for waiting'; chatcall1:=#3#0+'Paging '+systat.sysopname+' for chat, please wait.....'; chatcall2:=#3#7+' >>'+#3#5+'<'+#3#8+'*'+#3#5+'>'+#3#7+'<<'; guestline:='Enter "GUEST" as your user name to be a guest user on the system.'; namenotfound:=#3#5+'That name is'+#3#8+' NOT'+#3#5+' found in the user list.'; bulletinline:=#3#4+'Enter Bulletin Selection (XX,?,Q=Quit) : '; thanxvote:=#3#3+'Thanks for taking the time to vote!'; listline:='List files - P to Pause'; newline:='Search for new files -'; searchline:='Search all directories for a file mask -'; findline1:='Search descriptions and filenames for keyword -'; findline2:='Enter the string to search for:'; downloadline:='Download - You have @P file points.'; uploadline:='Upload - @Kk free on this drive'; viewline:='View archive interior files -@MP to Pause, N for Next file'; nofilepts:=#3#8+'Access denied: '+#3#5+'Insufficient file points to download.'; unbalance:=#3#8+'Access denied: '+#3#5+'Your upload/download ratio is out of balance:'; pninfo:='P to Pause, N for next directory'; gfnline1:='[Enter]=All files'; gfnline2:=#3#4+'File mask: '; batchadd:='File added to batch queue.'; end; assign(fstringf,'string.dat'); rewrite(fstringf); write(fstringf,fstring); close(fstringf); end; procedure make_user_lst; const dcols:clrs=((15,7,7,15,15,15,112,7,143,7),(15,7,1,11,9,14,31,4,140,10)); begin with u do begin name:='SYSOP'; realname:='System Operator'; pw:='SYSOP'; ph:='000-000-0000'; {rcg11272000 y2k stuff.} {bday:='00/00/00';} bday:='00/00/0000'; firston:=date; laston:=date; street:=''; citystate:=''; zipcode:=''; computer:='IBM Compatible'; occupation:=''; wherebbs:=''; note:='Change these stats to yours.'; lockedout:=FALSE; deleted:=FALSE; lockedfile:=''; ac:=[onekey,pause,novice,ansi,color, smw, {* short message waiting, in SHORTMSG.DAT *} fnodlratio,fnopostratio,fnofilepts,fnodeletion]; ar:=[]; for c:='A' to 'Z' do ar:=ar+[c]; (* with qscan[1] do begin ltr:='A'; number:=-32767; ext:=1; end;*) (* for i:=2 to maxboards do qscan[i]:=qscan[1];*) (* for i:=1 to maxboards do qscn[i]:=TRUE;*) (* dlnscn:=[];*) (* for i:=0 to maxuboards do dlnscn:=dlnscn+[i];*) for i:=1 to 20 do vote[i]:=0; sex:='M'; ttimeon:=0; uk:=0; dk:=0; uploads:=0; downloads:=0; loggedon:=0; tltoday:=600; msgpost:=0; emailsent:=0; feedback:=0; forusr:=0; filepoints:=0; waiting:=1; {* A-32767.1 -- "Greetings from Telegard" message *} linelen:=80; pagelen:=20; {* to make room for SysOp window when on.. *} ontoday:=0; illegal:=0; sl:=255; dsl:=255; cols:=dcols; lastmsg:=1; lastfil:=0; credit:=0; timebank:=0; for i:=1 to 5 do boardsysop[i]:=255; trapactivity:=FALSE; trapseperate:=FALSE; timebankadd:=0; mpointer:=-1; chatauto:=FALSE; chatseperate:=FALSE; userstartmenu:=''; slogseperate:=FALSE; {* NEW STUFF *} clsmsg:=2; { clear screen before displaying each message } flistopt:=1; { use file listing option #1 (normal) } msgorder:=0; { use Chrono message ordering } avadjust:=1; { no AVATAR color adjustment } {* NEW STUFF *ENDS* *} for i:=1 to 54 do res[i]:=0; end; assign(uf,'user.lst'); rewrite(uf); seek(uf,0); write(uf,u); { write dummy record } seek(uf,1); write(uf,u); { write user #1 } close(uf); end; procedure make_names_lst; begin with sr do begin name:='SYSOP'; number:=1; end; assign(sf,'names.lst'); rewrite(sf); seek(sf,0); write(sf,sr); seek(sf,1); write(sf,sr); {* think that was the bug... time will tell *} close(sf); end; procedure make_macro_lst; var i:integer; begin with macr do for i:=1 to 4 do macro[i]:=''; assign(macrf,'macro.lst'); rewrite(macrf); seek(macrf,0); write(macrf,macr); close(macrf); end; procedure make_boards_dat; begin with br do begin name:='General Messages'; filename:='GENERAL'; msgpath:=''; acs:=''; postacs:='vv'; mciacs:='%'; maxmsgs:=50; anonymous:=atno; password:=''; mbstat:=[mbskludge,mbsseenby,mbscenter,mbsbox,mbmcenter,mbaddtear]; permindx:=0; mbtype:=1; origin:=fidor.origin; text_color:=fidor.text_color; quote_color:=fidor.quote_color; tear_color:=fidor.tear_color; origin_color:=fidor.origin_color; for i:=1 to 11 do res[i]:=0; end; assign(bf,'boards.dat'); rewrite(bf); write(bf,br); close(bf); end; procedure make_uploads_dat; begin assign(uff,'uploads.dat'); rewrite(uff); with ufr do begin name:='SysOp directory'; filename:='SYSOP'; {rcg11182000 dosisms} {dlpath:=curdir+'\DLS\SYSOP\';} dlpath:=curdir+'/DLS/SYSOP/'; ulpath:=dlpath; maxfiles:=2000; password:=''; arctype:=1; cmttype:=1; fbdepth:=0; fbstat:=[]; acs:='s255d255'; ulacs:=''; nameacs:='s255'; permindx:=0; for i:=1 to 6 do res[i]:=0; end; write(uff,ufr); with ufr do begin name:='Miscellaneous'; filename:='MISC'; {rcg11182000 dosisms} {dlpath:=curdir+'\DLS\MISC\';} dlpath:=curdir+'/DLS/MISC/'; ulpath:=dlpath; maxfiles:=2000; password:=''; arctype:=1; cmttype:=1; fbdepth:=0; fbstat:=[]; acs:='d30'; ulacs:=''; nameacs:=''; permindx:=1; for i:=1 to 6 do res[i]:=0; end; write(uff,ufr); close(uff); end; procedure make_zlog_dat; var i:integer; begin with zfr do begin date:='08/18/89'; for i:=0 to 4 do userbaud[i]:=0; active:=0; calls:=0; newusers:=0; pubpost:=0; privpost:=0; fback:=0; criterr:=0; uploads:=0; downloads:=0; uk:=0; dk:=0; end; assign(zf,'zlog.dat'); rewrite(zf); write(zf,zfr); zfr.date:=''; write(zf,zfr); close(zf); end; procedure blockwritestr(var f:file; s:string); begin blockwrite(f,s[0],1); blockwrite(f,s[1],ord(s[0])); end; procedure savemhead1(var brdf:file; mhead:mheaderrec); procedure outftinfo(var ft:fromtoinfo); var s:string; begin with ft do begin blockwrite(brdf,anon,1); blockwrite(brdf,usernum,2); blockwritestr(brdf,as); blockwritestr(brdf,real); blockwritestr(brdf,alias); end; end; begin with mhead do begin blockwrite(brdf,signature,4); blockwrite(brdf,msgptr,4); blockwrite(brdf,isreplyto_iddate,6); blockwrite(brdf,isreplyto_idrand,2); blockwritestr(brdf,title); outftinfo(fromi); outftinfo(toi); blockwritestr(brdf,originsite); end; end; procedure make_email_brd; var t:text; fb:file; mheader:mheaderrec; mixr:msgindexrec; s:string; dt:ldatetimerec; pdt:packdatetime; lng,lsize:longint; i:integer; bb:byte; year,month,day,dow,hour,min,sec,sec100:word; begin assign(fb,'tosysop.ltr'); reset(fb,1); lsize:=filesize(fb); close(fb); assign(t,'tosysop.ltr'); reset(t); assign(brdf,'email.brd'); rewrite(brdf,1); {rcg12152000 changed for sanity...} { lng:=$FC020010; blockwrite(brdf,lng,4); lng:=$DCBA0123; blockwrite(brdf,lng,4); blockwrite(brdf,lsize,4); while (not eof(t)) do begin readln(t,s); bb:=$FF; blockwrite(brdf,bb,1); blockwrite(brdf,s[0],1); blockwrite(brdf,s[1],ord(s[0])); end; } { lng:=$FC020010; blockwrite(brdf,lng,sizeof (lng)); lng:=$DCBA0123; blockwrite(brdf,lng,sizeof (lng)); blockwrite(brdf,lsize,sizeof (lsize)); while (not eof(t)) do begin readln(t,s); bb:=$FF; blockwrite(brdf,bb,sizeof (bb)); blockwrite(brdf,s[0],1); blockwrite(brdf,s[1],ord(s[0])); end; } close(t); erase(t); with mixr do begin messagenum:=1; hdrptr:=filesize(brdf); msgindexstat:=[miexist]; msgid:=4242; getdate(year,month,day,dow); dt.year:=year; dt.month:=month; dt.day:=day; gettime(hour,min,sec,sec100); dt.hour:=hour; dt.min:=min; dt.sec:=sec; dt.sec100:=sec100; dt2pdt(dt,pdt); for i:=1 to 6 do msgdate[i]:=pdt[i]; msgdowk:=0; for i:=1 to 6 do lastdate[i]:=pdt[i]; lastdowk:=0; isreplyto:=65535; numreplys:=0; end; assign(mixf,'email.mix'); rewrite(mixf,sizeof(mixr)); blockwrite(mixf,mixr,1); close(mixf); with mheader do begin signature:=$ABCD0123; msgptr:=4; for i:=1 to 6 do isreplyto_iddate[i]:=0; isreplyto_idrand:=0; title:='Greetings, new Telegard SysOp!!'; with fromi do begin anon:=0; usernum:=1; as:='The Telegard Team'; real:='The Telegard Team'; alias:='The Telegard Team'; end; with toi do begin anon:=0; usernum:=1; as:='SysOp #1'; real:='System Operator'; alias:='SysOp'; end; originsite:=''; end; savemhead1(brdf,mheader); close(brdf); end; procedure make_events_dat; begin assign(evf,'events.dat'); rewrite(evf); with evr do begin active:=TRUE; (* event is active *) description:='Pack message bases'; etype:='P'; (* PACK BASES event type *) execdata:=''; (* no exec data needed *) busytime:=0; (* no offhook before event *) exectime:=240; (* 240 mins past midnite -- i.e. 4:00a *) busyduring:=TRUE; (* take phone offhook during *) duration:=1; (* 1 minute long *) execdays:=127; (* every day of the week *) monthly:=FALSE; (* weekly, not monthly *) end; write(evf,evr); with evr do begin active:=FALSE; (* event is NOT active *) description:='Nightly events'; etype:='D'; (* DOS SHELL event type *) execdata:='night.bat'; (* call NIGHT.BAT *) busytime:=1; (* take phone offhook 1 min before *) exectime:=241; (* 241 mins past midnite -- i.e. 4:01a *) busyduring:=TRUE; (* take phone offhook during *) duration:=1; (* 1 minute long *) execdays:=127; (* every day of the week *) monthly:=FALSE; (* weekly, not monthly *) end; write(evf,evr); close(evf); end; procedure make_laston_dat; begin with lcall do begin callernum:=0; name:='The Telegard Team'; number:=0; citystate:='Telegard Development HQ, MI'; end; assign(lcallf,'laston.dat'); rewrite(lcallf); write(lcallf,lcall); lcall.callernum:=-1; for i:=1 to 9 do write(lcallf,lcall); close(lcallf); end; procedure make_gfiles_dat; begin assign(tfilf,'gfiles.dat'); rewrite(tfilf); for i:=0 to 1 do begin with tfil do case i of 0:begin title:=''; filen:=''; gdate:=date; gdaten:=1; acs:=''; ulacs:=''; tbstat:=[]; permindx:=0; tbdepth:=0; for j:=1 to 4 do res[j]:=0; end; 1:begin title:='Miscellaneous'; filen:=#1#0#0#0#0#0; gdate:=date; gdaten:=daynum(gdate); acs:=''; ulacs:=''; tbstat:=[]; permindx:=0; tbdepth:=0; for j:=1 to 4 do res[j]:=0; end; end; write(tfilf,tfil); end; close(tfilf); end; procedure make_verbose_dat; begin with vr do for i:=1 to 4 do descr[i]:=''; assign(verbf,'verbose.dat'); rewrite(verbf); write(verbf,vr); close(verbf); end; procedure make_voting_dat; begin with vd do begin question:='<< No Question >>'; numa:=0; for i:=0 to 9 do with answ[i] do begin if (i<>0) then ans:='Selection '+chr(i+48) else ans:='No Comment'; numres:=0; end; end; assign(vdata,'voting.dat'); rewrite(vdata); for i:=0 to 19 do write(vdata,vd); close(vdata); end; procedure make_shortmsg_dat; begin with sm do begin msg:='Telegard system initialized on '+date+' at '+time+'.'; destin:=1; end; assign(smf,'shortmsg.dat'); rewrite(smf); write(smf,sm); close(smf); end; procedure make_mboard(s:string); var f:file; mixr:msgindexrec; lng:longint; i:integer; begin assign(brdf,s+'.brd'); rewrite(brdf,1); lng:=$FC020010; blockwrite(brdf,lng,4); close(brdf); assign(mixf,s+'.mix'); rewrite(mixf,sizeof(mixr)); mixr.hdrptr:=0; for i:=0 to 99 do blockwrite(mixf,mixr,1); close(mixf); assign(tref,s+'.tre'); rewrite(tref,sizeof(mtreerec)); close(tref); end; procedure make_fboard(s:string); begin ulffr.blocks:=0; {rcg11182000 lowercased this ".DIR" strings...} assign(ulff,s+'.dir'); rewrite(ulff); write(ulff,ulffr); close(ulff); end; procedure dostuff; begin ttl('Creating Telegard directory paths'); make_paths; ttl('Creating Telegard data files'); make_status_dat; make_modem_dat; make_string_dat; make_fidonet_dat; make_user_lst; make_names_lst; make_macro_lst; make_boards_dat; make_uploads_dat; (* make_protocol_dat;*) make_zlog_dat; make_email_brd; make_events_dat; make_laston_dat; make_gfiles_dat; make_verbose_dat; make_voting_dat; make_shortmsg_dat; make_mboard('general'); make_fboard('sysop'); make_fboard('misc'); ttl('Moving data files into GFILES directory'); movefile1('user.lst',path[1]); movefile1('names.lst',path[1]); movefile1('macro.lst',path[1]); movefile1('boards.dat',path[1]); movefile1('events.dat',path[1]); movefile1('fidonet.dat',path[1]); movefile1('gfiles.dat',path[1]); movefile1('laston.dat',path[1]); movefile1('modem.dat',path[1]); movefile1('protocol.dat',path[1]); movefile1('shortmsg.dat',path[1]); movefile1('string.dat',path[1]); movefile1('uploads.dat',path[1]); movefile1('verbose.dat',path[1]); movefile1('voting.dat',path[1]); movefile1('zlog.dat',path[1]); {rcg11182000 lowercased this ".DIR" string...} movefiles('*.dir',path[1]); ttl('Moving message files into MSGS directory'); movefile1('email.brd',path[2]); movefile1('email.mix',path[2]); movefile1('general.brd',path[2]); movefile1('general.mix',path[2]); movefile1('general.tre',path[2]); {rcg11182000 Made ANS MSG CFG and MNU lowercase...} ttl('Moving ANSI text files into AFILES directory'); movefiles('*.ans',path[5]); ttl('Moving normal text files into AFILES directory'); movefiles('*.msg',path[5]); movefile1('computer.txt',path[5]); ttl('Moving color configuration files into AFILES directory'); movefiles('*.cfg',path[5]); (* ttl('Moving message file into MSGS\EMAIL directory'); movefile1('a-32767.1',path[2]+'EMAIL\');*) ttl('Moving menu files into MENUS directory'); movefiles('*.mnu',path[3]); end; begin infield_out_fgrd:=11; infield_out_bkgd:=0; infield_inp_fgrd:=15; infield_inp_bkgd:=1; clrscr; textbackground(1); textcolor(15); gotoxy(1,1); clreol; gotoxy(10,1); write('Telegard v'+ver+' Initialization Utility - Copyright 1988,89,90 by'); gotoxy(1,2); clreol; gotoxy(8,2); write('Eric Oman, Martin Pollard, and Todd Bolitho - All Rights Reserved.'); textbackground(0); textcolor(7); window(1,3,80,25); writeln; assign(systatf,'status.dat'); {$I-} reset(systatf); {$I+} if ioresult=0 then begin textcolor(28); write('WARNING!!'); textcolor(14); writeln(' "STATUS.DAT" file already exists..'); writeln('Telegard has already been initialized!'); writeln('If you proceed, ALL DATA FILES WILL BE ERASED AND INITIALIZED!!!'); writeln; if not pynq('Proceed? ') then halt(1); writeln; end; getdir(0,curdir); {rcg11182000 dosisms.} { path[1]:=curdir+'\GFILES\'; path[2]:=curdir+'\MSGS\'; path[3]:=curdir+'\MENUS\'; path[4]:=curdir+'\TFILES\'; path[5]:=curdir+'\AFILES\'; path[6]:=curdir+'\TRAP\'; path[7]:=curdir+'\TEMP\'; path[8]:=curdir+'\SWAP\'; } path[1]:=curdir+'/GFILES/'; path[2]:=curdir+'/MSGS/'; path[3]:=curdir+'/MENUS/'; path[4]:=curdir+'/TFILES/'; path[5]:=curdir+'/AFILES/'; path[6]:=curdir+'/TRAP/'; path[7]:=curdir+'/TEMP/'; path[8]:=curdir+'/SWAP/'; textcolor(14); writeln; writeln('You will now be prompted several times for names of directorys'); writeln('that will be used by Telegard. Each directory will be created'); writeln('and the appropriate files will be moved there-in.'); writeln; writeln('GFILES pathname. This is the directory where the Telegard data'); writeln('files and miscellaneous Telegard text files will be located.'); writeln; prt('GFILES pathname: '); infielde(path[1],60); writeln; writeln; textcolor(14); writeln('MSGS pathname. This directory should contain all the message'); writeln('files (*.BRD, *.MIX, *.TRE) used by Telegard for both private'); writeln('and public messages.'); writeln; prt('MSGS pathname: '); infielde(path[2],60); writeln; writeln; textcolor(14); writeln('MENUS pathname. This is the directory where the Telegard menu'); writeln('files will be located.'); writeln; prt('MENUS pathname: '); infielde(path[3],60); writeln; writeln; textcolor(14); writeln('TFILES pathname. This is the directory where the Telegard'); writeln('"text file section" text files will be located in.'); writeln; prt('TFILES pathname: '); infielde(path[4],60); writeln; writeln; textcolor(14); writeln('AFILES pathname. This is the directory where the Telegard'); writeln('menu help files, ANSI displays, etc. will be located.'); writeln; prt('AFILES pathname: '); infielde(path[5],60); writeln; writeln; textcolor(14); writeln('TRAP pathname. This is the directory where Telegard will'); writeln('output all User Audit traps, chat conversations (CHAT.MSG),'); writeln('and SysOp logs (SYSOP*.LOG).'); writeln; prt('TRAP pathname: '); infielde(path[6],60); writeln; writeln; textcolor(14); writeln('TEMP pathname. Telegard uses this directory to convert between'); writeln('archive formats, receive batch uploads, and allow users to'); writeln('decompress archives to download single files, etc.'); writeln; prt('TEMP pathname: '); infielde(path[7],60); writeln; writeln; textcolor(14); writeln('SWAP pathname. This is the directory where Telegard''s swap'); writeln('shell function will store its memory image file (if it cannot'); writeln('swap to EMS memory).'); writeln; prt('SWAP pathname: '); infielde(path[8],60); writeln; writeln; clrscr; dostuff; writeln; star('Telegard BBS installed and initialized successfully!'); {rcg11172000 DOSism.} {star('This program, "INIT.EXE", can now be deleted.');} star('This program, "init", can now be deleted.'); star('Thanks for trying Telegard!'); {rcg11182000 added NormVideo.} NormVideo; end.