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