{$N+,E+} Unit DoSubs1; {***************************************************************************} {* 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 DoWaitConnect; Procedure DoWaitConnect_1; Procedure DoGetName; Procedure DoGetName_1; Procedure DoGetName_2; Procedure DoGetName_3; Procedure DoUserInput; Procedure DoPrompt; Procedure DoPrompt_1; Procedure DoLogOff; Procedure DoLogOff_1; Procedure DoDisconnect; Procedure DoDisconnect_1; Procedure DoDisconnect_2; Procedure DoBulletins; Procedure DoBullDel; Procedure DoBullDel_1; Procedure DoBullEdit; Procedure DoBullNext; Procedure DoBullNext_1; Procedure DoBullPickedChild; Procedure DoBullPickedChild_1; Procedure DoBullPickedParent; Procedure DoBullPickedParent_1; Procedure DoBullPickedBull; Procedure DoBullPickedBull_1; Procedure DoBullPickedBull_2; Procedure DoBullPost; Procedure DoBullPost_1; Procedure DoBullPrompt; Procedure DoBullPrompt_1; Procedure DoBullRead; Procedure DoBullRead_1; Procedure DoBullSubKill; Procedure DoBullSubKill_1; Procedure DoBullSubCon; Procedure DoBullSubCon_1; Procedure DoBullSubCon_2; Procedure DoBullSubDown; Procedure DoBullSubDown_1; Procedure DoBullSubMake; Procedure DoBullSubMake_1; Procedure DoBullSubOpen; Procedure DoBullSubUp; Procedure DoBullSubUp_1; Procedure DoCallBack; Procedure DoCallBack_1; Procedure DoCallBack_2; Procedure DoCallBack_3; Procedure DoCallBack_4; Procedure DoComment; Procedure DoComment_1; Procedure DoEditAppend; Procedure DoEditAppend_1; Procedure DoEditDelete; Procedure DoEditDelete_1; Procedure DoEditDelete_2; Procedure DoEditInsert; Procedure DoEditInsert_1; Procedure DoEditInsert_2; Procedure DoEditModify; Procedure DoEditModify_1; Procedure DoEditModify_2; Procedure DoEditPrompt; Procedure DoEditPrompt_1; Procedure DoFileShow; Procedure DoFileShow_1; Procedure DoHangUp; Procedure DoHangUp_1; Procedure DoHangUp_2; Procedure DoHangUp_3; Procedure DoMail; Procedure DoMail_1; Procedure DoMailSend; Procedure DoMailSend_1; Procedure DoMailSend_2; Procedure DoMailRead; Procedure DoMakePassword; Procedure DoMakePassword_1; Procedure DoMakePassword_2; Procedure DoModemSetup; Procedure DoModemSetup_1; implementation {***************************************************************************} {***************************************************************************} uses BBSFuncs, BBSGlbls, Bull, Crt, Dos, Disk, Glob, IOPorts, LCTKrnl, Misc, Monitor, Data, Time, UpDnLoad, UserData; Procedure DoWaitConnect; {***************************************************************************} begin if JulianDateTimeNow > ResetDateTime[Port] then begin AreaSub(ModemSetUp); exit; end; if Port = 0 then begin if SessInStr[0] <> '' then AreaSub(GetName); exit; end; if pos('CONNECT', UpCaseStr(SessInStr[Port])) <> 0 then begin DateTimeLogOut[Port] := JulianDateTimeNow + ConnectTime; DelayBBS(3, WaitConnect_1); end else if IsCallBack[Port] and ( (Pos('BUSY', SessInStr[Port]) <> 0) or (Pos('NO DIALTONE', SessInStr[Port]) <> 0) ) then AreaSub(CallBack_3); end; Procedure DoWaitConnect_1; {***************************************************************************} begin if Pos('2400', SessInStr[Port]) <> 0 then Baud[Port] := 2400 else if Pos('1200', SessInStr[Port]) <> 0 then Baud[Port] := 1200 else if not(IsCallBack[Port]) then Baud[Port] := 300; DumBool := BaudSwitch(Port, Baud[Port]); Monitor.Wr(Port, SessInStr[Port]); SessInStr[Port] := ''; DateTimeLogOut[Port] := JulianDateTimeNow + LogInTime; DelayBBS(1, GetName); end; Procedure DoUserInput; {***************************************************************************} var InChar: char; LenStr: byte; Letter: byte; Part1, Part2: string; begin if JulianDateTimeNow > InputDeadLine[Port] then begin BeepTime[Port] := BeepTime[Port]*0.9; InputDeadLine[Port] := JulianDateTimeNow + BeepTime[Port]; Say(Beep); if BeepTime[Port] < 0.001 then begin InputDeadLine[Port] := Infinity; SayL(''); SayL('Your prompt input time has expired, '+UserName[Port]+'!'); SayL('Disconnecting... Please call again later.'); AreaSub(Disconnect); end; end; if length(SessInStr[Port]) = 0 then exit; Letter := 0; repeat LenStr := length(SessInStr[Port]); inc(Letter); InChar := SessInStr[Port, Letter]; case InChar of BackSpace: begin if LenStr <> 1 then begin if Echo[Port] then Say(BackSpace+' '+BackSpace); Part1 := copy(SessInStr[Port], 1, Letter - 2); Part2 := copy(SessInStr[Port], Letter + 1, LenStr - Letter); SessInStr[Port] := Part1 + Part2; Dec(Letter, 3); end else begin Say(Beep); SessInStr[Port] := ''; end; end; Enter: begin AreaPop; if AreaPeek <> Pause_1 then SayL(''); end; end; {case} until (InChar = Enter) or (Letter = length(SessInStr[Port])); end; Procedure DoGetName; {***************************************************************************} var alpha: integer; begin for alpha := 1 to 10 do SayL(''); IdentifyBBS; VarPushInteger(0); FlushSessInput; Echo[Port] := true; AreaSub(GetName_1); end; Procedure DoGetName_1; {***************************************************************************} begin if VarPeekInteger = 3 then AreaSub(Disconnect) else Ask('Name: ', GetName_2, 0); end; Procedure DoGetName_2; {***************************************************************************} var OK: boolean; begin IsCallBack[Port] := IsCallBack[Port] and (UpCaseStr(UserName[Port]) = UpCaseStr(Reply)); UserName[Port] := Reply; UserName[Port] := UpCaseFirstLetters(UserName[Port]); OK := ValidName; if not(OK) then begin Say(#7); SayL('I do not know anyone named '+UserName[Port]+'.'); Ask('Are you new to this bulletin board? (y/N): ', GetName_3, 0); end else AreaSub(PasswordGood); end; Procedure DoGetName_3; {***************************************************************************} var UserStr: string; begin UserStr := Reply; if Upcase(UserStr[1]) = 'Y' then AreaSub(Register) else begin VarPushInteger(VarPopInteger + 1); SayL(''); AreaSub(GetName_1); end; end; Procedure DoPrompt; {***************************************************************************} begin if UserMenu[Port] = 'ON' then MainMenu; SayL(''); if MailCheck(true) then SayL('You have E-MAIL, '+UserName[Port]+'.') else 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': begin SayL('No additional sections available.'); AreaPush(Pause); end; 'B': AreaPush(Bulletins); 'C': AreaPush(Comment); 'D': AreaPush(Statistics); 'E': AreaPush(Mail); 'F': AreaPush(XFilePrompt); 'G': AreaPush(LogOff); 'H': if UserMenu[Port] <> 'ON' then MainMenu; 'I': begin SayL('No information available at this time.'); AreaPush(Pause); end; else begin Say(#7); SayL('Option "'+Command[1]+'" not available at this time.'); AreaPush(Pause); 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 AreaSub(Disconnect) else AreaPop; end; Procedure DoDisconnect; {***************************************************************************} var alpha: integer; begin Echo[Port] := false; SessInStr[Port] := ''; VarTextCloseAll(Port); DateTimeLogOut[Port] := Infinity; if LoginOK[Port] then SayL('Goodbye, '+UserName[Port]+'!'); SayL('Disconnected.'); VarPushInteger(0); AreaSub(Disconnect_1); end; Procedure DoDisconnect_1; {***************************************************************************} var alpha: integer; ClearAttempts: integer; begin ClearAttempts := VarPopInteger; if (ClearAttempts = 256) or OutputClear(Port) then begin AreaSub(Disconnect_2); AreaPush(HangUp); end else VarPushInteger(ClearAttempts + 1); end; Procedure DoDisconnect_2; {***************************************************************************} begin if LoginOK[Port] then UserData.Update; InitSessionVariables(Port); end; Procedure DoBulletins; {***************************************************************************} begin BullAreaID[Port] := 0; BullAreaDir[Port] := 0; BullAreaSubj[Port] := BullTopSubjectStr; AreaSub(BullPrompt); end; Procedure DoBullDel; {***************************************************************************} begin AreaSub(BullDel_1); AreaPush(BullPickedBull); end; Procedure DoBullDel_1; {***************************************************************************} var BullSABFileStr: string; DeadBull: integer; DeadBullFile: string; alpha: integer; Author: string; begin DeadBull := VarPopInteger; if DeadBull = 0 then begin AreaPop; exit; end; BullSABFileStr := BullSABFile(BullAreaDir[Port], BullAreaID[Port]); if not(FileLine('R', BullSABFileStr, DeadBull + 1, DeadBullFile)) then begin SayL('Bulletin would not open! Contact BBS Manager.'); AreaPop; exit; end; DeadBullFile := UsersDir + '\' + DeadBullFile; if not(BullHeaderAuthor(DeadBullFile, Author)) then begin ErrSayL('Error: ' + DeadBullFile + ' failed to open!'); AreaPop; exit; end; if UserName[Port] <> Author then begin SayL('You are not the author of this bulletin.'); if not(PrivCheck(true, BullKillPriv)) then begin AreaSub(Pause); exit; end; end; if FileLine('D', BullSABFileStr, DeadBull + 1, DumStr) then SayL('Bulletin deleted.') else SayL(#7 + 'Bulletin was NOT deleted.'); AreaPop; end; Procedure DoBullEdit; {***************************************************************************} var Author: string; BullPicked: integer; BullIDStr: string; begin BullPicked := VarPopInteger; AreaPop; if not(BullFile(BullAreaDir[Port], BullAreaID[Port], BullPicked, BullIDStr)) then exit; if not(BullHeaderAuthor(BullIDStr, Author)) then begin ErrSayL('Error: ' + BullIDStr + ' failed to open!'); AreaPop; exit; end; if UserName[Port] <> Author then begin SayL('You are not the author of this bulletin.'); if not(PrivCheck(true, BullEditPriv)) then begin AreaPush(Pause); exit; end; end; VarPushStr(BullIDStr); AreaPush(EditPrompt); end; Procedure DoBullNext; {***************************************************************************} begin if not(PrivCheck(true, BullReadPriv)) then begin AreaPush(Pause); exit; end; if FileCreate(UserDir(UserID[Port]) + '\' + Bull.NextSubjFile) then begin SayL('Searching '+DropBlanksEnd(BullAreaSubj[Port])+'...'); AreaSub(BullNext_1); end else AreaPop; end; Procedure DoBullNext_1; {***************************************************************************} var BullID: integer; BullIDStr: string; BullReadBool: boolean; BullSABFileStr: string; BullToRead: W10k; Done: boolean; GetNextSubjArea: boolean; WasRead: boolean; begin BullToRead := 1; Done := false; repeat BullSABFileStr := BullSABFile(BullAreaDir[Port], BullAreaID[Port]); GetNextSubjArea := false; if not(FileExists(BullSABFileStr)) then GetNextSubjArea := true; if not(GetNextSubjArea) and Disk.LineRead(BullSABFile(BullAreaDir[Port], BullAreaID[Port]), BullToRead + 1, BullIDStr) then begin BullID := IntStr(copy(BullIDStr, length(BullIDStr)-7, 4)); BullIDStr := UsersDir + '\' + BullIDStr; WasRead := FileDataBool('R', BullReadFile, BullID-1, BullReadBool); if not(WasRead) or (WasRead and not(BullReadBool)) then begin BullReadMark(BullID); VarPushStr(BullIDStr); VarPushInteger(0); {* # of lines before-hand *} VarPushInteger(LinesPerPage[Port]); AreaSub(FileShow); exit; end; end else GetNextSubjArea := true; if GetNextSubjArea then begin if not(Bull.SubjAreaMarkNext) then begin SayL('All bulletins in subject areas that were not shut have' + ' been read.'); Done := true; AreaSub(Pause); end else begin BullToRead := 0; SayL('Searching '+DropBlanksEnd(BullAreaSubj[Port])+'...'); end; end; inc(BullToRead); until Done; end; Procedure DoBullPickedBull; {***************************************************************************} var BullCount, StartBull: integer; begin BullCount := BullCountBulls(BullAreaID[Port]); if BullCount > 0 then begin VarPushInteger(BullCount); StartBull := BullCount - LinesPerPage[Port] + 2; if StartBull < 1 then StartBull := 1; VarPushInteger(StartBull); {* if BullCount > LinesPerPage[Port] then *} Ask('First bulletin to list ['+StrInt(StartBull)+']: ', BullPickedBull_1, 4) {* else AreaSub(BullPickedBull_1); *} end else begin SayL(Beep+'There are no bulletins at this subject area level.'); AreaSub(Pause); VarPushInteger(0); end; end; Procedure DoBullPickedBull_1; {***************************************************************************} var StartBullStr: string; StartBull, StopBull: integer; begin StartBull := VarPopInteger; StopBull := VarPeekInteger; if StopBull > LinesPerPage[Port] then begin StartBullStr := Reply; if StartBullStr <> '' then StartBull := IntStr(StartBullStr); if StopBull > StartBull + LinesPerPage[Port] - 2 then StopBull := StartBull + LinesPerPage[Port] - 2; end; DumInt := BullListBulls(StartBull, StopBull); Ask('Which bulletin? [ENTER to cancel]: ', BullPickedBull_2, 4); end; Procedure DoBullPickedBull_2; {***************************************************************************} var Count: integer; Picked: integer; InStr: string; begin Count := VarPopInteger; InStr := Reply; if InStr = '' then begin VarPushInteger(0); AreaPop; exit; end; Picked := IntStr(InStr); if (Picked <= 0) or (Picked > Count) then begin AreaSub(BullPickedBull); exit; end; VarPushInteger(Picked); AreaPop; end; Procedure DoBullPickedChild; {***************************************************************************} var Count: integer; begin if not(BullCountChildren(BullAreaID[Port]) > 0) then begin VarPushInteger(-1); AreaPop; exit; end; Count := BullListChildren(BullAreaDir[Port], BullAreaID[Port]); VarPushInteger(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 := VarPopInteger; InStr := Reply; Picked := IntStr(InStr); if (Picked <= 0) or (Picked > Count) then begin VarPushInteger(0); AreaPop; exit; end; VarPushInteger(Picked); AreaPop; end; Procedure DoBullPickedParent; {***************************************************************************} var Count: integer; begin if BullCountParents(BullAreaID[Port]) <= 0 then begin AreaPop; exit; end; Count := BullListParents(BullAreaDir[Port], BullAreaID[Port]); VarPushInteger(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 := VarPopInteger; 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; VarPushInteger(Picked); AreaPop; 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, BullSABFileStr: string; BF: text; TopLine: string; begin BullFileName := BullNextBulletin; BullSABFileStr := BullSABFile(BullAreaDir[Port], BullAreaID[Port]); TopLine := Bull.SABFileTopLine; if not(FileExists(BullSABFileStr)) then if FileCreate(BullSABFileStr) then DumBool := FileLine('O', BullSABFileStr, 1, TopLine); if not(Disk.LineAppend(BullSABFileStr, BullFileName)) then begin AreaSub(Pause); exit; end; if FileOpen('W', UsersDir + '\' + BullFileName, BF) = 0 then begin writeln(BF, 'Subject: ', Reply); writeln(BF, 'Author : ', UserName[Port]); writeln(BF, 'Date : ', DateTimeStrNow); writeln(BF, 'Expires: '); writeln(BF, MultiChar('-',78)); Close(BF); VarPushStr(UsersDir + '\' + BullFileName); AreaSub(EditAppend); end else AreaPop; end; Procedure DoBullPrompt; {***************************************************************************} begin if UserMenu[Port] = 'ON' then BullMenu; SayL(''); SayL('Subject Area: '+BullAreaSubj[Port]); SayL(StrInt(BullCountParents(BullAreaID[Port])) +' subject area(s) above, ' + StrInt(BullCountChildren(BullAreaID[Port]))+' subject area(s) below, ' + StrInt(BullCountBulls(BullAreaID[Port])) +' 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; ; SayL(''); if InStr = '' then exit; UserOpt := upcase(InStr[1]); case UserOpt of 'A': AreaPush(BullSubMake); 'C': AreaPush(Comment); 'D': AreaPush(BullSubDown); 'E': begin AreaPush(BullEdit); AreaPush(BullPickedBull); end; 'G': AreaPush(Logoff); 'H': if UserMenu[Port] <> 'ON' then BullMenu; 'K': begin AreaPush(Pause); AreaPush(BullSubCon); end; 'N': AreaPush(BullNext); 'S': begin AreaPush(BullSubOpen); AreaPush(BullPickedChild); end; 'P': AreaPush(BullPost); 'Q': AreaPop; 'R': AreaPush(BullRead); 'B': begin AreaPush(Pause); AreaPush(BullSubKill); end; 'T': begin AreaPush(Pause); AreaPush(BullDel); end; 'U': AreaPush(BullSubUp); else begin SayL(Beep+'Option "'+UserOpt+'" not available at this time.'); AreaPush(Pause); end; end; {case} end; Procedure DoBullRead; {***************************************************************************} begin if not(PrivCheck(true, BullReadPriv)) then begin AreaPop; exit; end; AreaSub(BullRead_1); AreaPush(BullPickedBull); end; Procedure DoBullRead_1; {***************************************************************************} var BullPicked: integer; BullIDStr: string; BullSABFileStr: string; begin AreaPop; BullPicked := VarPopInteger; ; if BullPicked = 0 then exit; if BullFile(BullAreaDir[Port], BullAreaID[Port], BullPicked, BullIDStr) then begin BullReadMark(BullID(BullIDStr)); VarPushStr(BullIDStr); VarPushInteger(0); {* # of lines before-hand *} VarPushInteger(LinesPerPage[Port]); AreaPush(FileShow); end; 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 DoBullSubDown; {***************************************************************************} begin if BullCountChildren(BullAreaID[Port]) = 1 then begin BullSwitchSubjectArea(1); AreaPop; exit; end; AreaSub(BullSubDown_1); AreaPush(BullPickedChild); end; Procedure DoBullSubDown_1; {***************************************************************************} var BSD: Integer; begin AreaPop; BSD := VarPopInteger; if BSD = -1 then begin SayL(Beep + 'There are no subject areas below this one.'); AreaPush(Pause); end else if BSD > 0 then BullSwitchSubjectArea(BSD); 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 BullSABFileStr: string; NewSubjectArea: W10k; Subject: string; begin Subject := Reply; NewSubjectArea := BullNextSubjectArea; if Subject = '' then begin AreaPop; exit; end; if not(BullSAConnect(BullSAPFile(UserID[Port], NewSubjectArea), BullSACFile(BullAreaDir[Port], BullAreaID[Port]) )) then begin ErrSayL(#7 + 'ERROR: Unable to add the subject area!'); AreaSub(Pause); exit; end; BullSABFileStr := BullSABFile(UserID[Port], NewSubjectArea); if FileCreate(BullSABFileStr) then DumBool := Disk.LineAppend(BullSABFileStr, StrSized(Subject, BSALen)); 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 := FileLine('D', BullSACFile(BullAreaDir[Port], BullAreaID[Port]), VarPopInteger + 1, DumStr); AreaPop; end; Procedure DoBullSubOpen; {***************************************************************************} var BullFileStr: string; Flipped: integer; begin Flipped := VarPopInteger; AreaPop; DumBool := Bull.SubjAreaFlip(BullAreaDir[Port], BullAreaID[Port], Flipped); end; Procedure DoBullSubUp; {***************************************************************************} begin if BullAreaID[Port] = 0 then begin SayL(#7 + 'You are already at the top level.'); AreaSub(Pause); exit; end; if BullCountParents(BullAreaID[Port]) = 1 then begin BullSwitchSubjectArea(-1); AreaPop; exit; end; AreaSub(BullSubUp_1); AreaPush(BullPickedParent); end; Procedure DoBullSubUp_1; {***************************************************************************} begin BullSwitchSubjectArea(-VarPopInteger); AreaPop; end; Procedure DoCallBack; {***************************************************************************} var Phone: string; begin if not(UserData.GetPhone(Phone)) then begin AreaSub(Prompt); exit; end; Phone := StrPhone(Phone); Ask('Do you want this Wyrm BBS to call you back right now at ' +Phone+' (Y/n)?: ', CallBack_1, 1); end; Procedure DoCallBack_1; {***************************************************************************} var YesStr: string; begin YesStr := Reply; if upcase(YesStr[1]) = 'N' then AreaPop else begin SayL('Please give your modem the automatic answer command "ATA".'); VarPushInteger(0); AreaSub(CallBack_2); end; end; Procedure DoCallBack_2; {***************************************************************************} var alpha: integer; ClearAttempts: integer; begin ClearAttempts := VarPopInteger; if Echo[Port] or (DateTimeLogOut[Port] <> Infinity) then begin Echo[Port] := false; SessInStr[Port] := ''; DateTimeLogOut[Port] := Infinity; SayL('Goodbye, '+UserName[Port]+'!'); SayL('Disconnected.'); end; if (ClearAttempts = 256) or OutputClear(Port) then begin AreaSub(CallBack_3); AreaPush(HangUp); end else VarPushInteger(ClearAttempts + 1); end; Procedure DoCallBack_3; {***************************************************************************} begin UserData.Update; AreaPop; AreaSub(CallBack_4); DateTimeLogOut[Port] := JulianDateTimeNow + CallBackTime; IsCallBack[Port] := true; end; Procedure DoCallBack_4; {***************************************************************************} var Phone: string; begin if not(UserData.GetPhone(Phone)) then begin AreaSub(Disconnect); exit; end; SessInStr[Port] := ''; Delay(ModemDelay); SayL('ATDT'+Phone); AreaSub(WaitConnect); end; Procedure DoComment; {***************************************************************************} var alpha: integer; EFile: string; begin SayL(''); SayL('Paging the System Operator (SYSOP)...'); for alpha := 1 to 6 do Say(#7); SayL('Please enter your comment, '+UserName[Port]+'.'); SayL('The SYSOP will interrupt eventually if available.'); Ask('Subject [ENTER = cancel]: ', Comment_1, 0); end; Procedure DoComment_1; {***************************************************************************} var SubjectStr: string; EFile: string; EM: text; begin SubjectStr := Reply; if SubjectStr = '' then begin AreaPop; exit; end; EFile := MailNext; if DirExists(UserDir(0)) then if FileOpen('A', UserDir(0) + '\' + MailBox, EM) = 0 then begin writeln(EM, UserName[Port]); writeln(EM, SubjectStr); writeln(EM, EFile); close(EM); end; VarPushStr(EFile); AreaSub(EditAppend); end; Procedure DoEditAppend; {***************************************************************************} {* pops the file name {***************************************************************************} var FileStr: string; BlankCount: Integer; begin FileStr := VarPopStr; Inc(VarTextTOS[Port]); if FileOpen('A', FileStr, VarText[Port, VarTextTOS[Port]]) = 0 then begin WordWrap[Port] := true; SayL('Enter two blank lines to quit and save.'); SayL(MultiChar('-', LineLen)); AreaSub(EditAppend_1); BlankCount := 0; VarPushInteger(BlankCount); Ask('', EditAppend_1, 0); end else begin ErrSayL('File "'+FileStr+'" would not open for writing!!!'); AreaPop; end; end; Procedure DoEditAppend_1; {***************************************************************************} var InStr: string; BlankCount: Integer; begin BlankCount := VarPopInteger; InStr := Reply; if InStr = '' then Inc(BlankCount); if BlankCount = 0 then writeln(VarText[Port, VarTextTOS[Port]], InStr); if BlankCount = 1 then if InStr <> '' then begin BlankCount := 0; writeln(VarText[Port, VarTextTOS[Port]]); writeln(VarText[Port, VarTextTOS[Port]], InStr); end; VarPushInteger(BlankCount); if BlankCount = 2 then begin DumInt := VarPopInteger; Close(VarText[Port,VarTextTOS[Port]]); Dec(VarTextTOS[Port]); WordWrap[Port] := false; AreaPop; end else Ask('', EditAppend_1, 0); end; Procedure DoEditDelete; {***************************************************************************} begin Ask('Please enter the number of the line to delete [ENTER = cancel]: ', EditDelete_1, 0); end; Procedure DoEditDelete_1; {***************************************************************************} var DeadLine, LineStr: string; begin DeadLine := Reply; if DeadLine = '' then begin AreaPop; exit; end; if FileLine('R', VarPeekStr, IntStr(DeadLine), LineStr) then begin SayL(LineStr); VarPushInteger(IntStr(DeadLine)); Ask('Delete this line (y/N): ', EditDelete_2, 1); end else begin SayL(''); SayL(Beep+'Error with the line number or file. Line NOT deleted.'); AreaSub(Pause); end; end; Procedure DoEditDelete_2; {***************************************************************************} var DeadLine: integer; LicenseToKill: string; begin AreaPop; LicenseToKill := Reply; DeadLine := VarPopInteger; if not((upcase(LicenseToKill[1]) = 'Y') and FileLine('D', VarPeekStr, DeadLine, DumStr)) then begin SayL(''); SayL('Line was NOT deleted.'); AreaPush(Pause); end; end; Procedure DoEditInsert; {***************************************************************************} begin Ask('Insert a new line before which line? [ENTER = cancel]: ', EditInsert_1, 0); end; Procedure DoEditInsert_1; {***************************************************************************} var Where: integer; begin Where := IntStr(Reply); if Where = 0 then begin AreaPop; exit; end; VarPushInteger(Where); SayL('Please enter the new line.'); Ask('', EditInsert_2, 0); end; Procedure DoEditInsert_2; {***************************************************************************} var NewLine: string; Where: integer; begin NewLine := Reply; Where := VarPopInteger; DumBool := FileLine('I', VarPeekStr, Where, NewLine); AreaPop; end; Procedure DoEditModify; {***************************************************************************} begin Ask('Please enter the number of the line to modify [ENTER = cancel]: ', EditModify_1, 0); end; Procedure DoEditModify_1; {***************************************************************************} var ModLine: integer; OldLine: string; begin ModLine := IntStr(Reply); if ModLine = 0 then begin AreaPop; exit; end; if FileLine('R', VarPeekStr, ModLine, OldLine) then begin VarPushInteger(ModLine); SayL(OldLine); SayL('Please enter the line again with changes.'); Ask('', EditModify_2, 0); end else AreaPop; end; Procedure DoEditModify_2; {***************************************************************************} var ModifiedLine: string; begin ModifiedLine := Reply; DumBool := FileLine('O', VarPeekStr, VarPopInteger, ModifiedLine); AreaPop; end; Procedure DoEditPrompt; {***************************************************************************} begin if UserMenu[Port] = 'ON' then EditMenu; SayL(''); SayL('Editing file "'+ VarPeekStr + '".'); ShowTimeLeft; Ask('EDITOR command prompt (type H for Help): ', EditPrompt_1, 1); end; Procedure DoEditPrompt_1; {***************************************************************************} var InStr: string; UserOpt: char; begin AreaSub(EditPrompt); InStr := Reply; ; SayL(''); if InStr = '' then exit; UserOpt := upcase(InStr[1]); case UserOpt of 'A': begin VarPushStr(VarPeekStr); AreaPush(EditAppend); end; 'C': AreaPush(Comment); 'D': AreaPush(EditDelete); 'G': AreaPush(Logoff); 'H': if UserMenu[Port] <> 'ON' then EditMenu; 'I': AreaPush(EditInsert); 'L': begin VarPushStr(VarPeekStr); VarPushInteger(0); VarPushInteger(-LinesPerPage[Port]); AreaPush(FileShow); end; 'M': AreaPush(EditModify); 'Q': begin AreaPop; DumStr := VarPopStr; end; 'S': begin VarPushStr(VarPeekStr); VarPushInteger(0); VarPushInteger(LinesPerPage[Port]); AreaPush(FileShow); end; else begin SayL(Beep+'Option "'+UserOpt+'" not available at this time.'); AreaPush(Pause); end; end; {case} end; Procedure DoFileShow; {***************************************************************************} {* pops an area {* pops a string : FileStr {* pops a Integer : LinesPerPage -- if negative, adds line #'s {* pops a Integer : Shortened {***************************************************************************} var FileStr: string; LinesPerPage, Shortened: Integer; TextNum: integer; begin FileStr := VarPopStr; LinesPerPage := VarPopInteger; Shortened := VarPopInteger; ; TextNum := VarPushText; if not(FileOpen('R', FileStr, VarText[Port, TextNum]) = 0) then begin SayL('Sorry, the file you wanted to read would not open.'); exit; end; SayL(MultiChar('-', 78)); VarPushInteger(Shortened + 1); VarPushInteger(LinesPerPage); AreaSub(FileShow_1); end; Procedure DoFileShow_1; {***************************************************************************} var LinesPerPage: integer; LineCount: integer; LineStr: string; TextNum: integer; WithLineNumbers: boolean; begin LinesPerPage := VarPopInteger; WithLineNumbers := LinesPerPage < 0; if WithLineNumbers then LinesPerPage := (-LinesPerPage) div 2; LineCount := VarPopInteger; TextNum := VarPeekTextNum; if not(EOF(VarText[Port, TextNum])) then begin readln(VarText[Port, TextNum], LineStr); if WithLineNumbers then SayL(StrInt(LineCount)); SayL(LineStr); inc(LineCount); if (LineCount + 1) mod LinesPerPage = 0 then AreaPush(Pause); VarPushInteger(LineCount); if WithLineNumbers then LinesPerPage := (-LinesPerPage)*2; VarPushInteger(LinesPerPage); end else begin Close(VarText[Port, TextNum]); DumInt := VarPopTextNum; SayL(MultiChar('-', 78)); AreaSub(Pause); end; end; Procedure DoHangUp; {***************************************************************************} begin if Port = 0 then begin AreaPop; exit; end; DelayBBS(2, HangUp_1); end; Procedure DoHangUp_1; {***************************************************************************} begin Say('+++'); DelayBBS(2, HangUp_2); end; Procedure DoHangUp_2; {***************************************************************************} begin Say('ATH0'+Enter); DelayBBS(4, HangUp_3); end; Procedure DoHangUp_3; {***************************************************************************} begin AreaPop; end; Procedure DoMail; {***************************************************************************} begin if UserMenu[Port] = 'ON' then MailMenu; SayL(''); DumBool := MailCheck(false); ShowTimeLeft; Ask('E-MAIL Command Prompt (H for Help Menu): ', Mail_1, 0); end; Procedure DoMail_1; {***************************************************************************} var InStr: string; Command: char; begin AreaSub(Mail); InStr := Reply; ; SayL(''); Command := upcase(InStr[1]); case Command of 'C': AreaPush(Comment); 'R': AreaPush(MailRead); 'S': AreaPush(MailSend); 'G': AreaPush(LogOff); 'H': if UserMenu[Port] <> 'ON' then MailMenu; 'Q': AreaPop; else SayL(Beep+'"'+Command+'" not available from this command prompt.'); end; {case} end; Procedure DoMailSend; {***************************************************************************} begin Ask('Subject [ENTER = cancel]: ', MailSend_1, 0); end; Procedure DoMailSend_1; {***************************************************************************} var SubjectStr: string; begin SubjectStr := Reply; if SubjectStr = '' then begin AreaPop; exit; end; VarPushStr(MailNext); VarPushStr(SubjectStr); Ask('To [ENTER = no more recipients]: ', MailSend_2, 0); end; Procedure DoMailSend_2; {***************************************************************************} var SubjectStr: string; InStr: string; ToUser: integer; ToUserStr: string; EM: text; EFile: string; begin SubjectStr := VarPopStr; EFile := VarPeekStr; InStr := Reply; ; if InStr = '' then begin AreaSub(EditAppend); exit; end; VarPushStr(SubjectStr); ToUser := UserFindID(InStr); ToUserStr := StrInt(ToUser); if ToUser = -1 then SayL(Beep+'I do not kPort "'+InStr+'".') else if DirExists(UserDir(ToUser)) then if FileOpen('A', UserDir(ToUser) + '\' + MailBox, EM) = 0 then begin writeln(EM, UserName[Port]); writeln(EM, SubjectStr); writeln(EM, EFile); close(EM); end; Ask('To [ENTER = no more recipients]: ', MailSend_2, 0); end; Procedure DoMailRead; {***************************************************************************} var Userbox: string; InStr: string; begin if not(MailCheck(false)) then begin AreaSub(Pause); exit; end; UserBox := UserDir(UserID[Port]) + '\' + MailBox; 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); VarPushInteger(0); VarPushInteger(LinesPerPage[Port]); VarPushStr(InStr); AreaSub(FileShow); end; end; Procedure DoMakePassword; {***************************************************************************} begin if UserID[Port] = 0 then begin SayL(Beep+'MANAGER cannot change the MANAGER PASSWORD.'); AreaPop; exit; end; SayL(''); 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[Port] := false; Ask('Password:', MakePassword_1, 0); end; Procedure DoMakePassword_1; {***************************************************************************} begin Password1 := Reply; if length(password1) < PassWordMinLen then begin SayL(''); SayL(Beep+'Your password must be at least '+StrInt(PassWordMinLen) + ' 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 SayL(''); SayL(Beep+'The second entry was not the same. Please re-enter the' + ' first again.'); AreaSub(MakePassword); exit; end; Echo[Port] := true; if not(FileExists(UserFile(UserID[Port]))) then DumBool := FileCreate(UserFile(UserID[Port])); if not(FileLine('O', UserFile(UserID[Port]), 1, password1)) then SayL(Beep+'Warning: password was not successfully saved to disk!'); AreaPop; end; Procedure DoModemSetup; {***************************************************************************} begin if Port = 0 then begin AreaSub(WaitConnect); exit; end; VarPushInteger(0); AreaSub(ModemSetup_1); AreaPush(HangUp); end; Procedure DoModemSetup_1; {***************************************************************************} var alpha: integer; ModCom: Integer; begin ModCom := VarPopInteger; if ModCom <> 0 then begin Monitor.Wr(Port, SessInStr[Port]); SessInStr[Port] := ''; end; case ModCom of 0: begin PutStr(Port, 'AT'); {* just to clear the air *} end; 1: PutStr(Port, 'AT&F'); {* initial factory configuration *} 2: PutStr(Port, 'ATQ0'); {* modem returns result codes *} 3: PutStr(Port, 'ATV1'); {* full result codes *} 4: PutStr(Port, 'ATE1'); {* modem echoes commands *} 5: PutStr(Port, 'ATF1'); {* full duplex *} 6: PutStr(Port, 'ATX4'); {* wait for dial tone, connect results, display BUSY *} 7: PutStr(Port, 'ATM0'); {* speaker off - ATM0 *} 8: PutStr(Port, 'ATS0=1'); {* answer on the first ring *} 9: begin ResetDateTime[Port] := JulianDateTimeNow + (15*60); AreaSub(WaitConnect); exit; end; end; {* case *} PutStr(Port, Enter); DelayBBS(1.5, ModemSetup_1); VarPushInteger(ModCom + 1); end; {***************************************************************************} {***************************************************************************} {***************************************************************************} begin end.