telegard/init.pas

(*****************************************************************************)
(*>                                                                         <*)
(*>  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('<27> ');
  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('<27><>[');
  textbackground(1); textcolor(15);
  write(' '+s+' ');
  textbackground(0); textcolor(9);
  write(']');
  repeat write('<27>') 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,<CR>,?=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.