{$N+,E+}

Unit BBSDoSub;

{***************************************************************************}

{*  The procedures are in the order that they appear in the main loop.

{*  A procedure will always start with "Do" and end with the name of the

{*    constant that calls it.

{*  These are the procedures that require interactive inputs or are very

{*    slow.

{*  The functions that BBSDosSub calls are in Unit BBSFuncs.

{*

{*  Test by placing BBS.EXE in a clean sub-directory by itself to see if

{*    it generates its needed files and sub-directories.

{***************************************************************************}

interface

{***************************************************************************}

{***************************************************************************}

Procedure DoWaitRing;

Procedure DoWaitConnect;

Procedure DoGetName;

Procedure DoGetName_1;

Procedure DoGetName_2;

Procedure DoUserInput;

Procedure DoRegister;

Procedure DoRegister_1;

Procedure DoWelcome;

Procedure DoMenu;

Procedure DoPrompt;

Procedure DoPrompt_1;

Procedure DoLogOff;

Procedure DoLogOff_1;

Procedure DoDisconnect;

Procedure DoAddOn;

Procedure DoAddOnMenu;

Procedure DoAddOnPrompt;

Procedure DoAddOnPrompt_1;

Procedure DoBullPost;

Procedure DoBullPost_1;

Procedure DoBullRead;

Procedure DoBullRead_1;

Procedure DoBulletins;

Procedure DoBullDel;

Procedure DoBullDel_1;

Procedure DoBullPrompt;

Procedure DoBullPrompt_1;

Procedure DoBullMenu;

Procedure DoBullSubMake;

Procedure DoBullSubMake_1;

Procedure DoBullSubKill;

Procedure DoBullSubKill_1;

Procedure DoBullSubCon;

Procedure DoBullSubCon_1;

Procedure DoBullSubCon_2;

Procedure DoBullSubDown;

Procedure DoBullSubDown_1;

Procedure DoBullSubUp;

Procedure DoBullSubUp_1;

Procedure DoBullPickedChild;

Procedure DoBullPickedChild_1;

Procedure DoBullPickedParent;

Procedure DoBullPickedParent_1;

Procedure DoBullPickedBull;

Procedure DoBullPickedBull_1;

Procedure DoChat;

Procedure DoStatistics;

Procedure DoStatistics_1;

Procedure DoDataMenu;

Procedure DoMailMenu;

Procedure DoEMail;

Procedure DoEMail_1;

Procedure DoEMailSend;

Procedure DoEMailSend_1;

Procedure DoEMailSend_2;

Procedure DoEMailSend_3;

Procedure DoEMailSend_4;

Procedure DoEMailRead;

Procedure DoFileShow;

Procedure DoMakePassword;

Procedure DoMakePassword_1;

Procedure DoMakePassword_2;

Procedure DoFeedback;

Procedure DoFeedback_1;

Procedure DoFeedback_2;

Procedure DoPasswordGood;

Procedure DoPasswordGood_1;

Procedure DoFileLineEdit;

Procedure DoFileLineEdit_1;

Procedure DoUpDown;



implementation

{***************************************************************************}

{***************************************************************************}

uses

{*  BBSAddOn, *}

  BBSFuncs,

  BBSGlbls,

  BBSYModm,

  Crt,

  Dos,

  FileIO,

  Globals,

  IOPorts,

  LctKrnl,

  LctSupp,

  MiscSubs,

  Windows;



Procedure DoWaitRing;

{***************************************************************************}

var

  alpha: integer;

  bravo: integer;

begin

  for alpha := 0 to NumPorts do

    if InputFrom[Now, alpha] then

      begin

        if alpha = 0 then

          begin

            if SessInStr[NOW] = 'KEYBOARD' then

              begin

                for bravo := 1 to NumPorts do

                  begin

                    InputFrom[Now, bravo] := false;

                    OutputTo[Now, bravo] := false;

                  end;

                ShowWriters;

                AreaSub(GetName);

              end;

          end

        else



{*   This is test code for skipping Ma Bell. *}

{*          if alpha = 2 then

            begin

              ToModem(2, 'ATX3');

              ShowReplies(2);

              ToModem(2, 'ATS7=255');

              ShowReplies(2);

*}



          if Pos('RING', SessInStr[Now]) <> 0 then

            begin



              InputFrom[Now, 0] := false;

              for bravo := 1 to NumPorts do

                begin

                  InputFrom[Now, bravo] := false;

                  OutputTo[Now, bravo] := false;

                end;

              InputFrom[Now, alpha] := true;

              OutputTo[Now, alpha] := true;

              ShowWriters;

              AreaSub(WaitConnect);

              Delay(ModemDelay);

              ToModem(alpha, 'ATA');

              Delay(ModemDelay);

              ShowReplies(2);

            end;

      end;

end;



Procedure DoWaitConnect;

{***************************************************************************}

begin

  if Pos('CONNECT', SessInStr[Now]) <> 0 then

    AreaSub(GetName);

end;



Procedure DoUserInput;

{***************************************************************************}

var

  InChar: char;

  charlie: integer;

begin

  if JulianDate*24*3600 + TimeInSecs > InputDeadLine[Now] then

    begin

      BeepTime[Now] := BeepTime[Now]*0.9;

      InputDeadLine[Now] := JulianDate*24*3600 + TimeInSecs + BeepTime[Now];

      Say(Beep);

      if BeepTime[Now] < 0.001 then

        begin

          InputDeadLine[Now] := Infinity;

          SayL('');

          SayL('Your prompt input time has expired!');

          SayL('Disconnecting... Please call again later.');

          AreaSub(Disconnect);

        end;

    end;

  if length(SessInStr[Now]) = 0 then

    exit;

  InChar := SessInStr[Now, length(SessInStr[Now])];

  case InChar of

    BackSpace:

      begin

        if length(SessInStr[Now]) <> 1 then

          begin

            if Echo[Now] then

              Say(BackSpace+' '+BackSpace);

            SessInStr[Now] := copy(SessInStr[Now],1,length(SessInStr[Now])-2);

           end

        else

          begin

            Say(Beep);

            SessInStr[Now] := '';

          end;

      end;

    Enter:

      begin

        SayL('');

        AreaPop;

        SessInStr[Now] := copy(SessInStr[Now], 1, length(SessInStr[Now]) -1);

      end;

  end; {case}

end;



Procedure DoGetName;

{***************************************************************************}

begin

  IdentifyBBS;

  SetTimeLogOut(LogInTime);

  FlushSessInput;

  Ask('Name:  ', GetName_1, 0);

end;



Procedure DoGetName_1;

{***************************************************************************}

var

  OK: boolean;

begin

  UserName[Now] := Reply;

  UserName[Now] := UpCaseFirstLetters(UserName[Now]);

  OK := ValidName;

  if not(OK) then

    begin

      Say(#7);

      SayL('I do not know anyone named '+UserName[Now]+'.');

      Ask('Are you new to this bulletin board? (y/N):  ', GetName_2, 0);

    end

  else

    AreaSub(PasswordGood);

end;



Procedure DoGetName_2;

{***************************************************************************}

var

  UserStr: string;

begin

  UserStr := Reply;

  if Upcase(UserStr[1]) = 'Y' then

    AreaSub(Register)

  else

    AreaSub(GetName);

end;



Procedure DoRegister;

{***************************************************************************}

var

  UL: text;

begin

  SetTimeLogOut(RegisterTime);

  if FileOpen('A', UsersLog, UL) = 0 then

    begin

      writeln(UL, UserName[Now]);

      UserID[Now] := UserNext;

      writeln(UL, UserID[Now]);

      Close(UL);

      AreaSub(MakePassword);

    end

  else

    AreaSub(Disconnect);

end;



Procedure DoRegister_1;

{***************************************************************************}

var

  NewUserTimeStr: string;

  NewUserPrivsStr: string;

begin

  NewUserTimeStr := StrInt(NewUserTime);

  NewUserPrivsStr := StrLongInt(NewUserPrivs);

  DumBool := FileLine('O', UserFile, 2, NewUserTimeStr);

  DumBool := FileLine('O', UserFile, 3, NewUserPrivsStr);

  AreaSub(Welcome);

end;



Procedure DoWelcome;

{***************************************************************************}

var

  NumSecs: longint;

  UF: text;

begin

  if UserID[Now] = 0 then

    begin

      NumSecs := Infinity;

      UserPrivs[Now] := AllPrivs;

    end

  else

    begin

      if FileOpen('R', UserFile, UF) = 0 then

        begin

          readln(UF, DumStr);

          readln(UF, NumSecs);

          readln(UF, UserPrivs[Now]);

          close(UF);

        end

      else

        begin

          NumSecs := NewUserTime;

          UserPrivs[Now] := 0;

        end;

    end;

  if NumSecs = Infinity then

    TimeLogOut[Now] := Infinity

  else

    SetTimeLogOut(NumSecs);

  SayL('');

  SayL('Welcome, '

    +UserName[Now]+'.  Your ID Code number is '+StrInt(UserID[Now])+'.');

  if MailCheck then

    SayL(Beep+Beep+'You have E-MAIL, '+ UserName[Now]+'!');

  AreaSub(Prompt);

end;



Procedure DoMenu;

{***************************************************************************}

begin

  SayL('A ----- Added BBS sections');

  SayL('B ----- Bulletins');

  SayL('C ----- Chat with the SYStem OPerator (SYSOP)');

  SayL('D ----- Data for the BBS and Users');

  SayL('E ----- Electronic Mail (E-MAIL)');

  SayL('F ----- Feeback to the SYSOP');

  SayL('G, L -- Goodbye or LogOff');

  SayL('H, ? -- Help (this menu)');

  SayL('U ----- Up/Download files');

  AreaPop;

end;



Procedure DoPrompt;

{***************************************************************************}

begin

  SayL('');

  SublimPick;

  ShowTimeLeft;

  Ask('MAIN COMMAND PROMPT (type H for Help):  ', Prompt_1, 1);

end;



Procedure DoPrompt_1;

{***************************************************************************}

var

  Command: string;

  Goodbye: boolean;

begin

  AreaSub(Prompt);

  ;

  SayL('');

  Command := Reply;

  if Command = '' then

    begin

      Say(Beep);

      exit;

    end;

  Command[1] := UpCase(Command[1]);

  Case Command[1] of

    'A': AreaPush(AddOn);

    'G', 'L': AreaPush(LogOff);

    '?', 'H': AreaPush(Menu);

    'C': AreaPush(Chat);

    'B': AreaPush(Bulletins);

    'D': AreaPush(Statistics);

    'E': AreaPush(EMail);

    'F': AreaPush(Feedback);

    'U': AreaPush(UpDown);

  else

    begin

      Say(#7);

      SayL('Option "'+Command[1]+'" not available at this time.');

    end;

  end; {case}

end;



Procedure DoLogOff;

{***************************************************************************}

begin

  SayL('');

  Ask('Are you sure you want to Log Off now? (y/N):  ', LogOff_1, 1);

end;



Procedure DoLogOff_1;

{***************************************************************************}

var

  InStr: string;

begin

  InStr := Reply;

  if InStr = '' then

    InStr := 'N';

  if upcase(InStr[1]) = 'Y' then

    begin

      SayL('Goodbye, '+UserName[Now]+'!');

      SayL('Disconnected.');

      TimeLogOut[Now] := Infinity;

      AreaSub(Disconnect);

    end

  else

    AreaPop;

end;



Procedure DoDisconnect;

{***************************************************************************}

var

  alpha: integer;

  AllOut: boolean;

begin

  AllOut := true;

  for alpha := 1 to NumPorts do

    if OutputTo[Now, alpha] then

      if (BytesInOutput(alpha) <> 0) or (PortOutStr[alpha] <> '') then

        AllOut := false

      else

        HangUp(alpha);

  if AllOut then

    begin

      InitSessionVariables(Now);

      AreaSub(WaitRing);

      ShowWriters;

    end;

end;



Procedure DoAddOn;

{***************************************************************************}

begin

  AreaSub(AddOnPrompt);

  AreaPush(AddOnMenu);

end;



Procedure DoAddOnMenu;

{***************************************************************************}

begin

  SayL('A ----- Add a new BBS section');

  SayL('F ----- Feedback to the SYSOP');

  SayL('G, L -- Goodbye/Logoff');

  SayL('H, ? -- this menu');

  SayL('Q ----- Quit to the previous command prompt');

  AreaPop;

end;



Procedure DoAddOnPrompt;

{***************************************************************************}

begin

  SayL('');

  ShowTimeLeft;

  Ask('Added BBS Sections Command Prompt (type H for help):  ',

    AddOnPrompt_1, 1);

end;



Procedure DoAddOnPrompt_1;

{***************************************************************************}

var

  InStr: string;

  UserOpt: char;

begin

  AreaSub(AddOnPrompt);

  InStr := Reply;

  ;

  if InStr = '' then

    exit;

  SayL('');

  UserOpt := upcase(InStr[1]);

  case UserOpt of

    'F': AreaPush(Feedback);

    'Q': AreaPop;

    'G', 'L':  AreaPush(Logoff);

    'H', '?':  AreaPush(AddOnMenu);

    'A': SayL(Beep+'Disabled.');

    else

      SayL(Beep+'Option "'+UserOpt+'" not available from this prompt.');

  end; {case}

end;





Procedure DoBulletins;

{***************************************************************************}

begin

  BullAreaID[Now]   := 0;

  BullAreaDir[Now]  := 0;

  BullAreaSubj[Now] := BullTopSubjectStr;

  AreaSub(BullPrompt);

  AreaPush(BullMenu);

end;



Procedure DoBullMenu;

{***************************************************************************}

begin

  SayL('A ----- Add a subject area');

  SayL('C ----- Connect this subject area to another upper level path');

  SayL('D ----- Down a subject area path');

  SayL('F ----- Feedback to the SYSOP');

  SayL('G, L -- Goodbye/Logoff');

  SayL('H, ? -- this menu');

  SayL('K ----- Kill/detach a subject area');

  SayL('N ----- read the Next bulletin in this subject area');

  SayL('P ----- Post/write a bulletin');

  SayL('Q ----- Quit to the previous command prompt');

  SayL('R ----- Read a bulletin');

  SayL('T ----- Trash/erase a bulletin');

  SayL('U ----- Up a subject area path');

  SayL('X ----- Cross-Reference a bulletin to another subject area');

  AreaPop;

end;



Procedure DoBullPrompt;

{***************************************************************************}

begin

  SayL('');

  SayL('Subject Area: '+BullAreaSubj[Now]);

  SayL(StrInt(BullCountParents(BullAreaID[Now]))+' subject area(s) above, '+

       StrInt(BullCountChildren(BullAreaID[Now]))+' subject area(s) below, '+

       StrInt(BullCountBulls(BullAreaID[Now]))+' bulletin(s).');

  ShowTimeLeft;

  Ask('BULLETIN command prompt (Type H for help):  ', BullPrompt_1, 1);

end;



Procedure DoBullPrompt_1;

{***************************************************************************}

var

  InStr: string;

  UserOpt,

  UserType: char;

  Count: integer;

  NewSubjectArea: integer;

begin

  AreaSub(BullPrompt);

  InStr := Reply;

  ;

  if InStr = '' then

    exit;

  SayL('');

  UserOpt := upcase(InStr[1]);

  case UserOpt of

    'C': AreaPush(BullSubCon);

    'R': AreaPush(BullRead);

    'P': AreaPush(BullPost);

    'T': AreaPush(BullDel);

    'F': AreaPush(Feedback);

    'A': AreaPush(BullSubMake);

    'K': AreaPush(BullSubKill);

    'D': AreaPush(BullSubDown);

    'U': AreaPush(BullSubUp);

    'Q': AreaPop;

    'G', 'L':  AreaPush(Logoff);

    'H', '?':  AreaPush(BullMenu);

    else

      SayL(Beep+'Option "'+UserOpt+'" not available at this time.');

  end; {case}

end;



Procedure DoBullPost;

{***************************************************************************}

begin

  if not(PrivCheck(true, BullPostPriv)) then

    begin

      AreaPop;

      exit;

    end;

  Ask('Subject:  ', BullPost_1, 0);

end;



Procedure DoBullPost_1;

{***************************************************************************}

var

  BullHeader,

  BullFileName:  StrBSA;

  BB: BSAFile;

  BF: text;

begin

  BullFileName := BullNextBulletin;

{$I-}

  if BullSABFileAssignResetMake(BB, BullAreaDir[Now], BullAreaID[Now]) then

    begin

      Seek(BB, FileSize(BB));

      write(BB, BullFileName);

      Close(BB);

    end

  else

    begin

      ErrSayL('A Bulletin file would not open!');

      AreaPop;

      exit;

    end;

{$I+}

  if FileOpen('W', BullFileName, BF) = 0 then

    begin

      writeln(BF, 'Subject:  ', Reply);

      writeln(BF, 'Author :  ', UserName[Now]);

      writeln(BF, 'Date   :  ', DateTimeStr);

      writeln(BF, 'Expires:  ');

      writeln(BF, MultiChar('-',78));

      Close(BF);

      VarPushStr(BullFileName);

      AreaPop;

      AreaPush(FileLineEdit);

    end

  else

    AreaPop;

end;



Procedure DoBullRead;

{***************************************************************************}

begin

  if not(PrivCheck(true, BullReadPriv)) then

    begin

      AreaPop;

      exit;

    end;

  AreaSub(BullRead_1);

  AreaPush(BullPickedBull);

end;



Procedure DoBullRead_1;

{***************************************************************************}

var

  BullToRead: W10k;

  BullID: W10k;

  BullIDStr: StrBSA;

begin

  AreaPop;

  BullToRead := VarPopByte;

  ;

  if BullToRead = 0 then

    exit;

  if BullSAFileDatum(BullSABFile(BullAreaDir[Now], BullAreaID[Now]),

   BullToRead, BullIDStr) then

    begin

      BullID := IntStr(copy(BullIDStr, length(BullIDStr)-7, 4));

      BullReadMark(BullID);

      VarPushStr(BullIDStr);

      VarPushByte(0); {* # of lines before-hand *}

      VarPushByte(LinesPerPage[Now]);

      AreaPush(FileShow);

    end;

end;



Procedure DoBullDel;

{***************************************************************************}

begin

  AreaSub(BullDel_1);

  AreaPush(BullPickedBull);

end;



Procedure DoBullDel_1;

{***************************************************************************}

var

  DeadBull: integer;

  DeadBullFile: StrBSA;

  alpha: integer;

  Author: string;

begin

  DeadBull := VarPopByte;

  if not(BullSAFileDatum(BullSABFile(BullAreaDir[Now], BullAreaID[Now]),

    DeadBull, DeadBullFile)) then

      begin

        SayL('Bulletin would not open!  Contact BBS Manager.');

        AreaPop;

        exit;

      end;

  if UserName[Now] <> BullHeaderAuthor(DeadBullFile) then

    begin

      SayL('Warning:  you are not the author of this bulletin.');

      if not(PrivCheck(true, BullKillPriv)) then

        begin

          AreaPop;

          exit;

        end;

    end;

  DumBool := BullSAFileDeleteDatum(

    BullSABFile(BullAreaDir[Now], BullAreaID[Now]), DeadBull);

  AreaPop;

end;



Procedure DoBullSubCon;

{***************************************************************************}

begin

  SayL(Beep+'Disabled.');

  AreaPop;

{*  AreaSub(BullSubCon_1);

  VarPushInt(0);

  VarPushInt(0);

*}

end;



Procedure DoBullSubCon_1;

{***************************************************************************}

begin

{*

  NewSub := VarPopInt;

  OldSub := VarPopInt;

  ;

  if NewSub = 0 then

    begin

      VarPushStr(

      VarPushInt(OldSub);

      AreaSub(BullSubCon_2);

      exit;

    end;

  SayL('Hit ENTER when you have picked the parent subject area...');

  VarPushInt(NewSub);

  AreaPush(BullPickedChildFrom(NewSub));

*}

end;



Procedure DoBullSubCon_2;

{***************************************************************************}

begin

{*

  ParentStr := VarPopStr;

  ParentNum := VarPopInt;

  BullFileConnect(ParentStr, BullSubAreaStr, ParentNum, BullArea);

  AreaPop;

*}

end;



Procedure DoBullSubMake;

{***************************************************************************}

begin

  if not(PrivCheck(true, BullAreaMakePriv)) then

    begin

      AreaPop;

      exit;

    end;

  Ask('New subject area:  ', BullSubMake_1, BSALen);

end;



Procedure DoBullSubMake_1;

{***************************************************************************}

var

  BB: BSAFile;

  NewSubjectArea: W10k;

  Subject: StrBSA;

begin

  Subject := Reply;

  NewSubjectArea := BullNextSubjectArea;

  if (Reply = '') or

    not(BullSAConnect(BullSAPFile(UserID[Now], NewSubjectArea),

                      BullSACFile(BullAreaDir[Now], BullAreaID[Now]) )) then

      begin

        AreaPop;

        exit;

      end;

{$I-}

  Assign(BB, BullSABFile(UserID[Now], NewSubjectArea));

  Rewrite(BB);

  write(BB, Subject);

  Close(BB);

{$I+}

  AreaPop;

end;



Procedure DoBullSubKill;

{***************************************************************************}

begin

  if not(PrivCheck(true, BullAreaKillPriv)) then

    begin

      AreaPop;

      exit;

    end;

  AreaSub(BullSubKill_1);

  AreaPush(BullPickedChild);

end;



Procedure DoBullSubKill_1;

{***************************************************************************}

begin

  DumBool := BullSAFileDeleteDatum(BullSACFile(BullAreaDir[Now],

    BullAreaID[Now]), VarPopByte);

  AreaPop;

end;



Procedure DoBullSubDown;

{***************************************************************************}

begin

  AreaSub(BullSubDown_1);

  AreaPush(BullPickedChild);

end;



Procedure DoBullSubDown_1;

{***************************************************************************}

begin

  BullSwitchSubjectArea(VarPopByte);

  AreaPop;

end;



Procedure DoBullSubUp;

{***************************************************************************}

begin

  AreaSub(BullSubUp_1);

  AreaPush(BullPickedParent);

end;



Procedure DoBullSubUp_1;

{***************************************************************************}

begin

  BullSwitchSubjectArea(-VarPopByte);

  AreaPop;

end;



Procedure DoBullPickedBull;

{***************************************************************************}

begin

  if BullCountBulls(BullAreaID[Now]) > 0 then

    begin

      VarPushByte(BullListBulls);

      Ask('Which bulletin? [ENTER to cancel]:  ', BullPickedBull_1, 3);

      exit;

    end;

  VarPushByte(0);

  AreaPop;

end;



Procedure DoBullPickedBull_1;

{***************************************************************************}

var

  Count: integer;

  Picked: integer;

  InStr: string;

begin

  Count := VarPopByte;

  InStr := Reply;

  if InStr = '' then

    begin

      VarPushByte(0);

      AreaPop;

      exit;

    end;

  Picked := IntStr(InStr);

  if (Picked <= 0) or (Picked > Count) then

    begin

      AreaSub(BullPickedBull);

      exit;

    end;

  VarPushByte(Picked);

  AreaPop;

end;



Procedure DoBullPickedChild;

{***************************************************************************}

var

  Count: integer;

begin

  if not(BullCountChildren(BullAreaID[Now]) > 0) then

    begin

      VarPushByte(0);

      AreaPop;

      exit;

    end;

  Count := BullListChildren(BullAreaDir[Now], BullAreaID[Now]);

  VarPushByte(Count);

  Ask('Which lower subject path? [ENTER to cancel]:  ', BullPickedChild_1,

    0);

end;



Procedure DoBullPickedChild_1;

{***************************************************************************}

var

  Count: integer;

  Picked: integer;

  InStr: string;

begin

  Count := VarPopByte;

  InStr := Reply;

  Picked := IntStr(InStr);

  if (Picked <= 0) or (Picked > Count) then

    begin

      VarPushByte(0);

      AreaPop;

      exit;

    end;

  VarPushByte(Picked);

  AreaPop;

end;



Procedure DoBullPickedParent;

{***************************************************************************}

var

  Count: integer;

begin

  if BullCountParents(BullAreaID[Now]) <= 0 then

    begin

      AreaPop;

      exit;

    end;

  Count := BullListParents(BullAreaDir[Now], BullAreaID[Now]);

  VarPushByte(Count);

  Ask('Go up which subject path? [ENTER to cancel]:  ', BullPickedParent_1,

    0);

end;



Procedure DoBullPickedParent_1;

{***************************************************************************}

var

  Count: integer;

  Picked: integer;

  InStr: string;

begin

  Count := VarPopByte;

  InStr := Reply;

  Picked := IntStr(InStr);

  if (Picked < 0) or (Picked > Count) then

    begin

      Say(Beep);

      AreaSub(BullPickedParent);

      exit;

    end;

  if Picked = 0 then

    begin

      AreaPop;

      exit;

    end;

  VarPushByte(Picked);

  AreaPop;

end;



Procedure DoChat;

{***************************************************************************}

var

  alpha: integer;

begin

  SayL('');

  SayL('Oh, Most Exalted Master, '+UserName[Now]+' requests an audience!');

  for alpha := 1 to 6 do

    Say(#7);

  SayL('The SYSOP will interrupt eventually if He is around.');

  AreaPop;

end;



Procedure DoDataMenu;

{***************************************************************************}

begin

  SayL('DATA HELP MENU');

  SayL('');

  SayL('B ----- BBS data');

  SayL('C ----- Change user data');

  SayL('D ----- Disk data');

  SayL('F ----- Feedback to the SYSOP');

  SayL('G, L -- Goodbye or Log-Off');

  SayL('H, ? -- Help (this menu)');

  SayL('Q ----- Quit to previous prompt');

  SayL('S ----- Show users');

  SayL('U ----- User data');

  AreaPop;

end;



Procedure DoStatistics;

{***************************************************************************}

begin

  SayL('');

  ShowTimeLeft;

  Ask('DATA command prompt (H for Help menu):  ', Statistics_1, 1);

end;



Procedure DoStatistics_1;

{***************************************************************************}

const

  DescripB: array[1..4] of string = (

    'Number of bulletins posted:  ',

    'Number of subject areas created under BULLETINS:  ',

    'Number of users:  ',

    'Number of e-mail letters created:  ');

var

  UserOpt: char;

  LineStr: string;

  alpha: integer;

  SF: text;

  UserChecked: string;

  UserCheckedID: integer;

  UserChanged: string;

  UserChangedID: integer;

begin

  AreaSub(Statistics);

  LineStr := Reply;

  SayL('');

  alpha := 0;

  if LineStr = '' then

    exit

  else

    case upcase(LineStr[1]) of

      'B':

        if FileOpen('R', StatFile, SF) = 0 then

          begin

            while not(EOF(SF)) do

              begin

                Inc(alpha);

                Say(DescripB[alpha]);

                readln(SF, LineStr);

                SayL(LineStr);

              end;

            close(SF);

          end;

      'D':

        begin

          SayL('Disk size:  '+StrLongInt(DiskSize(0)));

          SayL('Disk free:  '+StrLongInt(DiskFree(0)));

        end;

      'F': AreaPush(Feedback);

      'S': UsersShow;

      'U': UserShowData(UserID[Now]);

      '?', 'H': AreaPush(DataMenu);

      'Q'     : AreaPop;

      'G','L' : AreaPush(LogOff);

      'C':

      SayL('Disabled.');

{*

        begin

          SayL('CHANGE USER DATA OPTIONS');

          SayL('');

          SayL('P -- Password');

          SayL('C -- user privileges Code number');

          SayL('');

          ShowTimeLeft;

          Say('Option [Default = P]:  ');

          MultiRL(1, LineStr);

          SayL('');

          if LineStr = '' then

            LineStr := 'P';

          UserOpt := upcase(LineStr[1]);

          case UserOpt of

            'P':

              if UserID[Now] = 0 then

                begin

                  Say('Name of user:  ');

                  MultiRL(LineLen, UserChanged);

                  UserChangedID := UserFindID(UserChanged);

                  if UserChangedID > 0 then

                    begin

                      UserID[Now] := UserChangedID;

                      DumBool := PasswordMade;

                      UserID[Now] := 0;

                    end;

                end

              else

                if PasswordGood then

                  DumBool := PasswordMade;

            'C':

              if UserID[Now] = 0 then

                begin

                  Say('Name of user:  ');

                  MultiRL(LineLen, UserChanged);

                  UserChangedID := UserFindID(UserChanged);

                  if UserChangedID > 0 then

                    begin

                      UserID[Now] := UserChangedID;

                      Say('New privilege code number:  ');

                      MultiRL(LineLen, LineStr);

                      DumBool := FileLine('O', UserFile, 3, LineStr);

                      UserID[Now] := 0;

                    end;

                end

              else

                SayL(Beep

                  +'Please contact the BBS Manager to change privileges.');

            else

              SayL(Beep + 'Option "'+UserOpt+'" not available here."');

          end; {case}

          {*

        end;

*}

      else

        SayL(Beep+'Option "'+LineStr[1]+'" not available from this menu.');

    end; {case}

end;



Procedure DoMailMenu;

{***************************************************************************}

begin

  SayL('E-MAIL HELP MENU');

  SayL('');

  SayL('F ----- Feedback to the SYSOP');

  SayL('G, L -- Goodbye or Log-Off');

  SayL('H, ? -- Help (this menu)');

  SayL('R ----- Read e-mail');

  SayL('S ----- Send e-mail');

  SayL('Q ----- Quit to previous prompt');

  AreaPop;

end;



Procedure DoEMail;

{***************************************************************************}

begin

  SayL('');

  ShowTimeLeft;

  Ask('E-MAIL Command Prompt (H for Help Menu):  ', EMail_1, 0);

end;



Procedure DoEMail_1;

{***************************************************************************}

var

  InStr: string;

  Command: char;

begin

  AreaSub(EMail);

  InStr := Reply;

  ;

  SayL('');

  Command := upcase(InStr[1]);

  case Command of

    'F': AreaPush(Feedback);

    'R': AreaPush(EMailRead);

    'S': AreaPush(EMailSend);

    'G','L': AreaPush(LogOff);

    '?', 'H': AreaPush(MailMenu);

    'Q': AreaPop;

    else

      SayL(Beep+'"'+Command+'" not available from this command prompt.');

  end; {case}

end;



Procedure DoEMailSend;

{***************************************************************************}

var

  EFile: string;

begin

  EFile := MailNext;

  VarPushStr(EFile);

  AreaSub(EMailSend_1);

  AreaPush(FileLineEdit);

end;



Procedure DoEMailSend_1;

{***************************************************************************}

begin

  Ask('Subject (Enter nothing to cancel):  ', EMailSend_2, 0);

end;



Procedure DoEMailSend_2;

{***************************************************************************}

var

  SubjectStr: string;

begin

  SubjectStr := Reply;

  if SubjectStr = '' then

    begin

      DumStr := VarPopStr;

      AreaPop;

      exit;

    end;

  VarPushStr(SubjectStr);

  AreaSub(EMailSend_3);

end;



Procedure DoEMailSend_3;

{***************************************************************************}

begin

  Ask('To (Enter nothing to stop):  ', EMailSend_4, 0);

end;



Procedure DoEMailSend_4;

{***************************************************************************}

var

  SubjectStr: string;

  InStr: string;

  ToUser: integer;

  ToUserStr: string;

  EM: text;

  EFile: string;

begin

  SubjectStr := VarPopStr;

  EFile := VarPeekStr;

  VarPushStr(SubjectStr);

  ;

  InStr := Reply;

  if InStr = '' then

    begin

      DumStr := VarPopStr;

      DumStr := VarPopStr;

      AreaPop;

      exit;

    end;

  ToUser := UserFindID(InStr);

  ToUserStr := StrInt(ToUser);

  if ToUser = -1 then

    SayL(Beep+'I do not know "'+InStr+'".')

  else

    if DirExists(UserDir(ToUser)) then

      if FileOpen('A', UserDir(ToUser) + '\' + EMailBox, EM) = 0 then

        begin

          writeln(EM, UserName[Now]);

          writeln(EM, SubjectStr);

          writeln(EM, EFile);

          close(EM);

          SayL('E-Mail letter placed in '+InStr+'''s mailbox.');

        end;

  AreaSub(EMailSend_3);

end;



Procedure DoEMailRead;

{***************************************************************************}

var

  Userbox: string;

  InStr: string;

begin

  if not(MailCheck) then

    begin

      AreaPop;

      exit;

    end;

  UserBox := UserDir(UserID[Now]) + '\' + EMailBox;

  if FileLine('R', UserBox, 1, InStr) then

    begin

      SayL('Letter from '+InStr+'...');

      DumBool := FileLine('D', UserBox, 1, DumStr);

    end;

  if FileLine('R', UserBox, 1, InStr) then

    begin

      SayL('Subject:  '+InStr);

      DumBool := FileLine('D', UserBox, 1, DumStr);

    end;

  if FileLine('R', UserBox, 1, InStr) then

    begin

      DumBool := FileLine('D', UserBox, 1, DumStr);

      VarPushByte(0);

      VarPushByte(LinesPerPage[Now]);

      VarPushStr(InStr);

      AreaSub(FileShow);

    end;

end;



Procedure DoFileLineEdit;

{***************************************************************************}

var

  FileStr: string;

  BlankCount: byte;

begin

  FileStr := VarPeekStr;

  Inc(VarTextTOS[Now]);

  if FileOpen('A', FileStr, VarText[Now, VarTextTOS[Now]]) = 0 then

    begin

      SayL('Enter two blank lines to quit and save.');

      SayL(MultiChar('-', LineLen));

      AreaSub(FileLineEdit_1);

      BlankCount := 0;

      VarPushByte(BlankCount);

      Ask('', FileLineEdit_1, 0);

    end

  else

    begin

      ErrSayL('File "'+FileStr+'" would not open for writing!!!');

      AreaPop;

    end;

end;



Procedure DoFileLineEdit_1;

{***************************************************************************}

var

  InStr: string;

  BlankCount: byte;

begin

  BlankCount := VarPopByte;

  InStr := Reply;

  if InStr = '' then

    Inc(BlankCount);

  if BlankCount = 0 then

    writeln(VarText[Now, VarTextTOS[Now]], InStr);

  if BlankCount = 1 then

    if InStr <> '' then

       begin

         BlankCount := 0;

         writeln(VarText[Now, VarTextTOS[Now]]);

       end;

  VarPushByte(BlankCount);

  if BlankCount = 2 then

    begin

      DumByte := VarPopByte;

      Close(VarText[Now,VarTextTOS[Now]]);

      Dec(VarTextTOS[Now]);

      AreaPop;

    end

  else

    Ask('', FileLineEdit_1, 0);

end;



Procedure DoFileShow;

{***************************************************************************}

{*  pops an area

{*  pops a string:  FileStr

{*  pops a byte  :  LinesPerPage

{*  pops a byte  :  Shortened

{*

{*  page overrun problem not fixed

{***************************************************************************}

var

  FS: text;

{*  LineCount: integer;

*}

  LineStr: string;

{*  OptStr: string;

  Stop: boolean;

*}

  FileStr: string;

  LinesPerPage,

  Shortened: byte;

begin

  AreaPop;

  FileStr := VarPopStr;

  LinesPerPage := VarPopByte;

  Shortened := VarPopByte;

  ;

  if not(FileOpen('R', FileStr, FS) = 0) then

    begin

      SayL('Sorry, the file you wanted to read would not open.');

      exit;

    end;

  SayL(MultiChar('-', 78));

  while not(EOF(FS)) do

    begin

      readln(FS, LineStr);

      SayL(LineStr);

{*      Inc(LineCount);

      if LineCount >= LinesPerPage - 2 then

        begin

          LineCount := 0;

              SayL('');

              Say('S)top or ENTER to continue...');

              MultiRL(LineLen, OptStr);

              if OptStr <> '' then

                if upcase(OptStr[1]) = 'S' then

                  Stop := true;

            end;

*}

    end;

  Close(FS);

  SayL(MultiChar('-', 78));

end;



Procedure DoFeedback;

{***************************************************************************}

var

  EFile: string;

begin

  EFile := MailNext;

  VarPushStr(EFile);

  AreaSub(Feedback_1);

  AreaPush(FileLineEdit);

end;



Procedure DoFeedback_1;

{***************************************************************************}

begin

  Ask('Subject (Enter nothing to cancel):  ', Feedback_2, 0);

end;



Procedure DoFeedback_2;

{***************************************************************************}

var

  SubjectStr: string;

  EFile: string;

  EM: text;

begin

  EFile := VarPopStr;

  ;

  SubjectStr := Reply;

  if SubjectStr <> '' then

    if DirExists(UserDir(0)) then

      if FileOpen('A', UserDir(0) + '\' + EMailBox, EM) = 0 then

        begin

          writeln(EM, UserName[Now]);

          writeln(EM, SubjectStr);

          writeln(EM, EFile);

          close(EM);

          SayL('E-Mail letter placed in MANAGER''s mailbox.');

        end;

  AreaPop;

end;



Procedure DoPasswordGood;

{***************************************************************************}

begin

  Echo[Now] := false;

  Ask('Enter password:  ', PasswordGood_1, 0);

end;



Procedure DoPasswordGood_1;

{***************************************************************************}

var

  Password: string;

  RealPass: string;

begin

  Password := Reply;

  Echo[Now] := true;

  if UserID[Now] = 0 then

    RealPass := ManagerPassword

  else

    if not(FileLine('R', UserFile, 1, RealPass)) then

      begin

        SayL(Beep+'Unable to locate your user data file!');

        if UserKill then

          begin

            SayL('Your name has been deleted from the User Log file.');

            SayL('Please re-register.');

            AreaSub(Register);

          end;

      end;

  if RealPass = Password then

    AreaSub(Welcome)

  else

    begin

      SayL(Beep+'Invalid password.  Please try again.');

      AreaSub(GetName);

    end;

end;



Procedure DoMakePassword;

{***************************************************************************}

begin

  if UserID[Now] = 0 then

    begin

      SayL(Beep+'MANAGER cannot change the MANAGER PASSWORD.');

      AreaPop;

      exit;

    end;

  Say('Please enter a password of at least '+StrInt(PasswordMinLen));

  SayL(' characters.');

  SayL('The password will not show on the screen.  Please ENTER when done.');

  Echo[Now] := false;

  Ask('Password:', MakePassword_1, 0);

end;



Procedure DoMakePassword_1;

{***************************************************************************}

begin

  Password1 := Reply;

  if length(password1) < PassWordMinLen then

    begin

      Say(Beep+'Your password must be at least '+StrInt(PassWordMinLen));

      SayL(' characters long please!');

      AreaSub(MakePassword);

    end

  else

    begin

      SayL('Please enter your password again to safeguard against typos.');

      Ask('Password:', MakePassword_2, 0);

    end;

end;



Procedure DoMakePassword_2;

{***************************************************************************}

begin

  Password2 := Reply;

  if password1 <> password2 then

    begin

      Say(Beep+'The second entry was not the same.  Please re-enter the');

      SayL(' first again.');

      AreaSub(MakePassword);

      exit;

    end;

  Echo[Now] := true;

  if not(FileExists(UserFile)) then

    DumBool := FileCreate(UserFile);

  if not(FileLine('O', UserFile, 1, password1)) then

    SayL(Beep+'Warning:  password was not successfully saved to disk!');

  AreaSub(Register_1);

end;



Procedure DoUpDown;

{***************************************************************************}

begin

  DumBool := UpLoad(1, 'bbs.pas');

  AreaPop;

end;



{***************************************************************************}

{***************************************************************************}

{***************************************************************************}

begin

end.