{$N+,E+}

Unit DoSubs2;

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

{*  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 DoPassTime;

Procedure DoPasswordGood;

Procedure DoPasswordGood_1;

Procedure DoPause;

Procedure DoPause_1;

Procedure DoRegister;

Procedure DoRegister_1;

Procedure DoRegister_2;

Procedure DoRegister_3;

Procedure DoRegister_4;

Procedure DoStatistics;

Procedure DoStatistics_1;

Procedure DoStatUser;

Procedure DoStatUser_1;

Procedure DoStatUsersDel;

Procedure DoStatUsersDel_1;

Procedure DoStatUsersShow;

Procedure DoStatUsersShow_1;

Procedure DoWelcome;

Procedure DoXFilePrompt;

Procedure DoXFilePrompt_1;

Procedure DoXFileDown;

Procedure DoXFileDown_1;

Procedure DoXFileDown_2;

Procedure DoXFileDown_3;

Procedure DoXFileRem;

Procedure DoXFileRem_1;

Procedure DoXFileUp;

Procedure DoXFileUp_1;

Procedure DoXFileUp_2;

Procedure DoXFileUp_3;

Procedure DoXFileUp_4;

Procedure DoXFileUp_5;

Procedure DoXFileView;

Procedure DoXFileView_1;



implementation

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

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

uses

  BBSFuncs,

  BBSGlbls,

  Bull,

  Crt,

  Dos,

  Disk,

  Glob,

  IOPorts,

  LCTKrnl,

  Misc,

  Data,

  Time,

  UpDnLoad,

  UserData;



Procedure DoPassTime;

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

begin

  if JulianDateTimeNow > DelayDone[Port] then

    AreaPop;

end;



Procedure DoPasswordGood;

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

begin

  Echo[Port] := false;

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

end;



Procedure DoPasswordGood_1;

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

var

  Password: string;

  RealPass: string;

begin

  Password := Reply;

  Echo[Port] := true;

  if UserID[Port] = 0 then

    RealPass := ManagerPassword

  else

    if not(FileLine('R', UserFile(UserID[Port]), 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

    begin

      AreaSub(Prompt);

      AreaPush(Welcome);

    end

  else

    begin

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

      VarPushInteger(VarPopInteger + 1);

      AreaSub(GetName_1);

    end;

end;



Procedure DoPause;

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

begin

  Say('Please press ENTER to continue...');

  BeepTime[Port] := InputTime/10;

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

  SessInStr[Port] := '';

  AreaSub(Pause_1);

  AreaPush(UserInput);

end;



Procedure DoPause_1;

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

begin

  Say(MultiChar(Backspace, 80));

  Say(MultiChar(' ', 79));

  Say(MultiChar(Backspace, 79));

  AreaPop;

end;



Procedure DoRegister;

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

begin

  UserID[Port] := UserNext;

  SayL('');

  SayL('For security and avoiding long distance bills, this Wyrm BBS can');

  SayL('call you back immediately after you log in.  You only need to give');

  SayL('your modem the automatic answer command "ATA".');

  SayL('');

  Ask('Do you want the automatic call-back feature (Y/n)?:  ',

    Register_1, 1);

end;



Procedure DoRegister_1;

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

var

  Auto: string;

begin

  Auto := Reply;

  if upcase(Auto[1]) = 'N' then

    begin

      VarPushStr('');

      AreaSub(Register_4);

    end

  else

    AreaSub(Register_2);

end;



Procedure DoRegister_2;

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

begin

  Ask('Please enter your 7-digit phone number [ENTER = Cancel]:  ',

    Register_3, 8);

end;



Procedure DoRegister_3;

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

var

  Phone: string;

begin

  Phone := Reply;

  if Phone = '' then

    AreaSub(Register)

  else

    begin

      Phone := StrStripNonNum(Phone);

      if length(Phone) <> 7 then

        begin

          SayL(#7+'Please enter a 7 digit phone number.');

          AreaSub(Register_2);

        end

      else

        begin

          VarPushStr(Phone);

          AreaSub(Register_4);

        end;

    end;

end;



Procedure DoRegister_4;

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

var

  Phone: string;

  UL: text;

begin

  Phone := VarPopStr;

  UserData.ChangePhone(Phone);

  DateTimeLogOut[Port] := JulianDateTimeNow + RegisterTime;

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

    begin

      writeln(UL, UserName[Port]);

      writeln(UL, UserID[Port]);

      Close(UL);

      MailNewUser;

      AreaSub(Prompt);

      AreaPush(Welcome);

      AreaPush(MakePassword);

    end

  else

    AreaSub(Disconnect);

end;



Procedure DoStatistics;

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

begin

  if UserMenu[Port] = 'ON' then

    StatMenu;

  SayL('');

  ShowTimeLeft;

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

end;



Procedure DoStatistics_1;

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

const

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

    'Number of bulletins posted:  ',

    'Number of subject areas created under BULLETINS:  ',

    'Number of users:  ',

    'Number of e-mail letters created:  ',

    'Number of files uploaded:  ');

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);

            AreaPush(Pause);

          end;

      'D':

        begin

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

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

          AreaPush(Pause);

        end;

      'C': AreaPush(Comment);

      'H': if UserMenu[Port] <> 'ON' then

             StatMenu;

      'Q'     : AreaPop;

      'G': AreaPush(LogOff);

      'U': AreaPush(StatUser);

      else

        begin

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

          AreaPush(Pause);

        end;

    end; {case}

end;



Procedure DoStatUser;

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

begin

  if UserMenu[Port] = 'ON' then

    StatUserMenu;

  SayL('');

  ShowTimeLeft;

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

end;



Procedure DoStatUser_1;

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

var

  LineStr: string;

begin

  AreaSub(StatUser);

  LineStr := Reply;

  ;

  SayL('');

  if LineStr = '' then

    exit;

  case upcase(LineStr[1]) of

    'C': AreaPush(Comment);

    'D': AreaPush(StatUsersDel);

    'G': AreaPush(LogOff);

    'H': if UserMenu[Port] <> 'ON' then

           StatUserMenu;

    'Q': AreaPop;

    'M':

      begin

        if UserMenu[Port] = 'ON' then

          UserMenu[Port] := 'OFF'

        else

          UserMenu[Port] := 'ON';

        DumBool := FileLine('O', UserFile(UserID[Port]), 4, UserMenu[Port]);

      end;

    'S':  AreaPush(StatUsersShow);

    'U':  begin

            UserData.Show(UserID[Port]);

            AreaPush(Pause);

          end;

    else

      begin

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

        AreaPush(Pause);

      end;

  end; {case}

end;



Procedure DoStatUsersDel;

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

begin

  if not(PrivCheck(true, UserDelPriv)) then

    begin

      AreaPop;

      AreaPush(Pause);

    end

  else

    Ask('Number of the user to delete [ENTER to cancel]:  ', StatUsersDel_1,

      4);

end;



Procedure DoStatUsersDel_1;

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

var

  DeadUserStr: string;

  LogStat: boolean;

  Next: W10K;

  UserNumStr: string;

begin

  AreaPop;

  DeadUserStr := Reply;

  if DeadUserStr = '' then

    exit;

  Next := 0;

  repeat

    inc(Next);

    LogStat := FileLine('R', UsersLog, Next*2, UserNumStr);

  until (UserNumStr = DeadUserStr) or not(LogStat);

  if not(LogStat) then

    begin

      SayL('User number not in the Users Log.');

      AreaPush(Pause);

      exit;

    end;

  if FileLine('D', UsersLog, Next*2-1, DumStr) and

    FileLine('D', UsersLog, Next*2-1, DumStr) then

      SayL('User number '+UserNumStr+' deleted from the Users Log.')

    else

      begin

        SayL('Failure.  User NOT deleted from the Users Log.');

        AreaPush(Pause);

        exit;

      end;

  if DirKillDef(UserDir(IntStr(UserNumStr))) = 0 then

    SayL('User''s directory was deleted.')

  else

    SayL('Failure.  User''s directory was NOT deleted.');

  AreaPush(Pause);

end;



Procedure DoStatUsersShow;

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

begin

  AreaSub(StatUsersShow_1);

  VarPushInteger(1);

end;



Procedure DoStatUsersShow_1;

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

var

  LastLogout: string;

  LineNum: integer;

  Next: integer;

  UL: text;

  UserStr: string;

  UserNumStr: string;

begin

  Next := VarPopInteger;

  if (FileLine('R', UsersLog, Next*2-1, UserStr)

{*  and (UserStr <> ''))

*}

    and FileLine('R', UsersLog, Next*2, UserNumStr))

    and FileLine('R', UserFile(IntStr(UserNumStr)), 5, LastLogout) then

      begin

        LastLogout := StrSized(LastLogout, 27);

        UserNumStr := StrIntZer(IntStr(UserNumStr), 4);

        SayL('('+UserNumStr+') '+LastLogout + ':  ' + UserStr);

        inc(Next);

        if Next mod LinesPerPage[Port] = 0 then

          AreaPush(Pause);

        VarPushInteger(Next);

      end

  else

    AreaSub(Pause);

end;



Procedure DoWelcome;

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

var

  LastBull: string;

  LastFile: string;

  LogoutTime: string;

  NumSecsStr: string;

  NumSecs: longint;

  Phone: string;

  UserPrivsStr: string;

  UF: string;

begin

  DumInt := VarPopInteger; {* from GetName *}

  LoginOK[Port] := true;

  UF := UserFile(UserID[Port]);

  if UserID[Port] = 0 then

    begin

      NumSecs := Infinity;

      UserPrivs[Port] := AllPrivs;

    end

  else

    begin

      if not(FileLine('R', UF, 2, NumSecsStr)) or (NumSecsStr = '') then

        begin

          NumSecs := NewUserTime;

          NumSecsStr := StrInt(NewUserTime);

          DumBool := FileLine('O', UF, 2, NumSecsStr);

        end

      else

        NumSecs := IntStr(NumSecsStr);

      if not(FileLine('R', UF, 3, UserPrivsStr)) or (UserPrivsStr = '') then

        begin

          UserPrivs[Port] := NewUserPrivs;

          UserPrivsStr := StrInt(NewUserPrivs);

          DumBool := FileLine('O', UF, 3, UserPrivsStr);

        end

      else

        UserPrivs[Port] := IntStr(UserPrivsStr);

    end;

  if not(FileLine('R', UF, 4, UserMenu[Port])) or (UserMenu[Port] = '') then

    begin

      UserMenu[Port] := NewUserMenu;

      DumBool := FileLine('O', UF, 4, UserMenu[Port]);

    end;

  if NumSecs = Infinity then

    DateTimeLogOut[Port] := Infinity

  else

    DateTimeLogOut[Port] := JulianDateTimeNow + NumSecs;

  SayL('');

  SayL('Welcome, '

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

  DumBool := MailCheck(false);

  if not(FileLine('R', UF, 5, LogoutTime)) or (LogoutTime = '') then

    SayL('This is your first time on this Wyrm BBS.')

  else

    SayL('You were last on this Wyrm BBS at '+LogoutTime+'.');

  if not(FileLine('R', UF, 6, LastBull)) or (LastBull = '') then

    SayL('Bulletins posted on this Wyrm BBS:  '+StrInt(BullsPosted))

  else

    SayL('Bulletins posted since you last logged off:  '

      + StrInt(BullsPosted - IntStr(LastBull)));

  if not(FileLine('R', UF, 7, LastFile)) or (LastFile = '') then

    SayL('Files uploaded to this Wyrm BBS:  '+StrInt(FilesLoaded))

  else

    SayL('Files uploaded since you last logged off:  '

      + StrInt(FilesLoaded - IntStr(LastFile)));

  SayL('');

  AreaSub(Pause);

  if not(IsCallBack[Port]) then

    if UserData.GetPhone(Phone) then

      if length(StrStripNonNum(Phone)) = 7 then

        AreaSub(CallBack);

end;



Procedure DoXFilePrompt;

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

begin

  if UserMenu[Port] = 'ON' then

    XFileMenu;

  SayL('');

  ShowTimeLeft;

  Ask('FILES command prompt (Type H for help):  ', XFilePrompt_1, 1);

end;



Procedure DoXFilePrompt_1;

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

var

  Command: string;

begin

  AreaSub(XFilePrompt);

  ;

  SayL('');

  Command := Reply;

  if Command = '' then

    begin

      Say(Beep);

      exit;

    end;

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

  Case Command[1] of

    'D': AreaPush(XFileDown);

    'G': AreaPush(LogOff);

    'H': if UserMenu[Port] <> 'ON' then

                XFileMenu;

    'C': AreaPush(Comment);

    'Q': AreaPop;

    'R': AreaPush(XFileRem);

    'U': AreaPush(XFileUp);

    'V': AreaPush(XFileView);

  else

    begin

      Say(#7);

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

    end;

  end; {case}

end;



Procedure DoXFileDown;

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

begin

  Ask(

    'Number of the file you want to receive (1 to 9999) [ENTER to cancel]:  '

    ,XFileDown_1,4);

end;



Procedure DoXFileDown_1;

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

begin

  if Reply = '' then

    begin

      AreaPop;

      exit;

    end

  else

    VarPushStr(Reply);

  Ask('XModem, XModem-1K, or YModem Batch (x,k,Y):  ', XFileDown_2, 1);

end;



Procedure DoXFileDown_2;

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

var

  DownFile: string;

  DownFileInt: integer;

  FileCodeName,

  FileNormName: string;

  Mode: UpDnLoad.ModeType;

  ModeStr: string;

begin

  DownFile := VarPopStr;

  ModeStr := Reply;

  ;

  if DownFile = '' then

    begin

      AreaPop;

      exit;

    end;

  if upcase(ModeStr[1]) = 'X' then

    begin

      Mode := XModem;

      ModeStr := 'XModem';

    end

  else

    if upcase(ModeStr[1]) = 'K' then

      begin

        Mode := YModem;

        ModeStr := 'XModem-1K';

      end

    else

      begin

        Mode := YModemB;

        ModeStr := 'YModem Batch';

      end;

  DownFileInt := IntStr(DownFile) - 1;

  if FileLine('R', FileListFile, DownFileInt*FileListLines+1,

    FileCodeName) and

      FileLine('R', FileListFile, DownFileInt*FileListLines+2,

        FileNormName) then

          begin

            SayL('Start your download of "'+FileNormName

              +'" via '+ModeStr+' Port.');

            VarPushStr(FileCodeName);

            VarPushStr(ModeStr);

            VarPushInteger(DownFileInt);

            DelayBBS(3, XFileDown_3);

          end

  else

    begin

      SayL('File number '+DownFile+' not in the public File List.');

      AreaPop;

    end;

end;



Procedure DoXFileDown_3;

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

var

  FileCodeName: string;

  DownFileInt: integer;

  DownNum: string;

  DownNumInt: integer;

  Mode: UpDnLoad.ModeType;

  ModeStr: string;

begin

  if not(OutputClear(Port)) then

    exit;

  ModeStr := VarPopStr;

  FileCodeName := VarPopStr;

  DownFileInt := VarPopInteger;

  ;

  if ModeStr = 'XModem' then

    Mode := XModem

  else

    Mode := YModem;

  if UpDnLoad.UpLoad(Mode, FileCodeName, Port) then

    if FileLine('R', FileListFile, DownFileInt*FileListLines+7, DownNum) then

      begin

        DownNumInt := IntStr(DownNum);

        inc(DownNumInt);

        DownNum := StrInt(DownNumInt);

        DumBool := FileLine('O', FileListFile, DownFileInt*FileListLines+7,

          DownNum);

      end;

  AreaPop;

end;



Procedure DoXFileRem;

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

begin

  Ask(

    'Number of the file you want to remove (1 to 9999) [ENTER = cancel]:  ',

      XFileRem_1, 4);

end;



Procedure DoXFileRem_1;

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

begin

  if Reply = '' then

    begin

      AreaPop;

      exit;

    end;

  if FileRemList(Reply) then

    SayL('File successfully removed.')

  else

    SayL(Beep + 'File not removed!');

  AreaPush(Pause);

end;



Procedure DoXFileUp;

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

begin

  Ask('Name of file you want to send [ENTER to cancel]:  ', XFileUp_1, 12);

end;



Procedure DoXFileUp_1;

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

var

  UpFile: string;

begin

  UpFile := Reply;

  if UpFile = '' then

    begin

      AreaPop;

      exit;

    end;

  VarPushStr(UpFile);

  Ask('Copyright status (Public, Copyrighted, Shareware, UnkPortn/Other):  ',

    XFileUp_2, 1);

end;



Procedure DoXFileUp_2;

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

var

  CopyrStr: string;

  Copyr: char;

begin

  CopyrStr := Reply;

  if CopyrStr = '' then

    CopyrStr := 'U';

  Copyr := upcase(CopyrStr[1]);

  case Copyr of

    'P':  CopyrStr := 'Public';

    'C':  CopyrStr := 'Copyrighted';

    'S':  CopyrStr := 'Shareware';

    'U':  CopyrStr := 'UnkPortn';

    else

      CopyrStr := 'UnkPortn';

  end; {case}

  VarPushStr(CopyrStr);

  SayL('Please give a one line description.');

  Ask('', XFileUp_3, 0);

end;



Procedure DoXFileUp_3;

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

begin

  VarPushStr(Reply);

  Ask('XModem or XModem-1K/YModem (x/Y):  ', XFileUp_4, 1);

end;



Procedure DoXFileUp_4;

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

var

  ModeStr: string;

begin

  ModeStr := Reply;

  VarPushStr(ModeStr);

  if upcase(ModeStr[1]) = 'X' then

    ModeStr := 'XModem'

  else

    ModeStr := 'YModem/XModem-1K';

  SayL('Start your upload of the file via '+ModeStr+' Port.');

  DelayBBS(3, XFileUp_5);

end;



Procedure DoXFileUp_5;

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

var

  UpFile,

  CopyrStr,

  Descrip: string;

  FileCodeName: string;

  Mode: UpDnLoad.ModeType;

  ModeStr: string;

begin

  if not(OutputClear(Port)) then

    exit;

  ModeStr := VarPopStr;

  Descrip := VarPopStr;

  CopyrStr := VarPopStr;

  UpFile := VarPopStr;

  ;

  if upcase(ModeStr[1]) = 'X' then

    Mode := XModem

  else

    Mode := YModem;

  FileCodeName := FileNext;

  if UpDnLoad.DownLoad(Mode, FileCodeName, Port) then

    FileAddList(FileCodeName, UpFile, CopyrStr, Descrip);

  AreaPop;

end;



Procedure DoXFileView;

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

begin

  if not(FileExists(FileListFile)) then

    begin

      SayL('There are no files available in the public File List.');

      AreaSub(Pause);

      exit;

    end;

  VarPushInteger(0);

  AreaSub(XFileView_1);

end;



Procedure DoXFileView_1;

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

var

  FileNum: integer;

  NormFileName: string;

  Copyright,

  Rating,

  NumRaters,

  NumDown,

  Description: string;

begin

  FileNum := VarPopInteger;

  if (FileLine('R', FileListFile, FileNum*FileListLines+2, NormFileName)) and

    (NormFileName <> '') then

      begin

        Say('('+StrIntZer(FileNum+1, 4)+')  '+StrSized(NormFileName,12)

          +' ');

        Copyright := '?';

        DumBool := FileLine('R', FileListFile, FileNum*FileListLines+3,

          Copyright);

        Say(StrSized(Copyright, 11)+'  ');

        Rating := '?';

        DumBool := FileLine('R', FileListFile, FileNum*FileListLines+5,

          Rating);

        Say('Rating: '+StrSized(Rating, 4)+'  ');

        NumRaters := '?';

        DumBool := FileLine('R', FileListFile, FileNum*FileListLines+6,

          NumRaters);

        Say('Raters: '+StrSized(NumRaters,4)+'  ');

        NumDown := '?';

        DumBool := FileLine('R', FileListFile, FileNum*FileListLines+7,

          NumDown);

        SayL('Downloads: '+StrSized(NumDown, 4));

        Description := 'Description ???';

        DumBool := FileLine('R', FileListFile, FileNum*FileListLines+4,

          Description);

        SayL(Description);

        inc(FileNum);

        VarPushInteger(FileNum);

        if FileNum mod (LinesPerPage[Port] div 2 - 1) = 0 then

          AreaPush(Pause);

      end

  else

    AreaSub(Pause);

end;



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

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

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

begin

end.