{$N+,E+} {* required for ASK and the time outs *}

Unit BBSFuncs;

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

{* This unit contains the subprograms called by Unit BBSDoSub.

{* They must be all non-interactive.

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

interface

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

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

uses

  BBSGlbls,

  Glob;



Function  AreaPeek: AreaType;

Procedure AreaPop;

Procedure AreaPush(PushedArea: AreaType);

Procedure AreaReset(InitArea: AreaType);

Procedure AreaSub(SubstituteArea: AreaType);

Procedure Ask(QueryStr: string; TheNextArea: AreaType; StringLength: byte);

Procedure CheckTimeLeft;

Procedure DelayBBS(Secs: real; TheNextArea: AreaType);

Procedure EditMenu;

Procedure FileAddList(FileCodeName, UpFile, CopyrStr, Descrip: string);

Function  FileRemList(NumStr: string): boolean;

Function  FileNext: string;

Function  FilesLoaded: integer;

Procedure FilterPortChar(alpha: integer; PortChar: char);

Procedure FlushSessInput;

Procedure GetInputs;

Procedure IdentifyBBS;

Procedure InitBBSGlbls;

Procedure InitSessionVariables(Session: integer);

Function  MailCheck(QuietMode: boolean): boolean;

Procedure MailMenu;

Procedure MailNewUser;

Function  MailNext: string;

Procedure MainInit;

Procedure MainLoop;

Procedure MainMenu;

Function  OutputClear(InPort: integer): boolean;

Procedure Periodic;

Function  PrivCheck(MsgOn: boolean; PrivBits: longint): boolean;

Function  Reply: string;

Procedure RestartBBS;

Function  SetUpBBSFiles(BBSFile: string): boolean;

Procedure ShowTimeLeft;

Procedure StatMenu;

Procedure StatUserMenu;

Procedure SublimInit;

Procedure SublimPick;

Procedure Trash(DeadFile: string);

Function  UserDir(UserNum: W10k): string;

Function  UserFindID(var NameStr: string): integer;

Function  UserFindName(UserNum: integer): string;

Function  UserKill: boolean;

Function  UserNext: integer;

Function  ValidName: boolean;

Function  VarPeekInteger: Integer;

Function  VarPeekStr: string;

Function  VarPeekTextNum: integer;

Function  VarPopInteger: Integer;

Function  VarPopStr: string;

Function  VarPopTextNum: integer;

Procedure VarPushInteger(PushedInteger: Integer);

Procedure VarPushStr(PushedStr: string);

Function  VarPushText: integer;

Procedure VarResetInteger(InitInteger: Integer);

Procedure VarResetStr(InitStr: string);

Procedure VarTextCloseAll(Session: integer);

Procedure XFileMenu;



implementation

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

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

Uses

  BBSAlarm,

  Data,

  Disk,

  Keyb,

  Misc,

  Monitor,

  Scrn,

  Time,



  Crt,

  Dos,

  DoSubs1,

  DoSubs2,

  IOPorts,

  LctKrnl, {* for RestartBBS *}

  LctSupp; {* for OutputClear *}



Function AreaPeek: AreaType;

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

begin

  AreaPeek := Area[Port, AreaTOS[Port]];

end;



Procedure AreaPop;

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

begin

  if AreaTOS[Port] = 1 then

    begin

      ErrSayL('AreaTOS popped to less than 1!!!');

      Area[Port, AreaTOS[Port]] := Prompt;

    end

  else

    begin

      Area[Port, AreaTOS[Port]] := Zero;

      Dec(AreaTOS[Port]);

    end;

end;



Procedure AreaPush(PushedArea: AreaType);

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

var

  alpha: integer;

begin

  if AreaTOS[Port] = AreaMaxStack then

    begin

      ErrSayL('AreaTOS pushed past AreaMaxStack!!!');

      for alpha := 1 to (AreaMaxStack - 1) do

        Area[Port, alpha] := Area[Port, alpha + 1];

    end

  else

    Inc(AreaTOS[Port]);

  Area[Port, AreaTOS[Port]] := PushedArea;

end;



Procedure AreaReset(InitArea: AreaType);

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

begin

  AreaTOS[Port] := 1;

  Area[Port, AreaTOS[Port]] := InitArea;

end;



Procedure AreaSub(SubstituteArea: AreaType);

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

begin

  Area[Port, AreaTOS[Port]] := SubstituteArea

end;



Procedure Ask(QueryStr: string; TheNextArea: AreaType; StringLength: byte);

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

{* if StringLength = 0 then StringLength = LineLen - Len(QueryStr)

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

var

  EnterPos: integer;

begin

  Say(QueryStr);

  AreaSub(TheNextArea);

  if StringLength = 0 then

    StringLength := LineLen - Length(QueryStr);

  InStrMaxLen[Port] := StringLength;

  BeepTime[Port] := InputTime/10;

  InputDeadLine[Port] := JulianDateTimeNow + BeepTime[Port];

  EnterPos := 1;

  PosString(Enter, SessInStr[Port], EnterPos);

  SessInStr[Port] := copy(SessInStr[Port], EnterPos, length(SessInStr[Port])

    - EnterPos + 1);

  if SessInStr[Port, 1] <> Enter then

    SessInStr[Port] := ''

  else

    begin

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

      Say(SessInStr[Port]);

    end;

  AreaPush(UserInput);

end;



Procedure CheckTimeLeft;

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

begin

  if DateTimeLogOut[Port] = Infinity then

    exit;

  if JulianDateTimeNow < DateTimeLogOut[Port] then

    exit;

  DateTimeLogOut[Port] := Infinity;

  SayL(Beep);

  SayL('It is time to give someone else a chance to log in.');

  SayL('Please call again tomorrow!');

  AreaPush(Disconnect);

end;



Procedure DelayBBS(Secs: real; TheNextArea: AreaType);

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

begin

  AreaSub(TheNextArea);

  DelayDone[Port] := JulianDateTimeNow + Secs;

  AreaPush(PassTime);

end;



Procedure EditMenu;

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

begin

  SayL('');

  SayL('EDITOR HELP MENU');

  SayL('|');

  SayL('A ----- Append Line(s)');

  SayL('D ----- Delete Line');

  SayL('I ----- Insert Line');

  SayL('L ----- List File with Line Numbers');

  SayL('M ----- Modify Line');

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

  SayL('|');

  SayL('C ----- Chat/Comment to the SYSOP');

  SayL('G ----- Goodbye (log off)');

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

  SayL('Q ----- Quit back to the menu that calls this one');

end;



Procedure FileAddList(FileCodeName, UpFile, CopyrStr, Descrip: string);

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

var

  FL: text;

begin

  if FileOpen('A', FileListFile, FL) = 0 then

    begin

{$I-}

      writeln(FL, FileCodeName);

      writeln(FL, UpFile);

      writeln(FL, CopyrStr);

      writeln(FL, Descrip);

      writeln(FL, 'N/A');

      writeln(FL, '0');

      writeln(FL, '0');

{* Global FileListLines = 7 *}

      Close(FL);

{$I+}

    end;

  if IOResult <> 0 then

    SayL('Failure.  Unable to add file to public File List.');

end;



Function FileRemList(NumStr: string): boolean;

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

var

  Temp: boolean;

  FirstLine,

  LastLine: integer;

begin

  if not(PrivCheck(true, FileDelPriv)) then

    begin

      FileRemList := false;

      exit;

    end;

  FirstLine := IntStr(NumStr);

  LastLine := FirstLine + FileListLines - 1;

  Temp := FileLineDel(FileListFile, FirstLine, LastLine);

  FileRemList := Temp;

end;



Function FileNext: string;

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

var

  Temp: string;

  NumFiles: W10k;

  NumFilesStr: string;

begin

  Temp := UserDir(UserID[Port]) + '\' + 'File';

  NumFiles := 0;

  if FileLine('R', StatFile, 5, NumFilesStr) then

    begin

      NumFiles := IntStr(NumFilesStr);

      Temp := Temp + StrIntZer(NumFiles, 4)

    end

  else

    Temp := Temp + '0000';

  inc(NumFiles);

  NumFilesStr := StrInt(NumFiles);

  DumBool := FileLine('O', StatFile, 5, NumFilesStr);

  FileNext := Temp + '.BBS';

end;



Function FilesLoaded: integer;

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

var

  Temp: integer;

  TempStr: string;

begin

  Temp := 0;

  if FileLine('R', StatFile, 5, TempStr) then

    Temp := IntStr(TempStr);

  FilesLoaded := Temp;

end;



Procedure FilterPortChar(alpha: integer; PortChar: char);

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

var

  LenStr: integer;

  Letter: integer;

  SpaceFound: boolean;

  BackCount: integer;

  BackLoop: integer;

  CutStr: string;

  TooLong: boolean;

begin

  TooLong := false;

  if (InStrMaxLen[alpha] <= length(SessInStr[alpha]))

    and (AreaPeek = UserInput) then

      if (PortChar = Enter) or (PortChar = BackSpace) then

        SessInStr[alpha] := SessInStr[alpha] + PortChar

      else

        begin

          if WordWrap[Port] then

            begin

              LenStr := length(SessInStr[alpha]);

              Letter := LenStr;

              repeat

                SpaceFound := SessInStr[alpha, Letter] = ' ';

                Dec(Letter);

              until (Letter = 0) or SpaceFound;

              if SpaceFound then

                begin

                  SessInStr[alpha] := SessInStr[alpha] + PortChar;

                  BackCount := 0;

                  for BackLoop := LenStr downto Letter do

                    begin

                      inc(BackCount);

                      SessInStr[alpha] := SessInStr[alpha]

                        + BackSpace;

                    end;

                  CutStr := copy(SessInStr[alpha], Letter + 2,

                    BackCount - 1);

                  SessInStr[alpha] := SessInStr[alpha]

                    + Enter

                    + CutStr;

                end

              else

{* no spaces *}

                SessInStr[alpha] :=

                  copy(SessInStr[alpha], 1, InStrMaxLen[alpha])

                    + Enter

                    + copy(SessInStr[alpha], InStrMaxLen[alpha]+1,

                    length(SessInStr[alpha]));

            end

          else

            begin

              Say(Beep);

              TooLong := true;

            end;

        end

  else

    if (PortChar = BackSpace) and (SessInStr[alpha] = '') then

      Say(Beep)

    else

      SessInStr[alpha] := SessInStr[alpha] + PortChar;

  if ((PortChar <> BackSpace) and Echo[alpha])

    and not(TooLong) then

      begin

        if PortChar = '+' then

          PortChar := #197;

        PortOutStr[alpha] := PortOutStr[alpha] + PortChar;

      end;

  TooLong := false;

end;



Procedure FlushSessInput;

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

var

  alpha: integer;

begin

  FlushInputBuff(Port);

end;



procedure GetInputs;

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

var

  PortChar: char;

  alpha: integer;

begin

  for alpha := 0 to NumPorts do

    if GetChar(alpha, PortChar) then

      begin

        if alpha = 0 then

          begin

            if PortChar = Null then

              Monitor.Change

            else

              if Monitor.KeyboardOn then

                begin

                  if Area[Displayed, AreaTOS[Displayed]] = WaitConnect then

                    PortOutStr[Displayed] := PortOutStr[Displayed] +PortChar;

                  FilterPortChar(Displayed, PortChar);

                end;

          end

        else

          FilterPortChar(alpha, PortChar);

      end;

end;



Procedure IdentifyBBS;

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

begin

  SayL(#7+#7+#7);

  SayL('You have connected to the '+BBS_G+' BBS!');

  SayL('');

  SayL('Licensed to '+Owner_G+', Registration Number '+RegNum_G);

  SayL('Wyrm BBS Version '+Version_G+' Copyright 1991 David Croft');

  SayL('');

end;



Procedure InitBBSGlbls;

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

begin

  for Port := 0 to NumPorts do

    begin

      InitSessionVariables(Port);

      ResetDateTime[Port] := JulianDateTimeNow;

    end;

  for Port := NumPorts downto 0 do

    PortOutStr[Port] := '';

end;



procedure InitSessionVariables(Session: integer);

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

var

  alpha: integer;

begin

  Baud[Session] := 300;

  IsCallBack[Session] := false;

  InStrMaxLen[Session] := LineLen;

  Echo[Session] := false;

  LoginOK[Session] := false;

  UserID[Session] := 0;

  UserName[Session] := '';

  DateTimeLogOut[Session] := Infinity;

  for alpha := 1 to AreaMaxStack do

    Area[Session, alpha] := Zero;

  AreaTOS[Session] := 1;

  for alpha := 1 to VarIntegerMaxStack do

    VarInteger[Session, alpha] := 0;

  VarIntegerTOS[Session] := 1;

  for alpha := 1 to VarStrMaxStack do

    VarStr[Session, alpha] := '';

  VarStrTOS[Session] := 1;

  VarTextTOS[Session] := 1;

  ResetDateTime[Session] := JulianDateTimeNow + (15*60);

  Area[Session, AreaTOS[Session]] := WaitConnect;

  LinesPerPage[Session] := 23;

  SessInStr[Session] := '';

  WordWrap[Session] := false;

end;



Function MailCheck(QuietMode: boolean): boolean;

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

var

  InStr: string;

  UserBox: string;

  TempMailCheck: boolean;

begin

  TempMailCheck := false;

  UserBox := UserDir(UserID[Port]) + '\' + MailBox;

  if FileSizeAny(UserBox) > 0 then

    TempMailCheck := true;

  if not(QuietMode) then

    if TempMailCheck then

      SayL('You have E-MAIL.')

    else

      SayL('You have no e-mail right now.');

  MailCheck := TempMailCheck;

end;



Procedure MailMenu;

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

begin

  SayL('');

  SayL('E-MAIL HELP MENU');

  SayL('|');

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

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

  SayL('|');

  SayL('C ----- Chat/Comment to the SYSOP');

  SayL('G ----- Goodbye (log off)');

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

  SayL('Q ----- Quit back to the menu that calls this one');

end;



Procedure MailNewUser;

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

var

  EM: text;

begin

  if not(FileExists(NewUserMailFile)) then

    exit;

  if DirExists(UserDir(UserID[Port])) then

    if FileOpen('A', UserDir(UserID[Port]) + '\' + MailBox, EM) = 0 then

      begin

        writeln(EM, 'Wyrm BBS MANAGER');

        writeln(EM, 'New User Mail');

        writeln(EM, NewUserMailFile);

        close(EM);

      end;

end;



Function MailNext: string;

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

var

  TempMailNext: string;

  MailCount: integer;

begin

  TempMailNext := '';

  if DirExists(UserDir(UserID[Port])) then

    if FileLine('R', StatFile, 4, TempMailNext) then

      begin

        MailCount := IntStr(TempMailNext);

        Inc(MailCount);

        TempMailNext := StrInt(MailCount);

        DumBool := FileLine('O', StatFile, 4, TempMailNext);

        TempMailNext := UserDir(UserID[Port])+'\'

          + 'M' + StrIntZer(MailCount, 7) + '.BBS';

      end;

  MailNext := TempMailNext;

end;



Procedure MainInit;

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

var

  alpha: integer;

  InStr: string;

  CF: text;

begin

  AlarmInit;

  Monitor.Init;

  InitBBSGlbls;

  ExitSave := ExitProc;

  ExitProc := @RestartBBS;

  DosError := 0;

  SublimInit;

  DumBool := DirExistsMake(UserDir(0));

  for alpha := 0 to NumPorts do

    InitPort(alpha);

end;



Procedure MainLoop;

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

begin

  repeat

    Periodic;

    case AreaPeek of

      WaitConnect  :  DoWaitConnect;

      WaitConnect_1:  DoWaitConnect_1;

      UserInput    :  DoUserInput;

      Welcome      :  DoWelcome;

      Prompt       :  DoPrompt;

      Prompt_1     :  DoPrompt_1;

      LogOff       :  DoLogOff;

      LogOff_1     :  DoLogOff_1;

      Bulletins    :  DoBulletins;

      BullDel      :  DoBullDel;

      BullDel_1    :  DoBullDel_1;

      BullEdit     :  DoBullEdit;

      BullNext     :  DoBullNext;

      BullNext_1   :  DoBullNext_1;

      BullPickedBull       : DoBullPickedBull;

      BullPickedBull_1     : DoBullPickedBull_1;

      BullPickedBull_2     : DoBullPickedBull_2;

      BullPickedChild      : DoBullPickedChild;

      BullPickedChild_1    : DoBullPickedChild_1;

      BullPickedParent     : DoBullPickedParent;

      BullPickedParent_1   : DoBullPickedParent_1;

      BullPost     :  DoBullPost;

      BullPost_1   :  DoBullPost_1;

      BullPrompt   :  DoBullPrompt;

      BullPrompt_1 :  DoBullPrompt_1;

      BullRead     :  DoBullRead;

      BullRead_1   :  DoBullRead_1;

      BullSubCon       :  DoBullSubCon;

      BullSubCon_1     :  DoBullSubCon_1;

      BullSubCon_2     :  DoBullSubCon_2;

      BullSubDown  :  DoBullSubDown;

      BullSubDown_1:  DoBullSubDown_1;

      BullSubKill      :  DoBullSubKill;

      BullSubKill_1    :  DoBullSubKill_1;

      BullSubMake      :  DoBullSubMake;

      BullSubMake_1    :  DoBullSubMake_1;

      BullSubOpen      :  DoBullSubOpen;

      BullSubUp    :  DoBullSubUp;

      BullSubUp_1  :  DoBullSubUp_1;

      CallBack     :  DoCallBack;

      CallBack_1   :  DoCallBack_1;

      CallBack_2   :  DoCallBack_2;

      CallBack_3   :  DoCallBack_3;

      CallBack_4   :  DoCallBack_4;

      Comment     :  DoComment;

      Comment_1   :  DoComment_1;

      Disconnect   :  DoDisconnect;

      Disconnect_1   :  DoDisconnect_1;

      Disconnect_2   :  DoDisconnect_2;

      EditAppend         : DoEditAppend;

      EditAppend_1       : DoEditAppend_1;

      EditDelete         : DoEditDelete;

      EditDelete_1       : DoEditDelete_1;

      EditDelete_2       : DoEditDelete_2;

      EditInsert         : DoEditInsert;

      EditInsert_1       : DoEditInsert_1;

      EditInsert_2       : DoEditInsert_2;

      EditModify         : DoEditModify;

      EditModify_1       : DoEditModify_1;

      EditModify_2       : DoEditModify_2;

      EditPrompt         : DoEditPrompt;

      EditPrompt_1       : DoEditPrompt_1;

      FileShow             : DoFileShow;

      FileShow_1           : DoFileShow_1;

      GetName      :  DoGetName;

      GetName_1    :  DoGetName_1;

      GetName_2    :  DoGetName_2;

      GetName_3    :  DoGetName_3;

      HangUp       :  DoHangUp;

      HangUp_1     :  DoHangUp_1;

      HangUp_2     :  DoHangUp_2;

      HangUp_3     :  DoHangUp_3;

      Mail        :  DoMail;

      Mail_1      :  DoMail_1;

      MailSend    :  DoMailSend;

      MailSend_1  :  DoMailSend_1;

      MailSend_2  :  DoMailSend_2;

      MailRead    :  DoMailRead;

      MakePassword         : DoMakePassword;

      MakePassword_1       : DoMakePassword_1;

      MakePassword_2       : DoMakePassword_2;

      ModemSetup     :  DoModemSetup;

      ModemSetup_1   :  DoModemSetup_1;

      PassTime     :  DoPassTime;

      PasswordGood         : DoPasswordGood;

      PasswordGood_1       : DoPasswordGood_1;

      Pause                : DoPause;

      Pause_1              : DoPause_1;

      Register     :  DoRegister;

      Register_1   :  DoRegister_1;

      Register_2   :  DoRegister_2;

      Register_3   :  DoRegister_3;

      Register_4   :  DoRegister_4;

      Statistics     :  DoStatistics;

      Statistics_1   :  DoStatistics_1;

      StatUser       :  DoStatUser;

      StatUser_1     :  DoStatUser_1;

      StatUsersDel   :  DoStatUsersDel;

      StatUsersDel_1 :  DoStatUsersDel_1;

      StatUsersShow  :  DoStatUsersShow;

      StatUsersShow_1:  DoStatUsersShow_1;

      XFilePrompt          : DoXFilePrompt;

      XFilePrompt_1        : DoXFilePrompt_1;

      XFileDown            : DoXFileDown;

      XFileDown_1          : DoXFileDown_1;

      XFileDown_2          : DoXFileDown_2;

      XFileDown_3          : DoXFileDown_3;

      XFileRem             : DoXFileRem;

      XFileRem_1           : DoXFileRem_1;

      XFileUp              : DoXFileUp;

      XFileUp_1            : DoXFileUp_1;

      XFileUp_2            : DoXFileUp_2;

      XFileUp_3            : DoXFileUp_3;

      XFileUp_4            : DoXFileUp_4;

      XFileUp_5            : DoXFileUp_5;

      XFileView            : DoXFileView;

      XFileView_1          : DoXFileView_1;

      else

        ErrSayL(Beep+'Bad Area!!!:  '+ StrInt(Ord(AreaPeek)));

    end; {case}

  until Forever;

end;



Procedure MainMenu;

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

begin

  SayL('');

  SayL('MAIN HELP MENU');

  SayL('|');

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

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

  SayL('C ----- Chat/Comment to the System Operator (SYSOP)');

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

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

  SayL('F ----- Files');

  SayL('G ----- Goodbye (log off)');

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

  SayL('I ----- Information about Wyrm BBS');

end;



Function OutputClear(InPort: integer): boolean;

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

var

  Temp: boolean;

begin

  if InPort = 0 then

    begin

      OutputClear := PortOutStr[0] = '';

      exit;

    end;

  Temp := not((BytesInOutput(InPort) <> 0) or (PortOutStr[InPort] <> ''));

  OutputClear := Temp;

end;



Procedure Periodic;

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

var

  AreaP: AreaType;

begin

  inc(Port);



{* !!!!!!!!!!!! PATCH !!!!!!!!!!!!! *}

  Port := 2;



  if Port > NumPorts then

    Port := 0;

  Monitor.Update;

  GetInputs;

  PutOutputs;

  CheckTimeLeft;

  AreaP := AreaPeek;

{* Temp disabled !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  if not(AreaP in

   [

    WaitConnect..WaitConnect_1,

    CallBack_2..CallBack_3,

    Disconnect..Disconnect_2,

    GetName,

    HangUp..HangUp_3,

    PassTime,

    ModemSetup..ModemSetup_1

   ]) then

     if Disconnected(Port) then

        AreaReset(Disconnect);

*}

  if AlarmOn then

    DumBool := AlarmCheck;

end;



Function PrivCheck(MsgOn: boolean; PrivBits: longint): boolean;

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

begin

  if UserPrivs[Port] and PrivBits = PrivBits then

    PrivCheck := true

  else

    if MsgOn then

      begin

        PrivCheck := false;

        SayL(Beep);

        case PrivBits of

          BullReadPriv:

            SayL('You lack the privilege to read bulletins.');

          BullPostPriv:

            SayL('You lack the privilege to post bulletins.');

          BullKillPriv:

            SayL('You lack the privilege to trash another''s bulletins.');

          BullAreaMakePriv:

            SayL('You lack the privilege to make a BULLETIN subject area.');

          BullAreaKillPriv:

            SayL('You lack the privilege to delete a BULLETIN subject area.');

          BullEditPriv:

            SayL('You can only edit bulletins that you author.');

          else

            SayL('You lack the privileges to do this.');

        end; {case}

        SayL('Please contact the BBS Manager to expand your privileges.');

      end;

end;



Function Reply: string;

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

var

  Ending: integer;

  Temp: string;

begin

  Ending := 1;

  PosString(Enter, SessInStr[Port], Ending);

  Temp := copy(SessInStr[Port], 1, Ending - 1);

  Reply := Temp;

end;



{$F+}

Procedure RestartBBS;

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

{*  Catches fatal errors and restarts the BBS.

{*  TP Reference Guide pp. 216-7

{*  future mods:  p. 217 check and report ErrorAddr

{*    & output to printer (although if looping may use up all the paper)

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

var

  alpha: longint;

begin

  for alpha := 1 to NumPorts do

    CommClose(alpha, true);

  ExitProc := ExitSave;

  ErrSayL('Fatal Error!  BBS hung!');

  ErrSayL('Exit code:  '+StrInt(ExitCode));

  ErrSayL('IO Error :  '+StrInt(IOError));

  ErrSayL('Dos error:  '+StrInt(DosError));

  SayL('Hit any key to halt the program.');

  SayL('Wyrm BBS will automatically restart itself in a few seconds...');

  alpha := 0;

  repeat

    Inc(alpha);

  until (alpha = 100000) or keypressed;

  if keypressed then

    halt;

  MainLoop;

end;

{$F-}



Function SetUpBBSFiles(BBSFile: string): boolean;

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

var

  Success: boolean;

  BBS: text;

begin

  Success := false;

  if BBSFile = 'NUL' then

    begin

    end

  else

    SayL(Beep+'SetUpBBSFile function does not recognize '+BBSFile+'!');

  SetUpBBSFiles := Success;

end;



Procedure ShowTimeLeft;

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

var

  Sec, Min, Hour: longint;

  TimeLeft: longint;

begin

  if DateTimeLogOut[Port] = Infinity then

    begin

      Say('(No Time Limit) ');

      exit;

    end;

  TimeLeft := DateTimeLogOut[Port] - JulianDateTimeNow;

  SecsSplit(TimeLeft, DumLongInt, Hour, Min, Sec);

  Say('('+StrIntZer(Hour,2) +':'+ StrIntZer(Min, 2) + ':'

    + StrIntZer(Sec, 2)+') ');

end;



Procedure StatMenu;

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

begin

  SayL('');

  SayL('DATA HELP MENU');

  SayL('|');

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

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

  SayL('U ----- User Data Menu');

  SayL('|');

  SayL('C ----- Chat/Comment to the SYSOP');

  SayL('G ----- Goodbye (log off)');

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

  SayL('Q ----- Quit back to the menu that calls this one');

end;



Procedure StatUserMenu;

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

begin

  SayL('');

  SayL('USER DATA HELP MENU');

  SayL('|');

  SayL('S ----- Show users and their last logout time');

  SayL('U ----- show User data and settings');

  SayL('M ----- Toggle automatic menu display');

  SayL('P ----- change Password');

  SayL('|');

  SayL('N ----- change user privileges code Number');

  SayL('D ----- Delete a user');

  SayL('T ----- change user on-line Time');

  SayL('|');

  SayL('C ----- Chat/Comment to the SYSOP');

  SayL('G ----- Goodbye (log off)');

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

  SayL('Q ----- Quit back to the menu that calls this one');

end;



Procedure SublimInit;

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

var

  SF: text;

begin

  if not(FileExists(SubliminalFile)) then

    begin

      DumBool := FileCreate(SubliminalFile);

      Assign(SF, SubliminalFile);

      Append(SF);

      writeln(SF, 'Wyrm Bulletin Board System (WBBS) Version Test 1.');

      writeln(SF, 'Wyrm BBS by David Croft, copyright 1991.');

      writeln(SF, 'WBBS is a multi-user board.');

      writeln(SF, 'WBBS does bulletins, electronic-mail, and up/downloads.');

      writeln(SF, 'WBBS uses a system of privileges to protect data.');

      writeln(SF, 'WBBS users can change these one-line, random messages.');

      Close(SF);

    end;

  SublimRange := 0;

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

    begin

      while not(EOF(SF)) and (SublimRange <= SublimRangeMax) do

        begin

          Inc(SublimRange);

          readln(SF, Sublim[SublimRange]);

        end;

      close(SF);

    end

  else

    begin

      Sublim[1] := 'Error:  ' + SubliminalFile + ' will not open for read!';

      SublimRange := 1;

    end;

end;



Procedure SublimPick;

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

var

  LuckyLine: integer;

begin

  randomize;

  LuckyLine := random(SublimRange) + 1;

  SayL(Sublim[LuckyLine]);

end;



Procedure Trash(DeadFile: string);

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

var

  DF,

  TF: text;

  InStr: string;

  Dir: DirStr;

  Name: NameStr;

  Ext: ExtStr;

begin

  if FileOpen('R', DeadFile, DF) <> 0 then

    exit;

  FSplit(DeadFile, Dir, Name, Ext);

  if FileOpen('W', TrashDir + '\' + Name, TF) <> 0 then

    exit;

  repeat

    readln(DF, InStr);

    writeln(TF, InStr);

  until EOF(DF);

  Close(TF);

  Close(DF);

  FileDel(DeadFile, DumInt);

end;



Function UserDir(UserNum: W10k): string;

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

begin

  UserDir := UsersDir + '\' + 'USER'+StrIntZer(UserNum, 4) + '.BBS';

end;



Function UserFindID(var NameStr: string): integer;

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

var

  TempUserFindID: integer;

  UserLine: integer;

  IDStr: string;

begin

  TempUserFindID := -1;

  UserLine := FileSearch('u', UsersLog, NameStr);

  if UserLine <> 0 then

    if FileLine('R', UsersLog, UserLine + 1, IDStr) then

      if FileLine('R', UsersLog, UserLine, NameStr) then

        TempUserFindID := IntStr(IDStr);

  if UpCaseStr(NameStr) = 'MANAGER' then

    begin

      NameStr := 'MANAGER';

      TempUserFindID := 0;

    end;

  if UpCaseStr(NameStr) = 'SYSOP' then

    begin

      NameStr := 'SYSOP';

      TempUserFindID := 0;

    end;

  UserFindID := TempUserFindID;

end;



Function  UserFindName(UserNum: integer): string;

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

var

  TempUserFindName: string;

  UserLine: integer;

  UserNumStr: string;

  NameUser: string;

begin

  TempUserFindName := 'unkPortn';

  UserNumStr := StrInt(UserNum);

  UserLine := FileSearch('L', UsersLog, UserNumStr);

  if UserLine > 1 then

    if FileLine('R', UsersLog, UserLine - 1, NameUser) then

      TempUserFindName := NameUser;

  UserFindName := TempUserFindName;

end;



Function UserKill: boolean;

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

var

  TempUserKill: boolean;

  DeadLine: integer;

begin

  TempUserKill := false;

  DeadLine := FileSearch('U', UsersLog, UserName[Port]);

  if DeadLine <> 0 then

    if FileLine('D', UsersLog, DeadLine, DumStr) then

      if FileLine('D', UsersLog, DeadLine, DumStr) then

        TempUserKill := true;

  UserKill := TempUserKill;

end;



Function UserNext: integer;

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

var

  NumUsersStr: string;

  NumUsers: integer;

begin

  if not(FileExists(StatFile)) then

    DumBool := FileCreate(StatFile);

  if not(FileLine('R', StatFile, 3, NumUsersStr)) then

    NumUsersStr := '0';

  NumUsers := IntStr(NumUsersStr) + 1;

  NumUsersStr := StrInt(NumUsers);

  DumBool := FileLine('O', StatFile, 3, NumUsersStr);

  UserNext := NumUsers;

end;



Function ValidName: boolean;

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

var

  InStr: string;

  F: text;

  Found: boolean;

begin

  if (UpCaseStr(UserName[Port]) = 'MANAGER') or

    (UpCaseStr(UserName[Port]) = 'SYSOP') or

    (UpCaseStr(UserName[Port]) = 'SYSTEM') then

      begin

        UserName[Port] := 'Manager';

        ValidName := true;

        UserID[Port] := 0;

        exit;

      end;

  if not(FileExists(UsersLog)) then

    DumBool := FileCreate(UsersLog);

  if FileOpen('R', UsersLog, F) <> 0 then

    if not(FileCreate(UsersLog)) or (FileOpen('R', UsersLog, F) <> 0) then

      begin

        ErrSayL('UsersLog not found!');

        ValidName := false;

        exit;

      end;

  Found := false;

  repeat

    ReadLn(F, InStr);

    if UpCaseStr(InStr) = UpCaseStr(UserName[Port]) then

      begin

        UserName[Port] := InStr;

        Found := true;

        ReadLn(F, UserID[Port]);

      end;

  until EOF(F) or Found;

  Close(F);

  if Found then

    ValidName := true

  else

    ValidName := false;

end;



Function VarPeekInteger: Integer;

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

begin

  VarPeekInteger := VarInteger[Port, VarIntegerTOS[Port] - 1];

end;



Function VarPeekStr: string;

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

begin

  if VarStrTOS[Port] = 1 then

    ErrSayL('Error:  VarPeekStr attempted when VarStrTOS = 1!')

  else

    VarPeekStr := VarStr[Port, VarStrTOS[Port] - 1];

end;



Function VarPeekTextNum: integer;

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

begin

  VarPeekTextNum := VarTextTOS[Port] - 1;

end;



Function VarPopInteger: Integer;

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

begin

  if VarIntegerTOS[Port] = 1 then

    begin

      ErrSayL('VarIntegerTOS popped to less than 1!!!');

      VarPopInteger := 0;

    end

  else

    begin

      VarPopInteger := VarInteger[Port, VarIntegerTOS[Port] - 1];

      VarInteger[Port, VarIntegerTOS[Port]] := 0;

      Dec(VarIntegerTOS[Port]);

    end;

end;



Function VarPopStr: string;

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

begin

  if VarStrTOS[Port] = 1 then

    begin

      ErrSayL('VarStrTOS popped to less than 1!!!');

      VarPopStr := '';

    end

  else

    begin

      VarPopStr := VarStr[Port, VarStrTOS[Port] - 1];

      VarStr[Port, VarStrTOS[Port]] := '';

      Dec(VarStrTOS[Port]);

    end;

end;



Function VarPopTextNum: integer;

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

begin

  if VarTextTOS[Port] = 1 then

    ErrSayL('VarTextTOS popped to less than 1!!!')

  else

    begin

      VarPopTextNum := VarTextTOS[Port] - 1;

      Dec(VarTextTOS[Port]);

    end;

end;



Procedure VarPushInteger(PushedInteger: Integer);

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

var

  alpha: integer;

begin

  if VarIntegerTOS[Port] = VarIntegerMaxStack then

    begin

      ErrSayL('VarIntegerTOS pushed past VarIntegerMaxStack!!!');

      for alpha := 1 to (VarIntegerMaxStack - 1) do

        VarInteger[Port, alpha] := VarInteger[Port, alpha + 1];

      VarInteger[Port, VarIntegerTOS[Port]] := PushedInteger;

    end

  else

    begin

      VarInteger[Port, VarIntegerTOS[Port]] := PushedInteger;

      Inc(VarIntegerTOS[Port]);

    end;

end;



Procedure VarPushStr(PushedStr: string);

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

var

  alpha: integer;

begin

  if VarStrTOS[Port] = VarStrMaxStack then

    begin

      ErrSayL('VarStrTOS pushed past VarStrMaxStack!!!');

      for alpha := 1 to (VarStrMaxStack - 1) do

        VarStr[Port, alpha] := VarStr[Port, alpha + 1];

      VarStr[Port, VarStrTOS[Port]] := PushedStr;

    end

  else

    begin

      VarStr[Port, VarStrTOS[Port]] := PushedStr;

      Inc(VarStrTOS[Port]);

    end;

end;



Function  VarPushText: integer;

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

var

  Temp: integer;

begin

  if VarTextTOS[Port] = VarTextMaxStack then

    ErrSayL('VarTextTOS pushed past VarTextMaxStack!!!')

  else

    Inc(VarTextTOS[Port]);

  Temp := VarTextTOS[Port] - 1;

  VarPushText := Temp;

end;



Procedure VarResetInteger(InitInteger: Integer);

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

begin

  VarIntegerTOS[Port] := 1;

  VarInteger[Port, VarIntegerTOS[Port]] := InitInteger;

end;



Procedure VarResetStr(InitStr: String);

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

begin

  VarStrTOS[Port] := 1;

  VarStr[Port, VarStrTOS[Port]] := InitStr;

end;



Procedure VarTextCloseAll(Session: integer);

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

var

  Index: integer;

begin

{$I-}

  for Index := 1 to VarTextMaxStack do

    Close(VarText[Session, Index]);

{$I+}

  DumInt := IOResult;

end;



Procedure XFileMenu;

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

begin

  SayL('');

  SayL('FILE HELP MENU');

  SayL('|');

  SayL('V ----- View files available');

  SayL('D ----- Download a file from this BBS');

  SayL('U ----- Upload a file to this BBS');

  SayL('R ----- Remove a file from the list');

  SayL('|');

  SayL('C ----- Chat/Comment to the SYSOP');

  SayL('G ----- Goodbye (log off)');

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

  SayL('Q ----- Quit back to the menu that calls this one');

end;



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

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

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

begin

end.