{$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.