' $linesize:132 ' $title: 'RBBSSUB2.BAS 17.3A, Copyright 1986 - 90 by D. Thomas Mack' ' DA081003 ' Copyright 1990 by D. Thomas Mack, all rights reserved. ' Name ...............: RBBSSUB2.BAS ' First Released .....: February 11, 1990 ' Subsequent Releases.: August 26, 1990 ' Copyright ..........: 1986 - 1990 ' Purpose.............: The Remote Bulletin Board System for the IBM PC, ' RBBS-PC.BAS utilizes a lot of common subroutines. Those that do not ' require error trapping are incorporated within RBBSSUB 2-5 as ' separately callable subroutines in order to free up as much ' code as possible within the 64WasK code segment used by RBBS-PC.BAS. ' Parameters..........: Most parameters are passed via a COMMON statement. ' ' Subroutine Line Function of Subroutine ' Name Number ' Macro 1320 Check/execute macro ' AnswerIt 200 Answer the telephone when it rings ' ASCIICodes 129 Allow a CONFIG string to have any ASCII value ' BadChar 455 Check user name for invalid characters ' BadName 20235 Check for system crash attempt with bad file name ' Baud450 5507 Allow 300 baud callers to bump up to 450 baud ' CheckRatio 20096 Test upload/download ratio ' CheckMacro 1242 Checks for macro and processes ' CopyRight 97 Display RBBS-PC's copyright notice ' DEFALTU 9600 Write out the user's defaults ' DenyAccess 1386 Downgrade security so access denied ' DoorExit 10983 Set up a .BAT file to exit RBBS-PC to a "door" ' DosExit 10934 Set up a .BAT file to exit to DOS (second level) ' EditALine 2618 Edits a single line ' EditDef 120 Edit configuration parameters ' FileNameCheck 20240 Matches file name to a prefix & extension ' GetArc 20140 Handle request for verbose listing ' GetCommand 101 Get RBBS-PC's node id from command line ' GetTime 9140 Calculates callers elapsed time (hh,mm,ss) ' GoIdle 90 Release resources when waiting for keyboard input ' KillMsg 3952 Delete old or unnecessary messages ' Line25 945 Build and/or update line 25 of RBBS-PC's local screen ' LineEdit 3700 Edit a line while minimizing string space consumption ' LogError 13660 Log error message to CALLERS file ' LPrnt 1480 Subroutine to write to local display ' MLInit 8 Handle MultiLink initialization/de-initialization ' MsgProt 2055 Sets protection for a message ' MessageTo 2018 Sets who a message is to ' PageLen 5200 Change page length ' ParseIt 1637 Parses a string ' PassWrd 660 Verify user & message passwords ' PopCmdStack 1650 Get user input, 1st checking command stack ' PScrn 1483 Print to display ' QuickLPrnt 1482 Quickly writes count of blocks on file transfer ' QuickTPut 1478 Fast, but limited, "TPut" equivalent ' QuickTPut1 1478 Outputs short string following by CR LF ' RBBSExit 10992 RBBS-PC exit to transfer control to other programs ' RecoverMsg 10410 Recover a deleted message ' RemNonAlf 5100 Removes non-alpha characters from a string ' RingCaller 1636 Ring caller's bell and put message in emphasis ' SetBaud 1654 Set baud rate in the 8250 chip of the RS232 interface ' SetCrLf 1496 Set up the necessary carriage return/line feed string ' SetSection 12000 Set the proper section prompts (main, file, util, libr) ' SetThread 4554 Set up request for threading thru messages ' SkipLine 1485 Write a # of blank lines to the communications port ' SearchCmd 1238 Searches list of commands in RBBS for a request ' SecViolation 1380 Process a security violation ' SysMenu 112 Displays sysop menu/status ' SysopChat 4773 Sysop and caller chat ' TestRel 336 Tests for Reliable connect ' TGet 1498 Read a line from the communications port ' TPut 1396 Write a line to the communications port ' Trim 105 Strip leading and trailing blanks from a string ' TrimTrail 107 Strip off specified string off end of another string ' UntilRight 12878 Ask a question until user says answer is right ' UpdateU 10600 Updates the user record on loging off/exiting RBBS-PC ' VarInit 109 Initialize system variables ' ViewHelp 1330 Processes help command ' WhoCheck 2250 Checks whether a user exists in user file ' WhosOn 9801 Report status of each node - who's on ' WordInFile 10976 Find a whole word within a file/menu ' ' $INCLUDE: 'RBBS-VAR.BAS' ' 8 ' $SUBTITLE: 'MLInit - MultiLink initialization/deinitialization' ' $PAGE ' ' NAME -- MLInit ' ' INPUTS -- MLParm = 1 INITIALIZE AT STARTUP OR RE- ' CYLCE TIME ' MLParm = 2 DE-INITIALIZE ON EXITING TO ' A DOOR OR DOS REMOTELY ' MLParm = 3 DE-QUEUE COMMUNICATIONS PORTS ' MLParm = 4 CHECK FOR MULTILINK PRESENT ' ZDoorsTermType ' ZBaudTest! ' ZComPort$ ' ZComputerType ' ' OUTPUTS -- NONE ' ' PURPOSE -- To test for the presence of multi-link and set ' multi link options to be compatible with RBBS-PC ' SUB MLInit (MLParm) STATIC DEF SEG = 0 IF ZComputerType = 1 _ GOTO 10 IF NOT ZMLCom THEN _ IF ZNetworkType <> 1 THEN _ GOTO 10 ZMultiLinkPresent = PEEK(&H1FE) + 256 * PEEK(&H1FF) IF ZMultiLinkPresent = 0 THEN _ GOTO 10 ON MLParm GOSUB 30,20,60,10 10 DEF SEG EXIT SUB 20 IF ZDoorsTermType < 1 THEN _ RETURN DEF SEG = ZMultiLinkPresent GOSUB 60 ' ************** MLUTIL BAUD n (where n = ZBaudTest!) ****** WasAX = &H600 WasBX = ZBaudTest! ' Tell ML the baud rate GOSUB 80 ' ************** MLUTIL TERM n (where n = ZDoorsTermType) **** WasAX = &H700 + ZDoorsTermType GOSUB 80 ' Tell ML the terminal type ' ********* MLINK /port *********** ' ' Tell ML the communications port POKE (&H64 + PEEK(&H58) + 256 * PEEK(&H59) + &HC),ASC(RIGHT$(ZComPort$,1)) - 48 ' ************ MLUTIL SCMON ************* WasAX = &HB01 WasBX = 0 ' Tell ML to start monitoring the carrier GOSUB 80 RETURN ' ************** MLUTIL CCMON *************** 30 WasAX = &HB00 ' Turn off ML's carrier monitoring. WasBX = 0 GOSUB 80 ' ************** MLUTIL TERM 1 ************* WasAX = &H701 ' Change terminal type to ML type 1. WasBX = 0 GOSUB 80 ' ******* MLINK /port (where port = 9 if ML 3.03 or earlier ****** ' ******* port = 0 if ML 4.00 or greater ****** DEF SEG = ZMultiLinkPresent MultiLinkCommPort = (&H64 + PEEK(&H58) + 256 * PEEK(&H59) + &HC) MultiLinkVersion = PEEK(&H1) + 256 * PEEK(&H2) IF PEEK(MultiLinkCommPort) = &H1 OR _ PEEK(MultiLinkCommPort) = &H2 THEN _ IF MultiLinkVersion > 5000 THEN _ POKE (MultiLinkCommPort),&H0 _ ELSE POKE (MultiLinkCommPort),&H9 ' ********** MLUTIL ENQ ********** WasAX = &H1 ' Tell ML to conditional enque on the comm. port GOSUB 70 ' ********** MLUTIL BAUD 19200 ********* WasAX = &H600 ' Tell ML to reset the buad rate (19200 BAUD) WasBX = 19200 GOSUB 80 RETURN ' ********** MLUTIL DEQ ********* 60 WasAX = &H100 ' Tell ML to unconditionally deque the comm. port 70 WasBX = -4 IF ZComPort$ = "COM2" THEN _ WasBX = -3 IF ZComPort$ = "COM0" THEN _ RETURN ' ****** MULTI-LINK PROGRAMMING SUPPORT INTERFACE ******* 80 CALL RBBSML(WasAX,WasBX) RETURN END SUB 90 ' $SUBTITLE: 'GoIdle - release control when waiting' ' $PAGE ' ' NAME -- GoIdle ' ' INPUTS -- ZMLCom ' ZNetworkType ' ' OUTPUTS -- NONE ' ' PURPOSE -- To relinquish control when RBBS-PC is waiting for ' input from the communications port ' SUB GoIdle STATIC IF ZMLCom OR ZNetworkType = 1 THEN _ CALL MLInit(5) : _ EXIT SUB CALL GiveBack END SUB 97 ' $SUBTITLE: 'CopyRight - subroutine to display RBBS-PC copyright' ' $PAGE ' ' NAME -- CopyRight ' ' INPUTS -- NONE ' ' OUTPUTS -- NONE ' ' PURPOSE -- To display RBBS-PC's copyright notice on the local screen ' SUB CopyRight STATIC ZWasA = (ZRecycleToDos OR ZDebug OR ZNodeRecIndex > 2) IF ZWasA THEN _ EXIT SUB WIDTH 80 REDIM ZOutTxt$(11) ZOutTxt$(1) = "If you use RBBS-PC 17.3A, please consider contributing to" ' DA081003 ZOutTxt$(2) = "" ZOutTxt$(3) = " Capital PC Software Exchange" ZOutTxt$(4) = " Post Office Box 6128" ZOutTxt$(5) = " Silver Spring, Maryland 20906" ZOutTxt$(6) = "" ZOutTxt$(7) = "You are free to copy/share RBBS-PC 17.3A provided" ' DA081003 ZOutTxt$(08)= " 1. This program is distributed unmodified" ZOutTxt$(09)= " 2. No fee or consideration is charged for RBBS-PC itself" ZOutTxt$(10)= " 3. This notice is not bypassed or removed." CLS KEY OFF LOCATE ,,0 ZSnoop = -1 ZLocalUser = -1 CALL LPrnt(SPACE$(60) + "tm",1) CALL LPrnt(SPACE$(16) + STRING$(15,205) + " U S E R W A R E " + STRING$(15,205),1) CALL SkipLine(1) CALL LPrnt(SPACE$(17) + "Capital PC User Group User-Supported Software",1) CALL SkipLine (1) CALL LPrnt(SPACE$(5) + CHR$(214) + STRING$(66,196) + CHR$(183),1) FOR WasI = 1 TO 10 CALL LPrnt(SPACE$(5) + CHR$(186) + " " + ZOutTxt$(WasI) + SPACE$(62 - LEN(ZOutTxt$(WasI))) + CHR$(186),1) NEXT CALL LPrnt(SPACE$(5) + CHR$(211) + STRING$(66,196) + CHR$(189),1) CALL LPrnt(SPACE$(5) + "Copyright (c) 1983-90 Tom Mack, 39 Cranbury Drive, Trumbull, CT 06611",1) CALL DelayTime (8) ZSnoop = 0 END SUB 101 ' $SUBTITLE: 'GetCommand - sub to get command from command line' ' $PAGE ' ' NAME -- GetCommand ' ' INPUTS -- PARAMETER MEANING ' ZConfigFileName$ NAME OF RBBS-PC ".DEF" FILE TO ' USE AS A MODEL WHEN CREATING THE ' .DEF FILE NAME TO BE USED BY THIS ' COPY OF RBBS-PC. ' ' COMMAND LINE COMMAND LINE USED TO INVOKE ' RBBS-PC IN THE FORM: ' ' RBBS-PC.EXE x filename DEBUG /time /baud /reliable ' ' WHERE THE OPTIONAL PARAMETERS ARE: ' ' x IS THE NODE ID IN THE RANGE 1-9,0,A-Z ' filename IS THE FULLY QUALIFIED FILE NAME TO USE AS THE ".DEF" FILE ' DEBUG IS A DEBUGGING Switch ' /time IS THE TIME OF DAY FOR RBBS-PC TO RETURN TO THE CALLER ' /baud IS THE BAUD RATE OF THE CALLER IF RBBS-PC IS BEING SHELLED TO BY ' ANOTHER COMMUNICATIONS PROGRAM (THE COMMUNICATIONS PORT BEING ' USED IS ASSUMED TO BE THE ONE INPUTTED VIA THE RBBS-PC CONFIG ' PROGRAM ' /reliable IS IF RELIABLE MODE WAS DETECTED BY A HOST MAILER ' ' IF NO PARAMETERS ARE SUPPLIED, RBBS-PC ASSUMES THAT THE .DEF FILE NAME IS ' RBBS-PC.DEF AND THAT THE NODE IS NODE 1. ' ' OUTPUTS -- ZConfigFileName$ NAME OF RBBS-PC ".DEF" FILE FOR ' THIS COPY OF RBBS-PC TO USE ' ZNodeRecIndex RECORD NUMBER WITHIN THE ' MESSAGES FILE FOR THIS "NODE" ' (RANGE IS 2 TO 36) ' ' PURPOSE -- To get node id from command line and determine if rbbs ' is being run as a door ' SUB GetCommand (PassedDebug,NetTime$,ZNetBaud$,ZNetReliable$) STATIC STATIC ZDebug ' ' ' * GET NODE ID FROM COMMAND LINE ' ' WasPM$ = COMMAND$ CALL AllCaps(WasPM$) IF INSTR(WasPM$,"/") = 0 THEN _ GOTO 103 ' ' ' * PARSE THE COMMAND LINE FOR THREE POSITIONAL SWITCHES FOR NET MAIL ' ' CmdLine$ = MID$(WasPM$,INSTR(WasPM$,"/")) WasPM$ = LEFT$(WasPM$,INSTR(WasPM$,"/") - 1) ZWasA = 0 FOR WasX = 1 TO LEN(CmdLine$) IF MID$(CmdLine$,WasX,1) = "/" THEN _ ZWasA = ZWasA + 1 : _ ZSubDir$(ZWasA) = "" _ ELSE ZSubDir$(ZWasA) = ZSubDir$(ZWasA) + MID$(CmdLine$,WasX,1) NEXT NetTime$ = ZSubDir$(1) IF ZWasA > 1 THEN _ ZNetBaud$ = ZSubDir$(2) IF ZWasA > 2 THEN _ ZNetReliable$ = ZSubDir$(3) CALL Trim(NetTime$) CALL Trim(ZNetBaud$) CALL Trim(ZNetReliable$) 103 ZWasA = INSTR(WasPM$,"DEBUG") IF ZWasA > 0 THEN _ ZDebug = -1 : _ WasPM$ = LEFT$(WasPM$,ZWasA - 1) + _ RIGHT$(WasPM$,LEN(WasPM$) - ZWasA - 4) PassedDebug = ZDebug ZWasA = INSTR(WasPM$,"LOCAL") IF ZWasA > 0 THEN _ ZComPort$ = "COM0" : _ WasPM$ = LEFT$(WasPM$,ZWasA - 1) + _ RIGHT$(WasPM$,LEN(WasPM$) - ZWasA - 4) IF LEN(WasPM$) = 0 THEN _ WasPM$ = "-" ZNodeRecIndex = INSTR("-1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ",LEFT$(WasPM$,1)) IF ZNodeRecIndex < 2 THEN _ ZNodeRecIndex = 2 ZNodeID$ = MID$(STR$(ZNodeRecIndex-1),2) IF ZNodeRecIndex > 10 THEN _ ZNodeFileID$ = LEFT$(WasPM$,1) _ ELSE ZNodeFileID$ = ZNodeID$ IF ZNodeID$ <> "1" THEN _ ZLibNodeID$ = ZNodeFileID$ IF LEN(WasPM$) > 2 AND MID$(WasPM$,2,1) = " " THEN _ ZConfigFileName$ = MID$(WasPM$,3)_ ELSE MID$(ZConfigFileName$,5,1) = WasPM$ ZOrigCnfg$ = ZConfigFileName$ END SUB 105 ' $SUBTITLE: 'Trim - sub to eliminate leading/trailing blanks' ' $PAGE ' ' NAME -- Trim ' ' INPUTS -- PARAMETER MEANING ' TrimParm$ STRING THAT IS TO HAVE LEADING ' AND TRAILING BLANKS ELIMINATED FROM ' ' OUTPUTS -- TrimParm$ STRING WITH NO LEADING OR TRAILING ' BLANKS ' ' PURPOSE -- To strip leading and trailing blanks ' SUB Trim (TrimParm$) STATIC WasL = INSTR(TrimParm$," ") IF WasL < 1 THEN _ EXIT SUB IF WasL = 1 THEN _ WHILE LEFT$(TrimParm$,1) = " " : _ TrimParm$ = RIGHT$(TrimParm$,LEN(TrimParm$) - 1) : _ WEND CALL TrimTrail (TrimParm$," ") END SUB ' 107 ' $SUBTITLE: 'TrimTrail - sub to trim off trailing characters' ' $PAGE ' ' NAME -- TrimTrail ' ' INPUTS -- PARAMETER MEANING ' TrimParm$ WHAT STRING TO Trim FROM ' TrimThis$ WHAT CHARACTER TO Trim OFF END ' ' OUTPUTS -- NONE ' ' PURPOSE -- To remove all occurences of a character from end of string ' SUB TrimTrail (TrimParm$,TrimThis$) STATIC IF RIGHT$(TrimParm$, 1) <> TrimThis$ THEN _ EXIT SUB WasJ = LEN(TrimParm$) - 1 108 IF WasJ > 0 THEN _ IF MID$(TrimParm$, WasJ, 1) = TrimThis$ THEN _ WasJ = WasJ - 1 : _ GOTO 108 TrimParm$ = LEFT$(TrimParm$, WasJ) END SUB ' 109 ' $SUBTITLE: 'VarInit - subroutine to initialize system variables' ' $PAGE ' ' NAME -- VarInit ' ' INPUTS -- PARAMETER MEANING ' NONE ' ' OUTPUTS -- NONE ' ' PURPOSE -- To initialize system variable ' SUB VarInit STATIC ZAcknowledge$ = CHR$(6) ZAckChar$ = "C" + _ ZAcknowledge$ ZActiveMenu$ = "B" ZActiveMessage$ = CHR$(225) ZBackSpace$ = CHR$(8) + _ CHR$(32) + _ CHR$(8) ZBackArrow$ = CHR$(29) + _ CHR$(32) + _ CHR$(29) ZBaudRates$ = " 300 450 1200 2400 4800 96001920038400" ZBellRinger$ = CHR$(7) ZBulletinMenu$ = "" ZWasCL = 24 ZCancel$ = CHR$(24) ZColorReset$ = CHR$(27) + _ "[00;37;40m" ZConfigFileName$ = "RBBS-PC.DEF" ZCarriageReturn$ = CHR$(13) ZDeletedMsg$ = CHR$(226) ZDosVersion = 2 ZEndTransmission$ = CHR$(4) ZEscape$ = CHR$(27) ZExpectActiveModem = 0 ZFalse = 0 ZF1Key = 59 ZF10Key = 68 ZConfName$ = "MAIN" CALL SetHiLite (ZTrue) ZHomeConf$ = "" ZInConfMenu = -1 ZLastCommand$ = "M " ZLimitMinsPerSession = 0 ZLineFeed$ = CHR$(10) ZLineFeeds = NOT ZFalse ZLineEditChk$ = CHR$(9) + _ ZLineFeed$ + _ CHR$(11) + _ CHR$(12) + _ CHR$(127) + _ CHR$(8) + _ ZBellRinger$ + _ CHR$(26) + _ CHR$(227) ZLineMes$ = SPACE$(78) ' fixed length string workspace ZLockStatus$ = "UM UU UB UD" ZMenuIndex = 2 ZNAK$ = CHR$(21) ZNoAdvance = ZFalse ZPageLength = 23 ZParseOff = ZFalse ZPressEnter$ = " (Press [ENTER] to quit)" ZPressEnterExpert$ = " ([ENTER] quits)" ZPressEnterNovice$ = ZPressEnter$ ZPrivateDoor = ZFalse ZRightMargin = 72 ZReturnLineFeed$ = ZCarriageReturn$ + _ ZLineFeed$ ZSmartTable$ = "CS PB NS FN LN SL DT TM TR TE TL RP RR CT " + _ "C1 C2 C3 C4 C0 DD BD DB UB DL UL FI VY VN " + _ "TY TN BN ND FS LS" ZStartOfHeader$ = CHR$(1) ZTimeLoggedOn$ = SPACE$(8) ZTrue = NOT ZFalse ZUpInc = -1 ZXOff$ = CHR$(19) ZXOn$ = CHR$(17) ZInterrupOn$ = CHR$(11) + ZCancel$ + ZXOff$ + ZXOn$ + ZCarriageReturn$ ZOptionEnd$ = ZReturnLineFeed$ + " ,(" ZCrLf$ = ZCarriageReturn$ + ZLineFeed$ ZWasLG$(1) = "Registration Check Failed" ZWasLG$(2) = "Sysop name attempted" ZWasLG$(3) = "Locked out attempt" ZWasLG$(4) = "Password Attempt Failed" ZWasLG$(5) = "Auto Lockout done" ZWasLG$(6) = "Name in use on another Node!" ZWasLG$(7) = "" ZWasLG$(8) = "Locked reason read!" ZWasLG$(9) = "Expired Registration" END SUB ' 112 ' $SUBTITLE: 'SysMenu - sub to display RBBS-PC SYSOP menu' ' $PAGE ' ' NAME -- SysMenu ' ' INPUTS -- PARAMETER MEANING ' ' OUTPUTS -- NONE ' ' PURPOSE -- TO DISPLAY RBBS-PC's SYSOP MENU ON THE LOCAL SCREEN ' SUB SysMenu STATIC ZLocalUser = ZTrue ZSnoop = ZTrue ZNonStop = ZTrue CALL CheckTime (TIMER, ZDelay!, 1) CLS ZStopInterrupts = ZTrue ZBypassTimeCheck = ZTrue CALL BufFile ("MENU0",WasX) ZNonStop = ZFalse ZBypassTimeCheck = ZFalse ZLocalUser = ZFalse IF NOT ZOK THEN _ CALL LPrnt("MENU0 not on default drive",1) LOCATE 2,18 CALL LPrnt(LEFT$(ZVersionID$,8),0) LOCATE 2,42 CALL LPrnt(ZNodeID$,0) LOCATE 2,60 WasX$ = DATE$ CALL LPrnt(LEFT$(WasX$,6) + RIGHT$(WasX$,2),0) LOCATE 2,74 CALL LPrnt(LEFT$(TIME$,5),0) IF ZFMSDirectory$ <> "" THEN _ LOCATE 6,76 : _ CALL LPrnt("YES",0) IF ZExtendedLogging THEN _ LOCATE 8,76 : _ CALL LPrnt("YES",0) IF ZFossil THEN _ LOCATE 10,76 : _ CALL LPrnt("YES",0) LOCATE 12,75 : _ CALL LPrnt(ZComPort$,0) LOCATE 14,75 CALL LPrnt (STR$(CINT(FRE("A")/1024)) + "k",0) IF ZDebug THEN _ LOCATE 22,76 : _ CALL LPrnt("Yes",0) END SUB ' 120 ' $SUBTITLE: 'EditDef - sub to edit config parameters' ' $PAGE ' ' NAME -- EditDef ' ' INPUTS -- PARAMETER MEANING ' ' OUTPUTS -- OUTPUT STRING ' ' PURPOSE -- Interpretes and adjusts stored configuration parameters ' SUB EditDef STATIC ZAllOpts$ = ZMainCmds$ + _ ZFileCmd$ + _ ZUtilCmds$ + _ ZLibCmds$ + _ ZGlobalCmnds$ + _ ZSysopCmds$ ZHelpExtension$ = "." + _ ZHelpExtension$ ZCompressedExt$ = ZDefaultExtension$ ZWasQ = INSTR(ZDefaultExtension$,".") IF ZWasQ > 0 THEN _ ZDefaultExtension$ = LEFT$(ZDefaultExtension$, ZWasQ-1) ZCurDirPath$ = ZDirPath$ ZBegMain = 1 ZBegFile = LEN(ZMainCmds$) + ZBegMain ZBegUtil = LEN(ZFileCmd$) + ZBegFile ZBegLibrary = LEN(ZUtilCmds$) + ZBegUtil ZHelp$(3) = ZHelpPath$ + _ ZHelp$(3) ZHelp$(4) = ZHelpPath$ + _ ZHelp$(4) ZHelp$(7) = ZHelpPath$ + _ ZHelp$(7) ZHelp$(9) = ZHelpPath$ + _ ZHelp$(9) CALL BreakFileName (ZWelcomeFile$,ZWelcomeFileDrvPath$,Prefix$,_ Extension$,ZTrue) CALL ASCIICodes ("[","]",ZDefaultLineACK$) CALL ASCIICodes ("[","]",ZHostEchoOn$) CALL ASCIICodes ("[","]",ZHostEchoOff$) CALL ASCIICodes ("[","]",ZEmphasizeOffDef$) CALL ASCIICodes ("[","]",ZEmphasizeOnDef$) ZDR1$ = ZFG1Def$ ZDR2$ = ZFG2Def$ ZDR3$ = ZFG3Def$ ZDR4$ = ZFG4Def$ IF ZSubParm = -62 THEN _ EXIT SUB ZLocalUserMode = (RIGHT$(ZComPort$,1) < "1") IF ZLocalUserMode THEN _ ZRecycleToDos = ZTrue ZEchoer$ = ZDefaultEchoer$ IF LEN(ZScreenOutMsg$) < 2 THEN _ ZScreenOutMsg$ = ZStartOfHeader$ ZSmartTextCode$ = CHR$(ZSmartTextCode) IF ZMaxWorkVar < 13 THEN _ ZMaxWorkVar = 13 ' ' *** ESTABLISH RBBS-PC'S DOS SUBDIRECTORIES USAGE *** ' IF ZMainFMSDir$ <> "" THEN _ ZFMSDirectory$ = ZDirPath$ + _ ZMainFMSDir$ + _ "." + _ ZMainDirExtension$ : _ ZActiveFMSDir$ = ZFMSDirectory$ : _ ZLibDir$ = ZLibDirPath$ + _ ZMainFMSDir$ + _ "." + _ ZLibDirExtension$ ZUpcatHelp$ = ZHelpPath$ + _ ZUpcatHelp$ + _ ZHelpExtension$ IF ZSubDirCount < 1 THEN _ GOTO 123 FOR ZSubDirIndex = 1 TO ZSubDirCount INPUT #2,ZSubDir$ IF RIGHT$(ZSubDir$,1) <> "\" THEN _ ZSubDir$(ZSubDirIndex) = ZSubDir$ + _ "\" _ ELSE ZSubDir$(ZSubDirIndex) = ZSubDir$ NEXT GOTO 125 123 FOR ZSubDirIndex = 1 TO LEN(ZDnldDrives$) - 1 ZSubDir$(ZSubDirIndex) = MID$(ZDnldDrives$,ZSubDirIndex,1) + _ ":" NEXT ZSubDirCount = LEN(ZDnldDrives$) - 1 ' ' ***** SETUP UPLOAD DRIVE AND DIRECTORY.NAME *** ' 125 ZUpldDirCheck$ = ZUpldDir$ ZSubDirCount = ZSubDirCount + 1 IF ZUpldToSubdir THEN _ ZSubDir$(ZSubDirCount) = ZUpldSubdir$ + _ "\" _ ELSE ZSubDir$(ZSubDirCount) = RIGHT$(ZDnldDrives$,1) + _ ":" ZUpldDir$ = ZUpldDir$ + _ "." + _ ZMainDirExtension$ CALL SearchArray (ZSubDir$(ZSubDirCount),ZSubDir$(),ZSubDirCount-1,Found) ZCanDnldFromUp = (Found > 0) ZUpldDir$ = ZUpldPath$ + _ ZUpldDir$ 126 CLOSE #2 IF ZLibDrive$ <> "" THEN _ ZLibType = 1 ZSubParm = -10 CALL Carrier IF ZSubParm = -1 THEN _ IF ZLibDrive$ <> "" THEN _ CALL ChangeDir (ZLibDrive$ + _ "\") : _ CALL KillWork (ZLibWorkDiskPath$ + _ ZLibNodeID$ + _ "DK*.ARC") : _ ZErrCode = 0 ' ' *** INITIALIZE OMNINET INTERFACE IF OMNINET IN USE *** ' 128 IF ZNetworkType = 2 THEN _ ZWasCN$ = SPACE$(535) : _ CALL InitIO(ZWasA) END SUB ' 129 ' $SUBTITLE: 'ASCIICodes - subrotuine to allow any ASCII codes' ' $PAGE ' ' NAME -- ASCIICodes ' ' INPUTS -- PARAMETER MEANING ' LeftParen$ MARKS BEGINNING OF # ' RightParen$ MARKS END OF # ' Strng$ INPUT STRING ' ' OUTPUTS -- Strng$ OUTPUT STRING ' ' PURPOSE -- To allow a config string to have any ascii values. ' characters not enclosed taken as is. Enclosed ' characters interpreted as value of ascii code. ' (e.g. "123[32]4" is interpreted as "123 4"). ' SUB ASCIICodes (LeftParen$,RightParen$,Strng$) STATIC IF LEN(Strng$) < 1 THEN _ EXIT SUB Start = 1 WasL = LEN(Strng$) ZUserIn$ = Strng$ + _ LeftParen$ WasX = INSTR(ZUserIn$,LeftParen$) NewString$ = "" WHILE Start <= WasL NewString$ = NewString$ + _ MID$(ZUserIn$,Start,WasX - Start) WasY = INSTR(WasX,ZUserIn$,RightParen$) IF WasY > 0 THEN _ WasK = VAL(MID$(ZUserIn$,WasX + 1,WasY - WasX - 1)) : _ NewString$ = NewString$ + _ CHR$(WasK) : _ Start = WasY + 1 _ ELSE NewString$ = NewString$ + _ MID$(ZUserIn$,WasX,WasL + 1 - WasX) : _ Start = WasL + 1 WasX = INSTR(Start,ZUserIn$,LeftParen$) WEND Strng$ = NewString$ END SUB 200 ' $SUBTITLE: 'AnswerIt - sub to establish connection' ' $PAGE ' ' NAME -- AnswerIt ' ' INPUTS -- PARAMETER MEANING ' ZSubParm = 1 WAIT FOR PHONE TO RING ' = 2 CONTINUE LOOKING FOR CONNECT ' = 3 RENTRY AFTER FUNCTION KEY ' = 4 GO ON LINE IMMEDIATELY ' ZBG LOCAL DISPLAY'S BACKGROUND ' ZBorder LOCAL DISPLAY'S BORDER COLOR ' ZComPort$ COMMUNICATIONS PORT NAME ' ZComputerType TYPE OF COMPUTER RUNNING ON ' ZDumbModem NON-HAYES TYPE MODEM FLAG ' ZExtendedLogging EXTENDED CALLERS LOG FLAG ' ZFG LOCAL DISPLAY'S FOREGROUND ' ZModemAnswerCmd$ COMMAND TO ANSWER PHONE ' ZModemCntlReg LOCATION WasOF MODEM CNTRL. REG ' ZModemCountRingsCmd$ COMMAND TO COUNT PHONE RINGS ' ZModemInitBaud$ BAUD AT WHICH TO OPEN COMM. ' ZModemResetCmd$ COMMAND TO RESET THE MODEM ' ZModemStatusReg LOCATION OF MODEM STATUS REG ' ZPrinter FLAG TO PRINT ON LOCAL PRT. ' ZRequiredRings NUMBER OF RINGS TO ANSWER ON ' ZSnoop FLAG TO DISPLAY ON LOCAL PC ' ZSysopNext FLAG TO GIVE SYSOP CONTROL ' ' OUTPUTSS -- BaudTest! BAUD RATE TO SET RS232 AT ' ZEightBit PARITY INDICATOR ' ZReliableMode INDICATES MODEM-SUPPLIED ' "ERROR-FREE" Protocol ACTIVE ' ZSubParm = 1 Carrier DETECT Found (I.E. ' MODEM AUTO-ANSWERED). ' = 2 ANSWERED THE PHONE AND ' Carrier DETECT OCCURRED. ' = 3 SYSOP HIT "ESC" KEY ON THE ' LOCAL KEYBOARD. ' = 4 ANSWERED THE PHONE BUT NO ' Carrier WAS DETECTED. ' = 5 COMM. BUFFER OVERFLOW. ' = 6 FUNCTION KEY PRESSED ON THE ' LOCAL KEYBOARD. ' ' PURPOSE -- To detect incoming call and establish connection. ' SUB AnswerIt STATIC ZErrCode = 0 ZReliableMode = ZFalse ZFF = ZSubParm ZSubParm = 0 ON ZFF GOTO 201,324,245,320 ' ' ' * INITIALIZE MODEM AND ANNOUNCE RBBS-PC IS UP AND READY FOR CALLS ' ' 201 ZSubParm = -10 CALL Carrier IF ZSubParm = 0 THEN _ GOTO 210 ' ' ' * RESET THE MODEM VIA THE MODEM CONTROL REGISTER TO ASSURE IT IS READY ' ' IF ZFossil THEN _ State = 0 : _ CALL FosDTR(ZComPort,State) _ ELSE OUT ZModemCntlReg,&H4 CALL DelayTime (ZModemInitWaitTime) ' ' ' * CLEAR THE MODEM CONTROL REGISTER PRIOR TO OPEN THE COMMUNICATIONS PORT ' ' IF ZFossil THEN _ State = 1 : _ CALL FosDTR(ZComPort,State) _ ELSE OUT ZModemCntlReg,&H0 CALL DelayTime (ZModemInitWaitTime) 210 IF ZPrivateDoor THEN _ CALL Transfer : _ GOTO 235 CALL OpenCom(ZModemInitBaud$,",N,8,1") 220 CALL AMorPM 230 CALL Printit (" RBBS-PC " + ZVersionID$ + " Node " + _ ZNodeID$ + " up " + ZTime$ + " on " + DATE$) 235 ZEightBit = ZTrue ZSubParm = -10 CALL Carrier IF ZSubParm = 0 AND _ ZExitToDoors THEN _ CALL ReadProf : _ ZSubParm = 1 : _ GOTO 335 IF ZSubParm = 0 AND _ ZExpectActiveModem THEN _ ZBaudTest! = VAL(ZNetBaud$) : _ CALL TestRel (ZNetReliable$) : _ GOTO 328 IF ZExpectActiveModem OR _ ZExitToDoors THEN _ ZSubParm = 4 : _ EXIT SUB IF ZSubParm = 0 THEN _ ConnectDelay! = TIMER + ZMaxCarrierWait : _ GOTO 324 PCJr = ZFalse IF ZComputerType = 2 AND _ ZComPort$ = "COM1" AND _ ZModemStatusReg = 1022 THEN _ ZModemGoOffHookCmd$ = CHR$(14) + _ "P" : _ PCJr = ZTrue CALL SysMenu IF PCJr THEN _ ZOutTxt$ = CHR$(14) + _ "I" _ ELSE ZOutTxt$ = ZModemResetCmd$ CALL ModemPut (ZOutTxt$) CALL DelayTime (ZModemInitWaitTime) IF PCJr THEN _ ZOutTxt$ = CHR$(14) + _ ' PC-JR'ZWasS MODEM COMMAND IDENTIFIER "C 0," + _ ' SET "AUTO-ANSWER" OFF ON PC-JR'ZWasS MODEM "S 1," + _ ' SET SPEED TO 300 BAUD ON PC-JR'ZWasS MODEM "H" _ ' MANUALLY HANG UP THE PHONE (IF NOT ALREADY) ELSE ZOutTxt$ = ZModemInitCmd$ CALL ModemPut (ZOutTxt$) IF PCJr THEN _ ZOutTxt$ = CHR$(14) + _ "F 4" : _ CALL ModemPut (ZOutTxt$) RingBack = ZFalse LOCATE 16,55 IF ZRequiredRings = 0 THEN _ CALL LPrnt("WAITING FOR CARRIER",0) : _ GOTO 237 IF MID$(ZModemInitCmd$, _ INSTR(ZModemInitCmd$,"S0") + 3,3) = "255" THEN _ CALL LPrnt("RING BACK SYSTEM",0) : _ RingBack = ZTrue : _ GOTO 236 CALL LPrnt(" WAITING FOR RING ",0) 236 LOCATE 16,76 : _ CALL LPrnt(MID$(STR$(ZRequiredRings),2),0) 237 LOCATE 18,76 IF ZDosANSI THEN _ CALL LPrnt(ZEscape$ + "[05m" + "YES" + ZEscape$ + "[00m",0) _ ELSE CALL LPrnt ("YES",0) COLOR ZFG,ZBG,ZBorder LOCATE 20,56 ' ' ' * GET READY TO ANSWER INCOMMING CALL: ' * 1. LET THE MODEM "AUTO-ANSWER" FOR RBBS-PC. ' * REQUIRED RINGS = 0 AND S0 = 1 IN MODEM INIT COMMAND. ' * 2. ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS. ' * REQUIRED RINGS > 0 AND S0 = 254 IN MODEM Init COMMAND. ' * 3. ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS AFTER A USER ' * First CALLS AND THEN HANGS UP (I.E. RING-BACK). ' * REQUIRED RINGS > 0 AND S0 = 255 IN MODEM INIT COMMAND. ' ' WasQQ = 255 WasI = INSTR(ZModemInitCmd$,"S0") IF WasI = 0 OR PCJr THEN _ GOTO 239 IF VAL(MID$(ZModemInitCmd$,WasI + 3,3)) = 255 THEN _ WasQQ = 0 : _ ZBlk = WasQQ ZSecsUsedSession! = TIMER ZSubParm = 1 CALL Line25 RingAnswer = ZTrue IF RingBack THEN _ RingAnswer = ZFalse 239 RingBackWaitStart! = 0 IF RingBack THEN _ RingBackWaitStart! = TIMER : _ COLOR 7,0,0 _ ELSE COLOR ZFG,ZBG,ZBorder 240 IF ZSysopNext THEN _ ZSubParm = 3 : _ EXIT SUB ' ' ' * WAIT FOR INCOMING CALLS ' ' ScreenCleared = ZFalse 245 InactiveDelay! = TIMER + (60 * ZRecycleWait) NoCall = ZTrue CALL FlushCom (ModemResponse$) ModemResponse$ = "" 247 IF INP(ZModemStatusReg) > 127 OR (NOT NoCall) THEN _ GOTO 274 CALL FindFKey IF ZSubParm < 0 THEN _ EXIT SUB 250 IF ZKeyPressed$ = ZEscape$ THEN _ ZSubParm = 3 : _ EXIT SUB IF ZKeyPressed$ <> "" THEN _ GOTO 235 260 IF RingBackWaitStart! > 0 THEN _ CALL CheckTime(RingBackWaitStart!, TempElapsed!, 2) : _ IF TempElapsed! > 45 THEN _ RingBackWaitStart! = 0 : _ RingBackCount = 0 : _ RingAnswer = ZFalse: _ IF RingBack THEN _ LOCATE 20,56 : _ CALL LPrnt("Ringback timeout" + ZPagingPtrSupport$,1) 265 CALL CheckTime(ZSecsUsedSession!, TempElapsed!, 2) IF TempElapsed! > 120 AND NOT ScreenCleared THEN _ LOCATE ,,0 : _ CLS : _ ZWasCL = 1 : _ ScreenCleared = ZTrue : _ ZSecsUsedSession! = TIMER IF ZTimeToDropToDos! > 0 THEN _ IF ZOldDate$ <> DATE$ THEN _ IF TIMER => ZTimeToDropToDos! AND _ TIMER < 86340 THEN _ ' Skip btw 23:59 and 00:00 ZSubParm = 7 : _ EXIT SUB 266 IF (INP(ZModemStatusReg) AND &H40) > 0 AND _ ZRequiredRings > 0 THEN _ GOTO 276 270 IF ZRecycleWait > 0 THEN _ CALL CheckTime(InactiveDelay!, TempElapsed!, 1) : _ IF TempElapsed! <= 0 THEN _ ZSubParm = 8 : _ EXIT SUB CALL FlushCom (WasX$) IF LEN(WasX$) > 0 THEN _ ModemResponse$ = ModemResponse$ + WasX$ : _ RingDetected = (INSTR(ModemResponse$,"RING") > 0) : _ ConnectDetected = (INSTR(ModemResponse$,"ONNECT") > 0) : _ NoCall = (NOT RingDetected) AND (NOT ConnectDetected) IF RingDetected AND ZRequiredRings > 0 THEN _ MID$(ModemResponse$, INSTR(ModemResponse$,"RING")+1,1) = "A" : _ RingDetected = ZFalse : _ GOTO 276 CALL GoIdle GOTO 247 274 IF NOT RingBack THEN _ IF ConnectDetected THEN _ GOTO 321 IF ZRequiredRings = 0 THEN _ CALL DelayTime (3) : _ GOTO 321 ' ' ' * PREPARE TO ANSWER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 254) OR ' * THE CALL AFTER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 255) -- ' * "RING BACK." ' ' 276 CALL EofComm (Char) IF Char <> -1 THEN _ CALL FlushCom(WasX$) : _ IF ZSubParm = - 1 THEN _ EXIT SUB IF PCJr THEN _ GOTO 320 ZOutTxt$ = ZModemCountRingsCmd$ CALL ModemPut (ZOutTxt$) CALL DelayTime (ZModemCmdDelayTime) 290 CALL FlushCom(WasX$) IF ZSubParm = -1 THEN _ EXIT SUB 291 IF LEN(WasX$) = 0 THEN _ GOTO 310 292 IF INSTR(WasX$,"0") < 1 THEN _ GOTO 293 WasX$ = MID$(WasX$,INSTR(WasX$,"0"),4) 293 IF (NOT RingAnswer) AND (VAL(WasX$) < RingBackCount) THEN _ RingAnswer = ZTrue 300 RingBackCount = VAL(WasX$) ZWasQ = RingBackCount + 1 IF (NOT RingAnswer) THEN _ ZWasQ = 0 305 LOCATE 20,56 CALL LPrnt(TIME$ + " Ring " + STR$(ZWasQ),0) 310 IF (RingBackCount + 1 < ZRequiredRings) OR _ (NOT RingAnswer) THEN _ GOTO 239 320 IF PCJr THEN _ ZOutTxt$ = CHR$(14) + _ ' PC-JR'S MODEM COMMAND IDENTIFIER "T 0," + _ ' SET PC-JR'S MODEM TO TRANSPARENT MODE PERMANENTLY "M" _ ' TELL THE PC-JR'S MODEM TO ANSWER IN DATA MODE ELSE ZOutTxt$ = ZModemAnswerCmd$ CALL ModemPut (ZOutTxt$) ' ' ' * TEST FOR Carrier PRESENT ' ' 321 ConnectDelay! = TIMER + ZMaxCarrierWait 322 CALL CheckTime(ConnectDelay!, TempElapsed!, 1) 323 ZSubParm = -10 CALL Carrier IF ZSubParm AND _ TempElapsed! > 0 THEN _ GOTO 322 IF ZSubParm THEN _ ZSubParm = 4 : _ EXIT SUB CALL DelayTime (3) 324 ZSubParm = 0 CALL CheckTime(ConnectDelay!, TempElapsed!, 1) IF TempElapsed! <= 0 THEN _ CALL UpdtCalr ("Connect timeout",1) : _ ZSubParm = 4 : _ EXIT SUB 325 CALL FlushCom(WasX$) IF ZSubParm = -1 THEN _ IF ZErrCode = 69 THEN _ ZSubParm = 5 : _ EXIT SUB ModemResponse$ = ModemResponse$ + WasX$ IF LEN(ModemResponse$) > 200 THEN _ ModemResponse$ = RIGHT$(ModemResponse$,20) CALL CheckTime(ConnectDelay!, TempElapsed!, 1) IF TempElapsed! <= 0 THEN _ CALL UpdtCalr ("Connect timeout",1) : _ ZSubParm = 4 : _ EXIT SUB IF ZDumbModem THEN _ ZBaudTest! = VAL(ZModemInitBaud$) : _ GOTO 327 IF INSTR(ModemResponse$,"FAST") THEN _ ZBaudTest! = 19200 : _ GOTO 327 IF INSTR(ModemResponse$,"ONNECT") THEN _ ZBaudTest! = VAL(MID$(ModemResponse$,INSTR(ModemResponse$,"ONNECT") + 7)) : _ GOTO 327 IF INSTR(ModemResponse$,"ONLINE") THEN _ ZBaudTest! = VAL(MID$(ModemResponse$,INSTR(ModemResponse$,"ONLINE") + 7)) : _ GOTO 327 GOTO 324 327 CALL TestRel (ModemResponse$) 328 IF ZBaudTest! = 0 OR ZBaudTest! = 300 THEN _ ZBaudTest! = 300 : _ ZBPS = -1 : _ GOTO 331 IF ZBaudTest! = 1200 OR ZBaudTest! = 1275 THEN _ ZBPS = -3 : _ GOTO 331 IF ZBaudTest! = 2400 THEN _ ZBPS = -4 : _ GOTO 331 IF ZBaudTest! = 4800 OR ZBaudTest! = 9600 THEN _ ZBPS = -4-(ZBaudTest! /4800) : _ GOTO 331 IF ZBaudTest! = 19200 THEN _ ZBPS = -7 : _ GOTO 331 IF ZBaudTest! = 38400 THEN _ ZBPS = -8 : _ GOTO 331 GOTO 324 331 CALL SetBaud ZSubParm = 2 335 DontWrite = 0 END SUB 336 ' $SUBTITLE: 'TestRel - Test for Reliable mode connection' ' $PAGE ' ' NAME -- TestRel ' ' INPUTS -- PARAMETER MEANING ' Strng$ String to check for reliable ' ' OUTPUTS -- ZReliableMode Reliable mode indicator ' ' PURPOSE -- To test for reliable connect ' SUB TestRel (Strng$) STATIC ZReliableMode = ZFalse IF Strng$ = "" THEN _ EXIT SUB IF INSTR(Strng$,"REL") OR _ INSTR(Strng$,"R C") OR _ ' DA071701 INSTR(Strng$,"ARQ") OR _ INSTR(Strng$,"LAP") OR _ INSTR(Strng$,"AFT") OR _ INSTR(Strng$,"MNP") THEN _ ZReliableMode = -1 END SUB 455 ' $SUBTITLE: 'BadChar - sub to check user names for bad characters' ' $PAGE ' ' NAME -- BadChar ' ' INPUTS -- PARAMETER MEANING ' PassedName$ USER NAME ' ' OUTPUTS -- PassedName$ USER NAME WILL CONTAIN "" ' IF BAD CHARACTERS Found ' ' PURPOSE -- To check user names for invalid characters ' SUB BadChar (PassedName$) STATIC WasJ = 1 WasXX = LEN(PassedName$) 457 IF WasJ > WasXX THEN _ EXIT SUB WasX$ = MID$(PassedName$,WasJ,1) IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ '-./0123456789",WasX$) = 0 THEN _ PassedName$ = "" : _ EXIT SUB WasJ = WasJ + 1 GOTO 457 END SUB 660 ' $SUBTITLE: 'PassWrd - verify User and Message passwords' ' $PAGE ' ' NAME -- PassWrd ' ' INPUTS -- PARAMETER MEANING ' ZSubParm = 1 VERIFY USER PASSWORD ' = 2 VERIFY MESSAGE PASSWORD ' = 3 VERIFY MESSAGE PASSWORD ' = 4 VERIFY MESSAGE PASSWORD ' = 5 VERIFY MESSAGE PASSWORD ' ' OUTPUTS -- ZPswdFailed SET TO 0 IF PASSED ' SET TO -1 IF FAILED ' ' PURPOSE -- To verify user and message passwords ' SUB PassWrd STATIC ZErrCode = 0 ON ZSubParm GOTO 665,667,670,675,677 665 IF ZPswdSave$ = ZPswd$ THEN _ ZPswdFailed = 0 : _ EXIT SUB 667 Attempts = 0 670 Attempts = Attempts + 1 IF Attempts > ZAttemptsAllowed THEN _ ZPswdFailed = ZTrue : _ EXIT SUB 675 ZOutTxt$ = "Enter Password" ZHidden = ZTrue CALL PopCmdStack IF ZSubParm < 0 THEN _ ZPswdFailed = ZTrue : _ EXIT SUB ZHidden = ZFalse ZWasZ$ = ZUserIn$ 677 IF LEN(ZWasZ$) > 15 THEN _ GOTO 680 IF ZErrCode <> 0 THEN _ GOTO 670 CALL AllCaps (ZWasZ$) ZWasZ$ = ZWasZ$ + SPACE$(15 - LEN(ZWasZ$)) IF ZPswdSave$ = ZWasZ$ THEN _ ZPswdFailed = 0 : _ ZOutTxt$ = "" : _ EXIT SUB 680 CALL QuickTPut1 ("Wrong password ") ZLastIndex = 0 IF NOT ZMsgPswd THEN _ CALL UpdtCalr (ZActiveUserName$+" PW fail: " + ZWasZ$,1) GOTO 670 END SUB 945 ' $SUBTITLE: 'Line25 - sub to build/display RBBS-PCs line 25' ' $PAGE ' ' NAME -- Line25 ' ' INPUTS -- PARAMETER MEANING ' ZSubParm = 1 BUILD DISPLAY FOR LINE 25 ' = 2 UPDATE LINE 25 ' ZLockStatus$ STATUS OF LOCKS IN A MULTI- ' USER ENVIRONMENT OR TIME OF ' DAY USER LOGGED ON OR THE ' RE-CYCLED ' ' OUTPUTS -- ZCursorLine CURRENT LINE ON SCREEN ' ZCursorRow CURRENT ROW ON ZCursorLine ' ' PURPOSE -- To build or update RBBS-PC's line 25 displayed ' on the PC screen that is running RBBS-PC. ' SUB Line25 STATIC IF ZSubParm = 2 THEN _ GOTO 950 ' ' ' * BUILD LINE 25 DISPLAY ' ' 949 ZLine25$ = "Node " + _ ZNodeID$ + " " + _ ZPageStatus$ + " " + _ MID$("AVL ",1, -4 * ZSysopAvail) + _ ' DA080902 MID$("ANY ",1, -4 * ZSysopAnnoy) + _ ' DA080902 MID$("LPT ",1, -4 * ZPrinter) + _ ' DA080902 MID$("SYS ",1, -4 * ZSysopNext) + _ ' DA080902 MID$("XOFF ",1,-5 * ZXOffEd) + _ ' DA080902 MID$("CTS ",1,-4 * ZNotCTS) ' DA080902 ' ' ' * LINE 25 UPDATE ROUTINE ' ' 950 IF NOT ZSnoop THEN _ EXIT SUB ZCursorLine = CSRLIN ZCursorRow = POS(0) ZWasHH = LEN(ZActiveUserName$) + _ LEN(ZWasCI$) + _ LEN(ZLine25$) + _ LEN(STR$(ZUserSecLevel)) ' DA080902 LOCATE 25,1 IF ZNetworkType = 0 THEN _ IF ZAutoDownYes THEN _ ZLockStatus$ = " AD " + _ ' DA080902 ZTimeLoggedOn$ _ ELSE ZLockStatus$ = SPACE$(4) + _ ' DA080902 ZTimeLoggedOn$ IF ZWasHH > 63 THEN _ ' DA080902 ZWasHH = 0 _ ' DA080902 ELSE _ ' DA080902 ZWasHH = 64 - ZWasHH ' DA080902 ZLine25Hold$ = ZLine25$ + _ SPACE$(ZWasHH) + _ ' DA080902 STR$(ZUserSecLevel) + _ " " + _ ZActiveUserName$ + _ " " + _ ZWasCI$ ' DA080902 ZLine25Hold$ = LEFT$(ZLine25Hold$, 66) + " " + ZLockStatus$ ' DA080902 TempBasicWrites = ZUseBASICWrites ZUseBASICWrites = ZTrue CALL LPrnt(ZLine25Hold$,0) ZUseBASICWrites = TempBasicWrites LOCATE ZCursorLine,ZCursorRow END SUB 1238 ' $SUBTITLE: 'SearchCmd - sub to search command list' ' $PAGE ' ' NAME -- SearchCmd ' ' INPUTS -- PARAMETER MEANING ' StartPos POSITION TO BEGIN SEARCH AT ' ZAllOpts$ STRING TO SEARCH (COMMAND LIST) ' ZWasZ$ WHAT TO LOOK FOR ' ' OUTPUTS -- WhereFound POSITION OF ZWasZ$ IN ZAllOpts$ ' 0 IF NOT Found ' ' PURPOSE -- Searches valid command list for the requested ' command. If the sysop has configured RBBS-PC to ' restrict commands to only those valid within the ' RBBS-PC subsystem, then only those commands and ' "GLOBAL" commands are valid. Otherwise all commands ' are valid from any of the RBBS-PC subsections. ' SUB SearchCmd (StartPos,WhereFound) STATIC 1240 IF LEN(ZWasZ$) < 1 THEN _ WhereFound = 0 : _ EXIT SUB CALL Trim (ZWasZ$) CALL AllCaps (ZWasZ$) ZWasY$ = LEFT$(ZWasZ$,1) WhereFound = INSTR(StartPos,ZAllOpts$,ZWasY$) IF WhereFound = 0 THEN _ 'Not found: decide whether to hunt further IF StartPos < 2 OR ZRestrictValidCmds THEN _ GOTO 1242 _ ' fully searched or restricted ELSE WhereFound = INSTR(1,ZAllOpts$,ZWasY$) : _ 'hunt further GOTO 1242 IF WhereFound => ZBegLibrary THEN _ IF WhereFound < LEN(ZAllOpts$) - 11 THEN _ IF ZLibType = 0 THEN _ WhereFound = INSTR(WhereFound+1,AllOpt$,ZWasY$) : _ IF WhereFound = 0 THEN _ WhereFound = INSTR(1,ZAllOpts$,ZWasY$) : _ IF WhereFound >= ZBegLibrary OR WhereFound = 0 THEN _ WhereFound = 0 : _ GOTO 1242 IF NOT ZRestrictValidCmds THEN _ GOTO 1242 ' everything found valid ' ' ' * RESTRICT COMMANDS TO SUBSYSTEMS (EXCEPT GLOBAL AND SYSOP) ' ' IF WhereFound > LEN(ZAllOpts$) - 11 THEN _ IF ZUserSecLevel < ZOptSec(WhereFound) THEN _ WhereFound = 0 : _ EXIT SUB _ ELSE GOTO 1242 IF MID$(ZOrigCommands$,WhereFound,1) = "G" THEN _ GOTO 1242 ' ACCEPT GOODBYE/GRAPHICS IF (WhereFound < StartPos) OR _ (StartPos < ZBegFile AND WhereFound => ZBegFile ) OR _ (StartPos < ZBegUtil AND WhereFound => ZBegUtil ) OR _ (StartPos < ZBegLibrary AND WhereFound => ZBegLibrary ) THEN _ WhereFound = 0 ' REJECT: NOT IN Section 1242 IF WhereFound > 0 THEN _ LSET ZLastCommand$ = ZActiveMenu$ + MID$(ZOrigCommands$,WhereFound) : _ EXIT SUB IF ZMacroActive OR LEN(ZWasZ$) <> 1 THEN _ EXIT SUB CALL Macro (ZWasZ$,Found) IF Found THEN _ CALL FDMACEXE : _ ZWasZ$ = ZUserIn$(1) : _ GOTO 1240 END SUB 1320 ' $SUBTITLE: 'CheckMacro - sub to check if macro exists & process' ' $PAGE ' ' NAME -- CheckMacro ' ' INPUTS -- PARAMETER MEANING ' Strng$ STRING TO CHECK IF IS A MACRO ' ZMacroDrvPath$ DRIVE/PATH WHERE MACROS ARE ' ZMacroExtension$ EXTENSION WasOF MACROS ' MACRO.OFF FORCE NO MACRO TO BE Found ' ' OUTPUTS -- MacroFound WHETHER A MACRO WAS Found ' Strng$ SUBSTITUTE FOR COMMANDS ' ZCommPortStack$ REST OF MACRO ' 0 IF NOT Found ' ' PURPOSE -- Macro file is checked for security (1st line). ' 2nd line is substituted for passed string ' and parsed. Remaining part of macro put into ' stack to be executed. ' SUB CheckMacro (Strng$,MacroFound) STATIC MacroFound = ZFalse IF ZMacroExtension$ = "" OR INSTR(Strng$,".") > 0 THEN _ EXIT SUB IF LEN(Strng$) < ZMacroMin THEN _ ZMacroMin = 1 : _ EXIT SUB IF LEN(Strng$) = 1 THEN _ Temp$ = Strng$ : _ CALL AllCaps (Temp$) : _ IF INSTR(ZAllOpts$,Temp$) > 0 THEN _ EXIT SUB CALL Macro (Strng$,MacroFound) END SUB 1325 ' $SUBTITLE: 'Macro - check if macro exists & process' ' $PAGE ' ' NAME -- Macro ' ' INPUTS -- PARAMETER MEANING ' Strng$ STRING TO CHECK IF IS A MACRO ' ZMacroDrvPath$ DRIVE/PATH WHERE MACROS ARE ' ZMacroExtension$ EXTENSION OF MACROS ' MACRO.OFF FORCE NO MACRO TO BE Found ' ' OUTPUTS -- MacroFound WHETHER A MACRO WAS Found ' Strng$ SUBSTITUTE FOR COMMANDS ' ZCommPortStack$ REST OF MACRO ' 0 IF NOT Found ' ' PURPOSE -- Executes a macro if found. Does not check if macro ' letter uses a command. SUB Macro (Strng$,MacroFound) STATIC MacroFound = ZFalse FilName$ = Strng$ ' KG071201 CALL BreakFileName (FilName$,ZWasDF$,Prefix$,WasX$,ZFalse) ' KG071201 IF WasX$ = "" THEN _ ' KG071201 FilName$ = Strng$ + ZMacroExtension$ ' KG071201 IF ZWasDF$ = "" THEN _ ' KG071201 FilName$ = ZMacroDrvPath$ + FilName$ ' KG071201 CALL BadFile (FilName$,ZWasA) IF ZWasA > 1 THEN _ EXIT SUB CALL GRAPHICX (ZUserGraphicDefault$,FilName$,6) IF NOT ZOK THEN _ EXIT SUB CALL ReadDir (6,1) IF ZErrCode > 0 THEN _ EXIT SUB CALL CheckInt (ZOutTxt$) IF ZErrCode > 0 OR ZUserSecLevel < ZTestedIntValue THEN _ EXIT SUB ZWasA = INSTR(ZOutTxt$,"/") IF ZWasA > 0 THEN _ ' Check macro contraint WasX$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-ZWasA) : _ IF RIGHT$(WasX$,1) = "/" THEN _ IF ZLastCommand$ <> LEFT$(WasX$,LEN(WasX$)-1) THEN _ EXIT SUB _ ELSE GOTO 1327 _ ELSE IF LEFT$(ZLastCommand$,LEN(WasX$)) <> WasX$ THEN _ EXIT SUB 1327 ZMacroActive = ZTrue MacroFound = ZTrue ZMacroEcho = ZTrue END SUB 1330 ' $SUBTITLE: 'ViewHelp - Processes requests for help' ' $PAGE ' ' NAME -- ViewHelp ' ' INPUTS -- PARAMETER MEANING ' Section ORDER OF 1ST COMMAND IN CURRENT ' Section ' GRAPHICS.DEFAULT WHAT GRAPHICS TYPE USER WANTS ' HelpDefault$ HELP GET IF PRESS ENTER ' ZHelpPath$ ' ZHelpExtension$ ' ZBegFile ' ZBegMain ' ZBegUtil ' ZBegLibrary ' ' OUTPUTS -- DISPLAYS HELP ' ' PURPOSE -- The main help processor for RBBS. Puts up the ' optional menu. Accepts help with individual commands. ' SUB ViewHelp (Section,GraphicDefault$,HelpDefault$) STATIC HelpMenu$ = ZHelpPath$ + _ "HELP" + _ ZHelpExtension$ SotMenu = ZTrue IF ZWasQ > 1 THEN _ ZAnsIndex = 2 : _ ZLastIndex = ZWasQ: _ FastHelp = ZTrue : _ GOTO 1332 1331 IF SotMenu THEN _ ZFileName$ = HelpMenu$ : _ GOSUB 1350 : _ SotMenu = ZFalse ZAnsIndex = 1 ZOutTxt$ = "Help with what Command (or Topic name)" + _ ' DA071701 ZPressEnterExpert$ ZSubParm = 1 CALL TGet IF ZSubParm = -1 THEN _ EXIT SUB IF ZWasQ = 0 THEN _ EXIT SUB ZLastIndex = ZWasQ 1332 ZWasZ$ = ZUserIn$(ZAnsIndex) CALL AllCaps (ZWasZ$) IF ZWasZ$ = "?" THEN _ ZWasZ$ = "H" CALL BadFile (ZWasZ$,BadFileNameIndex) ON BadFileNameIndex GOTO 1333,1340,1340 1333 IF LEN(ZWasZ$) <> 1 THEN _ GOTO 1335 CALL SearchCmd (Section,ZFF) IF ZFF < 1 THEN _ ZOK = ZFalse : _ GOTO 1336 IF ZFF > LEN(ZAllOpts$) - 11 THEN _ IF ZFF > LEN(ZAllOpts$) - 7 AND NOT ZSysop THEN _ ZOK = ZFalse : _ GOTO 1336 _ ELSE ZWasZ$ = MID$(ZOrigCommands$,ZFF,1) : _ GOTO 1335 _ ELSE WasX = - (ZFF => ZBegMain) - (ZFF => ZBegFile) - (ZFF => ZBegUtil) - (ZFF => ZBegLibrary) : _ ZWasZ$ = MID$("MFU@",WasX,1) + _ MID$(ZOrigCommands$,ZFF,1) 1335 ZFileName$ = ZHelpPath$ + _ ZWasZ$ + _ ZHelpExtension$ GOSUB 1350 1336 IF NOT ZOK THEN _ ZOutTxt$ = "No help for " + _ ZWasZ$ : _ CALL QuickTPut1 (ZOutTxt$) : _ CALL UpdtCalr (ZOutTxt$,2) ZAnsIndex = ZAnsIndex + 1 IF ZAnsIndex <= ZLastIndex THEN _ GOTO 1332 IF FastHelp THEN _ FastHelp = ZFalse : _ EXIT SUB GOTO 1331 1340 ZOK = ZFalse GOTO 1336 1350 CALL Graphic (GraphicDefault$,ZFileName$) CALL BufFile (ZFileName$,WasX) RETURN END SUB 1380 ' $SUBTITLE: 'VIOLATION - handles all security violations' ' $PAGE ' ' NAME -- SecViolation ' ' INPUTS -- PARAMETER MEANING ' ' OUTPUTS -- ZCursorLine CURRENT LINE ON SCREEN ' ZCursorRow CURRENT ROW ON ZCursorLine ' ' PURPOSE -- Inform caller of security violation, augment count of ' violations and determine whether too many occurred. ' SUB SecViolation STATIC CALL FlushKeys CALL BufFile (ZSecVioHelp$,WasX) IF NOT ZOK THEN _ CALL QuickTPut1 ("Sorry, " + ZFirstName$ + ", action not permitted") CALL UpdtCalr ("SV!-" + ZViolation$,2) ZLastIndex = 0 CALL Muzak (3) ZViolationsThisSession = ZViolationsThisSession + 1 IF ZMaxViolations = 0 OR ZViolationsThisSession <= ZMaxViolations THEN _ EXIT SUB 1385 IF ZUserFileIndex < 1 THEN _ EXIT SUB ZOutTxt$ = "SECURITY VIOLATION! Sysop can reinstate" IF ZUserSecLevel <= ZMinLogonSec THEN _ ZOutTxt$ = "" : _ ZUserSecLevel = ZUserSecLevel - 1 _ ELSE ZUserSecLevel = ZMinLogonSec ZDenyAccess = ZTrue END SUB 1386 ' $SUBTITLE: 'DenyAccess - sub to permanently deny access' ' $PAGE ' ' NAME -- DenyAccess ' ' INPUTS -- PARAMETER MEANING ' ' OUTPUTS -- (USER'S RECORD) ' ' PURPOSE -- Permanently resets user's security level when access denied ' SUB DenyAccess STATIC CALL TPut ZLogonErrorIndex = 5 ZSubParm = 6 CALL FileLock CALL OpenUser (HighestUserRecord) FIELD 5, 128 AS ZUserRecord$ GET 5,ZUserFileIndex MID$(ZUserRecord$,47,2) = MKI$(ZUserSecLevel) PUT 5,ZUserFileIndex ZSubParm = 8 CALL FileLock END SUB 1396 ' $SUBTITLE: 'TPut -- common routine to write to comm. port' ' $PAGE ' ' NAME -- TPut (TERMINAL PUT) ' ' INPUTS -- PARAMETER MEANING ' ZOutTxt$ STRING TO WRITE TO THE ' COMMUNICATIONS PORT ' ZSubParm = 1 SKIP A LINE BEFORE WRITING ' TO THE COMMUNICATIONS PORT ' = 2 SKIP A LINE BEFORE WRITING ' TO THE COMMUNICATIONS PORT ' AND THEN SKIP TWO LINES ' AFTER WRITING TO THE COMM- ' UNICATIONS PORT ' = 3 WRITE TO THE COMMUNICATIONS ' PORT AND THEN SKIP TWO LINES ' = 4 WRITE TO THE COMMUNICATIONS ' PORT WITHOUT A CR/LF ' = 5 WRITE TO THE COMMUNICATIONS ' PORT WITH A CR/LF ' = 6 RESET EVERYTHING FOR INPUT STRING ' = 7 RE-ENTRY AFTER HANDLING A ' FUNCTION KEY ' ' OUTPUTS -- ZSubParm = -1 Carrier HAS BEEN DROPPED ' ZFunctionKey <> 0 FUNCTION KEY PRESSED ' ' PURPOSE -- Common output routine for RBBS-PC to the ' communications port (terminal put) SUB TPut STATIC IF ZSubParm <> 7 THEN _ Parm = ZSubParm ON ZSubParm GOTO 1398,1399,1400,1403,1405,1450,1411 ' ' ' * COMMON OUTPUT ROUTINE ' ' 1398 CALL SkipLine (1) GOTO 1405 1399 CALL SkipLine (1) 1400 ZCR = 1 1403 ZCR = ZCR + 1 1405 ZRet = ZFalse IF ZWasCM THEN _ GOTO 1435 1410 CALL FindFKey IF ZSubParm < 0 THEN _ EXIT SUB 1411 ZWasY$ = ZKeyPressed$ ZSubParm = Parm IF ZLocalUser THEN _ GOTO 1430 CALL EofComm (Char) IF Char = -1 THEN _ CALL CheckCarrier : _ IF ZSubParm = -1 THEN _ EXIT SUB _ ELSE GOTO 1430 CALL GetCom(ZWasY$) 1425 IF ZSubParm = -1 THEN _ EXIT SUB 1430 IF ZWasY$ = "" THEN _ GOTO 1435 ON INSTR(ZInterrupOn$,ZWasY$) GOTO 1434,1434,1473,1475,1433 GOSUB 1476 GOTO 1435 1433 GOSUB 1476 IF ASC(RIGHT$(ZCommPortStack$,2)) = 13 OR _ ZStopInterrupts THEN _ GOTO 1435 'stack if series of [ENTER]s or no previous stack GOTO 1471 1434 IF ZStopInterrupts THEN _ GOTO 1435 ZCommPortStack$ = "" IF ZFossil THEN _ CALL FOSTXPurge(ZComPort) : _ CALL FosRXPurge(ZComPort) GOTO 1471 1435 LOCATE ,,1 CALL LPrnt (ZOutTxt$,0) 1437 IF ZUpperCase THEN _ IF ZWasGR <> 2 THEN _ CALL AllCaps (ZOutTxt$) CALL PutCom (ZOutTxt$) 1450 IF ZCR <> 1 THEN _ CALL SkipLine (1) _ ELSE IF ZCR > 1 THEN _ CALL SkipLine (1) 1470 ZCR = 0 EXIT SUB 1471 CALL SkipLine (1) ZStopInterrupts = ZFalse ZRet = ZTrue ZNo = ZTrue ZNonStop = ZFalse GOTO 1470 1473 ZXOffEd = ZTrue GOTO 1410 1475 ZXOffEd = ZFalse GOTO 1410 1476 IF ASC(ZWasY$) < 127 THEN _ ZCommPortStack$ = ZCommPortStack$ + ZWasY$ RETURN END SUB 1478 ' $SUBTITLE: 'QuickTPut - subroutine to quickly write to terminal' ' $PAGE ' ' NAME -- QuickTPut ' ' INPUTS -- PARAMETER MEANING ' Strng$ STRING TO WRITE OUT ' NumReturns NUMBER OF CARRIAGE RETURNS ' ' OUTPUTS -- NONE ' ' PURPOSE -- Subroutine to quickly write to the terminal. This is ' different from "TPut" in the things it doesn't do: ' A.) No function key check, ' B.) No conversion to upper case, ' C.) No check for carrier present ' D.) No check for imbedded carriage return in "Strng$" ' E.) No support for XON/XOff ' SUB QuickTPut (Strng$,NumReturns) STATIC IF ZSubParm < 0 THEN _ EXIT SUB IF ZUseTPut THEN _ ZOutTxt$ = Strng$ : _ ZSubParm = 4 : _ CALL TPut : _ CALL SkipLine (NumReturns) : _ EXIT SUB CALL PutCom (Strng$) LOCATE ,,1 CALL LPrnt (Strng$,0) CALL SkipLine (NumReturns) END SUB SUB QuickTPut1 (Strng$) STATIC CALL QuickTPut (Strng$,1) END SUB 1480 ' $SUBTITLE: 'LPrnt - subroutine to write to display' ' $PAGE ' ' NAME -- LPrnt ' ' INPUTS -- PARAMETER MEANING ' Strng$ STRING TO WRITE OUT ' NumReturns NUMBER OF CARRIAGE RETURNS ' ' OUTPUTS -- NONE ' ' PURPOSE -- Subroutine to write to the display. ' SUB LPrnt (Strng$,NumReturns) STATIC IF NOT ZSnoop THEN _ EXIT SUB CALL PScrn (Strng$) IF ZVoiceType <> 0 AND ZTalkAll THEN _ CALL Talk (65,Strng$) IF ZUseBASICWrites THEN _ FOR WasI = 1 TO NumReturns : _ PRINT : _ NEXT : _ ELSE FOR WasI = 1 TO NumReturns : _ LOCATE ,,1 : _ CALL ANSI(ZCrLf$,ZWasCL,ZWasCC) : _ LOCATE ZWasCL,ZWasCC : _ NEXT END SUB 1482 ' $SUBTITLE: 'QuickLPrnt - subroutine to quickly write to display' ' $PAGE ' ' NAME -- QuickLPrnt ' ' INPUTS -- PARAMETER MEANING ' Strng$ STRING TO WRITE OUT ' Num NUMBER OF CARRIAGE RETURNS ' ' OUTPUTS -- NONE ' ' PURPOSE -- Subroutine to quickly write to the display. ' Overwrites, and puts up count SUB QuickLPrnt (Strng$,Num) STATIC IF ZSnoop THEN _ LOCATE ,1,1 : _ CALL Pscrn (Strng$ + STR$(Num)) END SUB 1483 ' $SUBTITLE: 'PScrn - subroutine to print to the screen' ' $PAGE ' ' NAME -- PScrn ' ' INPUTS -- PARAMETER MEANING ' Strng$ STRING TO WRITE OUT ' ' OUTPUTS -- NONE ' ' PURPOSE -- Writes to local screen regardless of whether you have ' carrier. Assumes have positioned cursor where you want. ' SUB PScrn (Strng$) STATIC IF Strng$ = "" THEN _ EXIT SUB IF ZUseBASICWrites THEN _ PRINT Strng$; _ ELSE CALL ANSI (Strng$,ZWasCL,ZWasCC) : _ LOCATE ZWasCL,ZWasCC END SUB 1485 ' $SUBTITLE: 'SkipLine - sub to write a blank line to user' ' $PAGE ' ' NAME -- SkipLine ' ' INPUTS -- PARAMETER MEANING ' ZLocalUser ' ZModemStatusReg ' NumReturns ' ZReturnLineFeed$ ' ZSnoop ' ' OUTPUTS -- NONE ' ' PURPOSE -- Skip lines on the user's terminal ' SUB SkipLine (NumReturns) STATIC FOR WasI=1 TO NumReturns CALL PutCom (ZReturnLineFeed$) NEXT IF NOT ZSnoop THEN _ GOTO 1486 IF ZUseBASICWrites THEN _ FOR WasI = 1 TO NumReturns : _ PRINT : _ NEXT _ ELSE FOR WasI = 1 TO NumReturns : _ LOCATE ,,1 : _ CALL ANSI(ZCrLf$,ZWasCL,ZWasCC) : _ LOCATE ZWasCL,ZWasCC : _ NEXT 1486 ZLinesPrinted = ZLinesPrinted + NumReturns ZUnitCount = ZUnitCount - ZDisplayAsUnit * NumReturns END SUB 1496 ' $SUBTITLE: 'SetCrLf -- sub to set up nulls/lf's for output' ' $PAGE ' ' NAME -- SetCrLf ' ' INPUTS -- PARAMETER MEANING ' ZCarriageReturn$ CARRIAGE RETURN CHARACTER ' ZLineFeed$ LINE FEED CHARACTER ' ZLineFeeds LINE FEED Switch ' ZNul$ NULL CHARACTER ' ' OUTPUTS -- ZReturnLineFeed$ END-OF-LINE STRING ' ' PURPOSE -- Set up the necessary nulls/line feeds to end ' each output to the communications port with. ' SUB SetCrLf STATIC ZReturnLineFeed$ = _ MID$(ZCarriageReturn$,1, - (NOT ZLocalUser)) + _ ZNul$ + _ MID$(ZLineFeed$,1, - (ZLineFeeds <> 0)) END SUB 1498 ' $SUBTITLE: 'TGet -- ask a user a question and get reply' ' $PAGE ' ' NAME -- TGet ' ' INPUTS -- PARAMETER MEANING ' ZSubParm = 1 STANDARD ENTRY ' = 2 ENTRY AFTER A FUNCTION KEY ' HAS BEEN HANDLED ' = 3 ENTRY AFTER STACKED COMMAND ' ZOutTxt$ STRING TO WRITE TO THE ' COMMUNICATIONS PORT ' ZHidden IF THIS IS TRUE THEN ECHO ' '.' INSTEAD OF ACTUAL ' CHARACTER ENTERED. ' ZForceKeyboard IF TRUE, STACKED INPUT ' IS BYPASSED AND KEYBOARD ' INPUT IS READ. ' ' OUTPUTS -- ZSubParm = -1 Carrier HAS BEEN DROPPED ' ZUserIn$ STRING THAT WAS ENTERED ' ZWasQ NUMBER OF PARAMETERES THAT ' WERE ENTERED WHICH WHERE ' SEPARATED BY A SEMICOLON ' ZUserIn$() STRING MATRIX WITH EACH ' ITEM CONTAIN THE STRING ' THAT WAS ENTERED BETWEEN ' SEMICOLONS. ' ZFunctionKey <> 0 FUNCTION KEY PRESSED ' ZYes Reply IS "Y" OR "YES" ' ZNo Reply IS "N" OR "NO" ' ZNonStop Reply IS "NS" OR "ns" ' ZKillMessage Reply IS "K" ' ZReply Reply IS "RE" ' ' SUBROUTINE PURPOSE -- COMMON ROUTINE TO ASK A USER A QUESTION ' SUB TGet STATIC MacroIndex = ZForceKeyboard ON ZSubParm GOTO 1500,1538,1625 ' ' ' * COMMON INPUT ROUTINE ' ' 1500 CALL Carrier IF ZSubParm = -1 THEN _ EXIT SUB ZLinesPrinted = 0 ZDisplayAsUnit = ZFalse InStack = ZFalse GOSUB 1580 ZWasA = 0 ZWasB = 0 ZWasC = 0 ZWasQ = 1 ZStoreParseAt = 1 Parm = 0 ZYes = ZFalse ZUserIn$ = "" SleepWarn = ZTrue ZNo = ZFalse ZNonStop = (ZPageLength < 1) IF ZOutTxt$ = "" THEN _ GOTO 1525 IF ZHidden THEN _ ZOutTxt$ = ZOutTxt$ + " (dots echo)" IF (NOT ZVerifying) OR HoldA$ = "" THEN _ CALL ColorPrompt (ZOutTxt$) : _ ZOutTxt$ = ZOutTxt$ + _ MID$("? ! ",2*ZTurboKey+1,2) : _ HoldA$ = ZOutTxt$ _ ELSE ZOutTxt$ = HoldA$ ZSubParm = 4 StopSave = ZStopInterrupts ZStopInterrupts = ZTrue CALL TPut ZStopInterrupts = StopSave IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _ EXIT SUB 1523 IF ZPromptBell THEN _ IF ZLocalUser THEN _ BEEP_ ELSE CALL PutCom(ZBellRinger$) 1525 CALL Carrier IF ZSubParm = -1 THEN _ EXIT SUB IF LEN(ZCommPortStack$) > 0 THEN _ InStack = ZTrue : _ WasX = INSTR(ZCommPortStack$,ZCarriageReturn$) : _ IF WasX > 0 THEN _ ZOutTxt$ = LEFT$(ZCommPortStack$,WasX-1) : _ ZCommPortStack$ = RIGHT$(ZCommPortStack$,LEN(ZCommPortStack$)-WasX) : _ GOTO 1534 _ ELSE ZWasY$ = LEFT$(ZCommPortStack$,1) : _ ZCommPortStack$ = RIGHT$(ZCommPortStack$,LEN(ZCommPortStack$)-1) : _ GOTO 1541 IF (ZForceKeyboard OR (NOT ZMacroActive) OR (ZMacroSave > 0)) THEN _ GOTO 1536 ' ' *** MACRO PROCESSING ' 1526 CALL ReadMacro IF ZMacroSave > 0 THEN _ GOTO 1500 IF NOT ZMacroActive THEN _ ZWasQ = 0 : _ ZLastIndex = 0 : _ EXIT SUB IF (ZDistantTGet > 0 ) OR (ZMacroTemplate$ <> "") THEN _ GOTO 1536 1534 ZUserIn$ = ZOutTxt$ ' Not Macro command - pass to normal processing IF ZMacroEcho THEN _ ZSubParm = 4 : _ CALL TPut WasX$ = ZCarriageReturn$ GOTO 1547 1536 IF ZLocalUser THEN _ GOTO 1537 ' CALL FindFKey: _ ' IF ZSubParm < 0 THEN _ ' EXIT SUB _ ' ELSE GOTO 1538 CALL EofComm (Char) IF Char <> -1 THEN _ CALL GetCom(ZWasY$) : _ IF ZSubParm = -1 THEN _ EXIT SUB _ ELSE GOTO 1541 1537 CALL CheckTime(ZAutoLogoff!, TempElapsed!, 3) IF TempElapsed! < 30 THEN _ IF TempElapsed! <= 0 THEN _ CALL UpdtCalr ("Sleep disconnect",1) : _ ZSubParm = -1 : _ ZNo = ZTrue : _ ZSleepDisconnect = ZTrue : _ EXIT SUB _ ELSE IF SleepWarn THEN _ SleepWarn = ZFalse : _ ZOutTxt$ = "Auto-Logoff in 30 seconds..." : _ ' DA071701 CALL RingCaller CALL FindFKey IF ZSubParm < 0 THEN _ EXIT SUB 1538 ZWasY$ = ZKeyPressed$ IF ZWasY$ <> "" THEN _ GOTO 1545 SendRemote = ZTrue CALL GoIdle GOTO 1525 1541 SendRemote = ZRemoteEcho IF ZTestParity THEN _ GOTO 1542 IF ZWasY$ = CHR$(127) THEN _ GOTO 1635 GOTO 1545 1542 IF ZWasY$ = "" THEN _ ZWasY$ = " " IF ASC(ZWasY$) = 141 THEN _ OUT ZLineCntlReg,&H1A : _ ZEightBit = ZFalse : _ ZTestParity = ZFalse : _ ZWasGR = ZFalse ZWasY$ = CHR$(ASC(ZWasY$) AND 127) 1545 WasX$ = ZWasY$ IF INSTR(ZLineEditChk$,ZWasY$) > 5 _ GOTO 1635 IF ZWasY$ < " " AND ZWasY$ <> ZCarriageReturn$ THEN _ GOTO 1525 IF ZWasY$ = "^" THEN _ GOTO 1525 IF ZWasY$ = ZCarriageReturn$ THEN _ GOTO 1547 _ ELSE GOSUB 1550 IF ZTurboKey < 1 THEN _ GOTO 1546 IF ZWasY$ = " " THEN _ ZWasY$ = "" IF ZWasY$ <> "/" THEN _ ZUserIn$ = ZWasY$ : _ ZWasY$ = ZCarriageReturn$ : _ WasX$ = ZWasY$ : _ GOTO 1547 ZTurboKey = 0 GOTO 1525 1546 IF LEN(ZUserIn$) => 512 THEN _ ZOutTxt$ = "Input too long!" : _ ZSubParm = 5 : _ CALL TPut : _ IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _ EXIT SUB _ ELSE GOTO 1500 ZUserIn$ = ZUserIn$ + _ ZWasY$ GOTO 1525 1547 ZTurboKey = ZFalse ' Carriage Return Handler ZHidden = ZFalse IF ZNoAdvance THEN _ ZNoAdvance = ZFalse : _ GOTO 1575 _ ELSE CALL LPrnt (ZCrLf$,0) : _ GOSUB 1551 : _ GOTO 1570 1550 IF ZLogonActive THEN _ IF (ZWasY$ = " " OR ZWasY$ = ";") AND LEN(ZUserIn$) > 0 AND _ ' MB073001 RIGHT$(ZUserIn$,1) <> " " AND RIGHT$(ZUserIn$,1) <> ";" THEN _ Parm = Parm + 1 : _ ZLogonActive = (Parm < 3) : _ ZHidden = (Parm = 2) : _ CALL LPrnt(WasX$,0) : _ GOTO 1551 IF ZHidden AND (WasX$ <> " ") THEN _ WasX$ = "." CALL LPrnt(WasX$,0) 1551 IF NOT SendRemote THEN _ RETURN IF ZHidden AND (WasX$ <> " ") THEN _ WasX$ = "." 1553 CALL PutCom (WasX$) RETURN 1570 IF SendRemote THEN _ IF ZLineFeeds THEN _ CALL PutCom (ZLineFeed$) 1575 IF LEN(ZUserIn$) > 4000 THEN _ ZOutTxt$ = "Try again, " + _ ZFirstName$ : _ ZSubParm = 5 : _ CALL TPut : _ IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _ EXIT SUB _ ELSE GOTO 1500 IF ZParseOff THEN _ ZParseOff = ZFalse : _ GOTO 1620 CALL ParseIt IF ZWasQ = 1 THEN _ GOTO 1622 GOTO 1625 1580 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect RETURN 1620 ZUserIn$(ZStoreParseAt) = ZUserIn$ ZWasQ = 1 1622 IF ZUserIn$ = "" THEN _ ZWasQ = 0 : _ ZHidden = ZFalse : _ GOTO 1628 1625 IF LEN(ZUserIn$) < 4 THEN _ WasX$ = LEFT$(ZUserIn$,3): _ CALL AllCaps (WasX$) : _ IF WasX$ = "Y" OR WasX$ = "YES" THEN _ ZYes = ZTrue _ ELSE IF WasX$ = "N" OR WasX$ = "NO" OR WasX$ = "A" THEN _ ZNo = ZTrue _ ELSE IF WasX$ = "RE" THEN _ ZReply = ZTrue : _ GOTO 1628 _ ELSE IF WasX$ = "K" THEN _ ZKillMessage = ZTrue : _ GOTO 1628 ZHidden = ZFalse 1628 CALL VerifyAns IF NOT ZOK THEN _ CALL QuickTPut1 ("Invalid answer <" + ZUserIn$(1) + ">") : _ GOTO 1500 HoldA$ = "" ZForceKeyboard = ZFalse IF ZMacroSave > 0 THEN _ ZGSRAra$(ZMacroSave) = ZUserIn$ : _ ZMacroSave = 0 : _ GOTO 1632 IF (ZDistantTGet > 0) OR (ZMacroTemplate$ <> "") THEN _ CALL WipeLine (38) : _ IF NOT ZNo THEN _ GOTO 1632 _ ELSE ZWasQ = 0 : _ ZMacroTemplate$ = "" : _ ZDistantTGet = 0 : _ ZNo = ZFalse : _ GOTO 1633 IF ZMacroActive THEN _ ZLastIndex = ZWasQ : _ FirstIndex = 1: _ ZMacroActive = NOT EOF(6) : _ ' KG021501 EXIT SUB IF ZAnsIndex > 255 OR ((NOT InStack) AND INSTR(ZUserIn$,".") > 0) THEN _ EXIT SUB IF MacroIndex THEN _ MacroIndex = 1 _ ELSE MacroIndex = ZAnsIndex CALL NoPath (ZUserIn$(MacroIndex),Found) IF Found THEN _ EXIT SUB CALL CheckMacro (ZUserIn$(MacroIndex),Found) IF Found THEN _ ZStoreParseAt = ZAnsIndex : _ GOTO 1525 EXIT SUB 1632 ZUserIn$ = "" ZForceKeyboard = ZFalse 1633 GOSUB 1580 ZWasQ = 1 GOTO 1525 1635 IF LEN(ZUserIn$) = 0 THEN _ GOTO 1525 IF ZLogonActive THEN _ IF INSTR(" ;",RIGHT$(ZUserIn$,1)) > 0 THEN _ Parm = Parm - 1 ZUserIn$ = LEFT$(ZUserIn$,LEN(ZUserIn$)-1) CALL LPrnt(ZLocalBksp$,0) IF SendRemote THEN _ CALL PutCom(ZBackSpace$) GOTO 1525 END SUB 1636 ' $SUBTITLE: 'RingCaller - sub to use sound + screen emphasis' ' $PAGE ' ' NAME -- RingCaller ' ' INPUTS -- PARAMETER MEANING ' ZOutTxt$ STRING TO EMPHASIZE ' ' OUTPUTS -- none ' ' PURPOSE -- Rings the users bell before and after string ' (but not snooping sysop) and adds emphasis around ' message sent. ' SUB RingCaller STATIC WasX$ = LEFT$(ZBellRinger$,-ZLocalUser) CALL PutCom (ZBellRinger$) CALL LPrnt (WasX$,0) ZSubParm = 2 ZOutTxt$ = ZEmphasizeOn$ + ZOutTxt$ + ZEmphasizeOff$ CALL TPut CALL PutCom (ZBellRinger$) CALL LPrnt (WasX$,0) END SUB 1637 ' $SUBTITLE: 'ParseIt - subroutine to parse a string' ' $PAGE ' ' NAME -- ParseIt ' ' INPUTS -- PARAMETER MEANING ' ZUserIn$ STRING TO PARSE ' ' OUTPUTS -- ZWasQ NUMBER PARSED ' ZUserIn$() PARSED STRINGS ' ' PURPOSE -- To parse a string into pieces. Uses semicolon ' if exists, otherwise space, otherwise comma ' SUB ParseIt STATIC ZWasA = INSTR(ZUserIn$,";") IF ZWasA > 0 THEN _ ParseChar$ = ";" _ ELSE IF ZUserIn$ <> SPACE$(LEN(ZUserIn$)) THEN _ CALL Trim (ZUserIn$) : _ WasX$ = ZUserIn$ : _ ZWasA = INSTR(ZUserIn$," ") : _ WHILE ZWasA > 0 : _ ZUserIn$ = LEFT$(ZUserIn$,ZWasA - 1) + _ MID$(ZUserIn$,ZWasA + 1) : _ ZWasA = INSTR(ZWasA,ZUserIn$," ") : _ WEND : _ ZWasA = INSTR(ZUserIn$," ") : _ IF ZWasA > 1 THEN _ ParseChar$ = " " _ ELSE ZWasA = INSTR(ZUserIn$,",") : _ ParseChar$ = "," IF ZWasA > 1 THEN _ GOTO 1639 ZWasDF$ = ZUserIn$ CALL AllCaps (ZWasDF$) IF ZWasDF$ = "NS" THEN _ ZUserIn$ = "C" : _ ZNonStop = ZTrue ZUserIn$(ZStoreParseAt) = ZUserIn$ ZNonStop = ZNonStop OR (ZWasDF$ = "C" AND NOT ZStackC) GOTO 1642 1639 ZUserIn$(ZStoreParseAt) = LEFT$(ZUserIn$,ZWasA - 1) ZWasA = ZWasA + 1 ZEOL = ZFalse 1640 ZWasB = INSTR(ZWasA,ZUserIn$,ParseChar$) ZWasC = ZWasB-ZWasA IF ZWasC < 1 THEN _ ZEOL = ZTrue : _ ZWasC = 128 ZWasDF$ = MID$(ZUserIn$,ZWasA,ZWasC) IF ZWasDF$ <> "" THEN _ ZWasQ = ZWasQ + 1 : _ ZStoreParseAt = ZStoreParseAt + 1 : _ ZUserIn$(ZStoreParseAt) = ZWasDF$ : _ CALL AllCaps(ZWasDF$) : _ WasX = INSTR(";NS;/G;C;",";"+ZWasDF$+";") : _ IF WasX > 0 THEN _ ZNonStop = ZNonStop OR (WasX = 1) OR (WasX = 7 AND NOT ZStackC) : _ ZAutoLogoffReq = ZAutoLogoffReq OR (WasX = 4) : _ IF ZWasQ > 0 AND WasX < 7 THEN _ ZWasQ = ZWasQ - 1 : _ ZStoreParseAt = ZStoreParseAt - 1 IF NOT ZEOL AND ZWasQ < 50 THEN _ ZWasA = ZWasB + 1 : _ GOTO 1640 IF ParseChar$ <> ";" THEN _ ZUserIn$ = WasX$ 1642 ZStackC = ZFalse END SUB 1650 ' $SUBTITLE: 'PopCmdStack - prompt for value with command stack check' SUB PopCmdStack STATIC CALL CheckCarrier IF ZSubParm = -1 THEN _ ZLastIndex = 0 : _ ZWasQ = 0 : _ EXIT SUB ZWasQ = 1 1651 IF ZAnsIndex < ZLastIndex THEN _ ZAnsIndex = ZAnsIndex + 1 : _ ZUserIn$ = ZUserIn$(ZAnsIndex) : _ IF MID$(ZLastCommand$,2,1) <> " " AND (NOT ZStackC) AND ZAnsIndex > 1 AND INSTR("Cc",ZUserIn$) > 0 AND LEN(ZUserIn$) = 1 THEN _ ' KG070901 GOTO 1651 _ ELSE ZSubParm = 3 : _ CALL TGet : _ GOTO 1652 ZLastIndex = 0 ZAnsIndex = 1 ZSubParm = 1 ZSearchingAll = ZFalse CALL TGet ZLastIndex = ZWasQ 1652 IF ZStoreParseAt > ZLastIndex THEN _ IF ZLastIndex > 0 THEN _ ZLastIndex = ZStoreParseAt ZStackC = ZFalse ZParseOff = ZFalse END SUB 1654 ' $SUBTITLE: 'SetBaud - sub to set the baud rate in the RS232' ' $PAGE ' ' NAME -- SetBaud ' ' INPUTS -- PARAMETER MEANING ' ZBaudRateDivisor NUMBER TO DIVIDE THE 8250 CHIP'S ' PROGRAMABLE CLOCK TO ADJUST THE ' BAUD RATE TO THE USER'S BAUD ' RATE (INDEPENDENT OF THE BAUD ' RATE USED TO OPEN THE COMM. PORT) ' ' DESIRED BAUD DIVISIOR (DECIMAL) TO OBTAIN DESIRED BAUD RATE ' RATE PCjr PC AND XT ' 50 2237 2304 ' 75 1491 1536 ' 110 1017 1047 ' 134.5 832 857 ' 150 746 768 ' 300 373 384 ' 600 186 192 ' 1200 93 96 ' 1800 62 64 ' 2000 56 58 ' 2400 47 48 ' 3600 31 32 ' 4800 23 24 ' 7200 not available 16 ' 9600 not available 12 ' 19200 not available 6 ' 38400 " 3 ' OUTPUTS -- BAUD RATE SET IN THE RS232 INTERFACE ' ' PURPOSE -- To set the baud rate in the RS232 interface ' inpependent of the baud rate the communications port ' was opened at ' SUB SetBaud STATIC IF NOT ZKeepInitBaud THEN _ ZTalkToModemAt$ = MID$(ZBaudRates$,(-5 * ZBPS),5) _ ELSE ZTalkToModemAt$ = ZModemInitBaud$ CALL Trim (ZTalkToModemAt$) IF LEN(ZTalkToModemAt$) < 5 THEN _ ZTalkToModemAt$ = SPACE$(4 - LEN(ZTalkToModemAt$)) + _ ZTalkToModemAt$ IF ZEightBit THEN_ Parity = 2 : _ ' No PARITY DataBits = 3 : _ ' 8 DATA BITS StopBits = 0 _ ' 1 STOP BIT ELSE Parity = 3 : _ ' EVEN PARITY DataBits = 2 : _ ' 7 DATA BITS StopBits = 0 ' 1 STOP BIT ComSpeed! = VAL(ZTalkToModemAt$) IF ComSpeed! > 19200 THEN _ IF FOSSIL THEN _ WasI = &H9600 _ ELSE WasI = 19200 _ ELSE WasI = ComSpeed! IF ZFossil THEN _ CALL FosSpeed(ZComPort,WasI,Parity,DataBits,StopBits) : _ EXIT SUB IF ComSpeed! = 2400 THEN _ ZBaudRateDivisor = &H30 + (1 * (ZComputerType = 2)) _ ELSE IF ComSpeed! = 1200 THEN _ ZBaudRateDivisor = &H60 + (3 * (ZComputerType = 2)) _ ELSE IF ComSpeed! = 9600 THEN _ ZBaudRateDivisor = &HC _ ELSE IF ComSpeed! = 300 THEN _ ZBaudRateDivisor = &H180 + (11 * (ZComputerType = 2)) _ ELSE IF ComSpeed! = 450 THEN _ ZBaudRateDivisor = &H100 + (8 * (ZComputerType = 2)) _ ELSE IF ComSpeed! = 4800 THEN _ ZBaudRateDivisor = &H18 _ ELSE IF ComSpeed! = 19200 THEN _ ZBaudRateDivisor = &H6 _ ELSE IF ComSpeed! = 38400 THEN _ ZBaudRateDivisor = &H3 MostSignifByte = FIX (ZBaudRateDivisor / 256) LeastSignifByte = ZBaudRateDivisor - (MostSignifByte * 256) LineCntlStatus = INP(ZLineCntlReg) MSBSave = INP(ZMSB) OUT ZMSB,0 OUT ZLineCntlReg,LineCntlStatus OR 128 OUT ZLSB,LeastSignifByte OUT ZMSB,MostSignifByte OUT ZLineCntlReg,LineCntlStatus OUT ZMSB,MSBSave END SUB 2018 ' $SUBTITLE: 'MessageTo - subroutine to get who a message is to' ' $PAGE ' ' NAME -- MessageTo ' ' INPUTS -- PARAMETER MEANING ' HighestUserRecord ' ' OUTPUTS -- MsgTo$ Who message is to ' RcvrRecNum User record # of who to ' ' PURPOSE -- Asks who a message is to and determines if receiver exists ' SUB MessageTo (HighestUserRecord,MsgTo$,MsgFrom$,RcvrRecNum,Found) STATIC Temp$ = MsgFrom$ CALL Trim (Temp$) 2020 IF MsgTo$ <> "" THEN _ GOTO 2032 ZOutTxt$ = "To [A]ll,S)ysop, or name" CALL SkipLine (1) ZParseOff = ZTrue GOSUB 2033 IF LEN(ZUserIn$) > 30 THEN _ CALL QuickTPut1 ("30 Char. Max") : _ GOTO 2020 2030 Found = ZTrue RcvrRecNum = 0 IF ZWasQ = 0 THEN _ MsgTo$ = "ALL" _ ELSE CALL AllCaps (ZUserIn$) : _ IF ZUserIn$ = "A" THEN _ MsgTo$ = "ALL" : _ EXIT SUB _ ELSE IF ZUserIn$ = "S" THEN _ MsgTo$ = "SYSOP" _ ELSE MsgTo$ = ZUserIn$ 2032 IF MsgTo$ <> "ALL" THEN _ IF (LEFT$(MsgTo$,4) <> "ALL " AND ZStartHash = 1) THEN _ ZWasDF = INSTR(MsgTo$+" @"," @") : _ ' KG052201 TempHashValue$ = LEFT$(MsgTo$,ZWasDF-1) : _ ' KG052201 CALL WhoCheck (TempHashValue$,Found,RcvrRecNum) : _ IF NOT Found THEN _ ZLastIndex = 0 : _ RcvrRecNum = 0 : _ ' KG060901 IF NOT ZReply THEN _ ZOutTxt$ = "[R]e-enter name, Q)uit, C)ontinue" : _ ZTurboKey = -ZTurboKeyUser : _ ZLastIndex = 0 : _ GOSUB 2033 : _ ZWasZ$ = ZUserIn$(1) : _ CALL AllCaps (ZWasZ$) : _ IF ZWasZ$ <> "C" THEN _ MsgTo$ = "" : _ IF ZWasZ$ <> "Q" THEN _ GOTO 2020 IF MsgTo$ = Temp$ THEN _ ZOutTxt$ = "Msg would be from and to SAME PERSON! Really do this (Y,[N])" : _ ZLastIndex = 0 : _ GOSUB 2033 : _ IF NOT ZYes THEN _ MsgTo$ = "" EXIT SUB 2033 CALL PopCmdStack IF ZSubParm < 0 THEN _ EXIT SUB RETURN END SUB 2055 ' $SUBTITLE: 'MsgProt - gets protection wanted for a message' ' $PAGE ' ' NAME -- MsgProt ' ' INPUTS -- PARAMETER MEANING ' MsgTo$ ' Found ' ' OUTPUTS -- ZPswd$ Protection desired ' ' PURPOSE -- Sets protection desired for a new message ' SUB MsgProt (MsgTo$,Found,MsgPswd$) STATIC IF MsgTo$ = "ALL" THEN _ GOTO 2090 2060 ZOutTxt$ = "Make message p(U)blic, p(R)ivate, (P)assword protected, (H)elp" IF MsgPswd$ = "^READ^" THEN _ DefaultProt$ = "R" : _ GOTO 2065 IF LEFT$(MsgPswd$,1) = "!" THEN _ DefaultProt$ = "P" _ ELSE _ DefaultProt$ = "U" 2065 MID$(ZOutTxt$,INSTR(ZOutTxt$,"("+DefaultProt$+")"),3) = "["+DefaultProt$+"]" ZTurboKey = -ZTurboKeyUser GOSUB 2096 IF ZWasQ = 0 THEN _ ZUserIn$(ZAnsIndex) = DefaultProt$ ZWasZ$ = LEFT$(ZUserIn$(ZAnsIndex),1) CALL AllCaps (ZWasZ$) ON INSTR("RUPH",ZWasZ$) GOTO 2075,2090,2075,2070 GOTO 2060 ' ' ** DISPLAY MESSAGE PROTECT HELP * ' 2070 CALL BufFile (ZHelp$(3),WasX) GOTO 2060 ' ' ** MAKE MESSAGE READ PROTECTED (ONLY ADDRESSEE AND SYSOP CAN READ IT) * ' 2075 IF MsgTo$ = "ALL" THEN _ CALL QuickTPut1 ("Msg to ALL cannot be private") : _ GOTO 2060 IF ZWasZ$ = "P" THEN _ GOTO 2088 2081 CALL QuickTPut1 ("Sending private mail to " + MsgTo$) ' DA071701 2084 MsgPswd$ = "^READ^" EXIT SUB 2085 ZOutTxt$ = "Password" GOSUB 2096 IF ZWasQ = 0 THEN _ IF LEFT$(MsgPswd$,1) = "!" THEN _ MsgPswd$ = MID$(MsgPswd$,2) : _ CALL QuickTPut1 ("Password is " + MsgPswd$) : _ RETURN _ ELSE _ GOTO 2085 IF LEN(ZUserIn$) > WasL THEN _ CALL QuickTPut1 (STR$(WasL) + " Chars. max") : _ GOTO 2085 IF WasL = 15 AND LEFT$(ZUserIn$,1) = "!" THEN _ CALL QuickTPut1 ("Password can't begin with '!'") : _ GOTO 2085 RETURN ' ' ** PASSWORD PROTECT MESSAGE (USERS WITH PASSWORD AND SYSOP CAN READ) * ' 2088 ZOutTxt$ = "Receiver(s) MUST know password to read msg. Use password (Y/[N])" ' DA071701 GOSUB 2093 IF NOT ZYes THEN _ GOTO 2070 WasL = 14 WasA1$ = "!" GOSUB 2085 CALL AllCaps (ZUserIn$) GOTO 2092 ' ' ** MAKE MESSAGE KILL PROTECTED (ONLY SENDER, ADDRESSEE AND SYSOP CAN KILL) * ' 2090 WasL = 15 WasA1$ = "" ZUserIn$ = "^KILL^" 2092 MsgPswd$ = WasA1$ + ZUserIn$ ' DA071701 EXIT SUB 2093 ZTurboKey = -ZTurboKeyUser 2094 ZSubParm = 1 CALL TGet 2095 IF ZSubParm = -1 THEN _ EXIT SUB RETURN 2096 CALL PopCmdStack GOTO 2095 END SUB 2250 ' $SUBTITLE: 'WhoCheck - Checks whether user exists' ' $PAGE ' ' NAME -- WhoCheck ' ' INPUTS -- PARAMETER MEANING ' WhoFind$ User to find ' ' OUTPUTS -- WhoFound Whether user found ' UserNumFound Record # of user ' ' PURPOSE -- Validate that user record exists. Sysop ' counted as found even if lack user record. ' SUB WhoCheck (WhoFind$,WhoFound,UserNumFound) STATIC UserNumFound = 0 IF ZStartHash <> 1 THEN _ WhoFound = ZTrue : _ EXIT SUB Work128$ = ZUserRecord$ WhoFound = ZFalse ToSysop = (INSTR(WhoFind$,"SYSOP") > 0 OR _ INSTR(WhoFind$,ZSysopFirstName$ + " " + ZSysopLastName$) > 0) ' KG060902 CALL OpenUser (HighestUserRecord) FIELD 5, 128 AS ZUserRecord$ IF ToSysop THEN _ WasX$ = ZSysopPswd1$ + " " + ZSysopPswd2$ _ ELSE WasX$ = WhoFind$ ZWasDF = INSTR(WasX$+"@","@") ' KG052201 WasX$ = LEFT$(WasX$,ZWasDF) ' KG052201 IF LEN(WasX$) > 1 THEN _ CALL FindUser (WasX$,"",ZStartHash,ZLenHash,_ 0,0,HighestUserRecord,WhoFound,_ UserNumFound,ZWasSL) LSET ZUserRecord$ = Work128$ IF NOT WhoFound THEN _ IF ToSysop THEN _ WhoFound = ZTrue _ ELSE CALL QuickTPut1 (WhoFind$ + " not active user") END SUB 2618 ' $SUBTITLE: 'EditALine - Edits a line in a message' ' $PAGE ' ' NAME -- EditALine ' ' INPUTS -- PARAMETER MEANING ' WasL Line # to edit ' ' OUTPUTS -- ZOutTxt$(WasL) Edited line ' ' PURPOSE -- Edit a line in a message. ' SUB EditALine (WasL) STATIC 2620 ZOutTxt$ = "Line #" + _ STR$(WasL) + _ " is:" + _ ZReturnLineFeed$ + _ ZOutTxt$(WasL) ZSubParm = 3 CALL TPut GOSUB 2695 IF NOT ZExpertUser THEN _ CALL QuickTPut1 ("Search & replace") ZOutTxt$ = "Search for" + _ ZPressEnterExpert$ ZMacroMin = 99 ZParseOff = ZTrue ZSubParm = 1 GOSUB 2694 IF ZWasQ = 0 THEN _ EXIT SUB ZWasY$ = LEFT$(ZUserIn$,1) IF ZWasY$ = RIGHT$(ZUserIn$,1) THEN _ IF LEN(ZUserIn$) > 2 THEN _ WasX = INSTR(2,ZUserIn$,ZWasY$) : _ IF WasX < LEN(ZUserIn$) THEN _ IF ZWasY$ < "0" OR (ZWasY$ > "9" AND ZWasY$ < "A") THEN _ ZUserIn$ = MID$(ZUserIn$,2,LEN(ZUserIn$)-2) : _ WasX = WasX - 1 : _ GOTO 2622 WasX = INSTR(ZUserIn$,";") 2622 IF WasX > 0 THEN _ WasX$ = LEFT$(ZUserIn$,WasX-1) : _ ZWasY$ = RIGHT$(ZUserIn$,LEN(ZUserIn$)-WasX) : _ GOTO 2660 WasX$ = ZUserIn$ ZOutTxt$ = "And replace by" ZParseOff = ZTrue ZSubParm = 1 GOSUB 2694 ZWasY$ = ZUserIn$ 2660 WasX = INSTR(1,ZOutTxt$(WasL),WasX$) IF WasX = 0 THEN _ CALL QuickTPut1 ("<" + WasX$ + "> not found in line" + STR$(WasL)) : _ GOTO 2620 2670 ZFF = LEN(WasX$) WasJJ = LEN(ZWasY$) IF ZFF = WasJJ THEN _ MID$(ZOutTxt$(WasL),WasX) = ZWasY$ : _ GOTO 2620 2690 ZWasDF$ = LEFT$(ZOutTxt$(WasL),WasX - 1) ZOutTxt$(WasL) = ZWasDF$ + _ ZWasY$ + _ MID$(ZOutTxt$(WasL),WasX + ZFF) IF LEN(ZOutTxt$(WasL)) > ZRightMargin THEN _ CALL WordWrap (ZRightMargin, ZLinesInMsg, ZOutTxt$()) GOTO 2620 2694 CALL TGet 2695 IF ZSubParm > -1 THEN _ RETURN END SUB 3700 ' $SUBTITLE: 'LineEdit - subroutine to produce edited line' ' $PAGE ' ' NAME -- LineEdit ' ' INPUTS -- PARAMETER MEANING ' ZBackArrow$ ' ZBackSpace$ ' ZCarriageReturn$ ' ZLineFeed$ ' ZLineMes$ BUFFER SPACE TO USE FOR HOLDING LINE ' ZLocalUser ' MaxLen MAXIMUM LENGTH OF STRING TO INPUT ' MsgLine WHERE IN ZOutTxt$() TO PUT THE EDITED LINE ' ZRightMargin ' ZSnoop ' ZStopInterrupts ' ZWaitExpired ' ' OUTPUTS -- ZOutTxt$(MsgLine) EDITED LINE ' ' PURPOSE -- Subroutine to edit a line quickly using a minimum of ' string space. ' SUB LineEdit (MsgLine,MaxLen) STATIC TabToSpace = 0 ' DA060901 LSET ZLineMes$ = ZOutTxt$(MsgLine) Col = LEN(ZOutTxt$(MsgLine)) ZStopInterrupts = ZTrue WasXXX = MaxLen - 3 ZWaitExpired = ZFalse GOTO 3782 3720 Col = Col + 1 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect 3730 IF TabToSpace > 0 THEN _ ' DA060901 WasX$ = " " : _ ' DA060901 TabToSpace = TabToSpace - 1 : _ ' DA060901 GOTO 3750 ' DA060901 CALL FindFKey ' DA060901 IF ZSubParm < 0 THEN _ EXIT SUB WasX$ = ZKeyPressed$ IF WasX$ = "" THEN _ IF ZLocalUser THEN _ GOTO 3730 _ ELSE GOTO 3732 IF WasX$ = ZEscape$ THEN _ ZKeyPressed$ = WasX$ : _ EXIT SUB SendRemote = ZTrue WasZ = INSTR(ZLineEditChk$,WasX$) IF WasZ < 1 THEN _ GOTO 3750 _ ELSE IF WasZ > 4 THEN _ GOTO 3870 _ ' DA060901 ELSE IF WasZ = 1 THEN _ ' DA060901 GOTO 3810 ' DA060901 IF ZLocalUser THEN _ GOTO 3730 3732 IF ZCommPortStack$ <> "" THEN _ WasX$ = LEFT$(ZCommPortStack$,1) : _ ZCommPortStack$ = RIGHT$(ZCommPortStack$,LEN(ZCommPortStack$)-1) : _ GOTO 3738 CALL EofComm (Char) IF Char <> -1 THEN _ GOTO 3736 CALL CheckTime(ZAutoLogoff!, TempElapsed!, 1) IF TempElapsed! <=0 THEN _ ZWaitExpired = ZTrue : _ EXIT SUB 3733 CALL Carrier IF ZSubParm THEN _ EXIT SUB GOTO 3730 3736 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect 3737 CALL GetCom (WasX$) 3738 SendRemote = ZRemoteEcho 3740 ON INSTR(ZLineEditChk$,WasX$) GOTO 3810,3730,3730,3730, _ ' DA060901 3870,3870,3870,3870,3870 ' DA060901 3750 IF SendRemote THEN _ CALL PutCom(WasX$) CALL LPrnt (WasX$, 0) IF WasX$ = ZCarriageReturn$ THEN _ Col = Col - 1 : _ GOTO 3850 3770 IF Col > WasXXX THEN _ IF WasX$ = " " THEN _ CALL SkipLine (1) : _ GOTO 3860 3780 MID$(ZLineMes$,Col) = WasX$ 3782 IF Col < MaxLen THEN _ GOTO 3720 WasZ = Col 3800 IF WasZ < 1 THEN _ WasZ = Col-1 : _ GOTO 3820 IF MID$(ZLineMes$,WasZ,1) = " " THEN _ GOTO 3820 WasZ = WasZ - 1 GOTO 3800 3810 TabToSpace = 5 - (Col MOD 5) ' DA060901 GOTO 3730 ' DA060901 3820 IF (NOT ZRemoteEcho) AND (NOT ZLocalUser) THEN _ CALL SkipLine (1) : _ GOTO 3860 Col = MaxLen - WasZ IF ZSnoop THEN _ IF (POS(0) > Col) AND (Col > 0) THEN _ LOCATE ,POS(0)-Col: _ CALL LPrnt(STRING$(Col,32),0) 3830 IF ZRemoteEcho THEN _ CALL PutCom (STRING$(Col,8) + STRING$(Col,32)) 3840 ZOutTxt$(MsgLine) = LEFT$(ZLineMes$,WasZ) ZOutTxt$(MsgLine + 1) = MID$(ZLineMes$,WasZ + 1,Col) CALL SkipLine (1) GOTO 3891 3850 IF SendRemote AND ZLineFeeds THEN _ CALL PutCom(ZLineFeed$) 3860 ZOutTxt$(MsgLine) = LEFT$(ZLineMes$,Col) GOTO 3891 3870 IF Col = 1 THEN _ GOTO 3730 Col = Col-2 3880 CALL LPrnt(ZLocalBksp$,0) 3885 IF SendRemote THEN _ CALL PutCom (ZBackSpace$) 3890 GOTO 3720 3891 CALL Carrier END SUB 3952 ' $SUBTITLE: 'KillMsg - subroutine to delete messages' ' $PAGE ' ' NAME -- KillMsg ' ' INPUTS -- PARAMETER MEANING ' MsgToKill MESSAGE NUMBER TO KILL ' ActiveMessages NUMBER ACTIVE MESSAGES ' ' OUTPUTS -- NONE ' ' PURPOSE -- To kill/delete old or unnecessary messages ' SUB KillMsg (MsgToKill,ActiveMessages) STATIC ' FIELD #1,128 AS ZMsgRec$ WasQX = 1 3955 IF WasQX > ActiveMessages THEN _ ZOutTxt$ = "No such msg #" + _ STR$(MsgToKill) : _ GOTO 4031 IF ZMsgPtr(WasQX,2) = MsgToKill AND MsgToKill => 1 THEN _ GOTO 3970 WasQX = WasQX + 1 GOTO 3955 3970 ZSubParm = 3 CALL FileLock GET 1,ZMsgPtr(WasQX,1) IF ZUserSecLevel >= ZSecKillAny THEN _ GOTO 4030 3980 ZWasZ$ = MID$(ZMsgRec$,101,15) CALL Trim (ZWasZ$) IF LEN(ZWasZ$) = 0 THEN _ GOTO 4030 3990 IF ZWasZ$ = "^READ^" OR ZWasZ$ = "^KILL^" THEN _ CALL MsgNameMatch (ZActiveUserName$,"",6,MsgFromCaller) : _ CALL MsgNameMatch (ZActiveUserName$,"",37,MsgToCaller) : _ IF (MsgFromCaller or MsgToCaller) THEN _ GOTO 4030 _ ELSE ZMsgPswd = ZTrue : _ ZAttemptsAllowed = 0 : _ ZOutTxt$ = "Only sender & receiver can kill" : _ GOTO 4031 4000 IF LEFT$(ZWasZ$,1) = "!" THEN _ ZWasZ$ = MID$(ZWasZ$,2) 4010 ZPswdSave$ = ZWasZ$ + _ SPACE$(15 - LEN(ZWasZ$)) ZAttemptsAllowed = 1 ZMsgPswd = ZTrue CALL PassWrd IF ZPswdFailed THEN _ GOTO 4031 4030 MID$(ZMsgRec$,116,1) = ZDeletedMsg$ PUT 1,LOC(1) ZSubParm = 4 CALL FileLock ZOutTxt$ = "Killed Msg # " + _ STR$(MsgToKill) CALL UpdtCalr (ZOutTxt$,1) 4031 ZSubParm = 5 CALL TPut END SUB 4554 ' $SUBTITLE: 'SetThread - Sets up the interface for threading' ' $PAGE ' ' NAME -- SetThread ' ' INPUTS -- PARAMETER MEANING ' CurMsgNum Current message number ' CurSubj$ Current message subject ' ' OUTPUTS -- ZUserIn$() Search msg by string ' ZWasQ 0 if thread cancelled ' ' PURPOSE -- Find out how the caller wants to thread - ' i.e. search messages by matching subject - ' forward from current, back from current, ' or forward from top of messages ' SUB SetThread (CurMsgNum,CurSubj$) STATIC IF ZWasQ > 1 THEN _ ZWasZ$ = ZUserIn$(2) : _ GOTO 4657 4656 ZOutTxt$ = "THREAD: +)forward, -)back, 1)from origin ([ENTER] quits)" ZTurboKey = -ZTurboKeyUser ZSubParm = 1 CALL TGet IF ZWasQ = 0 OR ZSubParm = -1 THEN _ EXIT SUB ZWasZ$ = ZUserIn$(1) 4657 ZWasZ$ = LEFT$(ZWasZ$,1) WasX = INSTR("+-1",ZWasZ$) IF WasX = 0 THEN _ GOTO 4656 ZUserIn$(1) = "R" IF WasX = 1 THEN _ CurMsgNum = CurMsgNum + 1 _ ELSE IF WasX = 2 THEN _ CurMsgNum = CurMsgNum - 1 _ ELSE CurMsgNum = 1 : _ ZWasZ$ = "+" ZUserIn$(3) = MID$(STR$(CurMsgNum),2) + ZWasZ$ IF LEN(CurSubj$) < 4 OR LEFT$(CurSubj$,3) <> "(R)" THEN _ ZUserIn$(2) = CurSubj$ _ ELSE ZUserIn$(2) = MID$(CurSubj$,4) ZUserIn$(2) = LEFT$(ZUserIn$(2) + " ",22) ZLastIndex = 3 ZAnsIndex = 1 ZWasQ = 3 END SUB 4773 ' $SUBTITLE: 'SysopChat - chat with sysop' ' $PAGE ' ' NAME -- SysopChat ' ' INPUTS -- PARAMETER MEANING ' OUTPUTS -- ZWasCM True if chat active ' ' PURPOSE -- Lets sysop chat interactively with caller ' SUB SysopChat STATIC ZWasCM = ZTrue TimeChatStarted! = TIMER ZSubParm = 1 CALL Line25 ZOutTxt$(2) = "" 4775 CALL LineEdit (1,72) IF ZKeyPressed$ = ZEscape$ OR _ ZSubParm < 0 THEN _ GOTO 4777 ZOutTxt$(1) = "" IF ZOutTxt$(2) <> "" THEN _ ZOutTxt$ = ZOutTxt$(2) : _ ZOutTxt$(1) = ZOutTxt$(2) : _ ZOutTxt$(2) = "" _ ELSE ZOutTxt$ = "" ZSubParm = 4 CALL TPut IF ZSubParm > -1 THEN _ GOTO 4775 4777 ZWasCM = 0 CALL CheckTime(TimeChatStarted!,Elapsed!, 2) ZSecsPerSession! = ZSecsPerSession! + Elapsed! IF NOT ZLocalUser THEN _ ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect CALL QuickTPut(" Chat over. BBS resuming",2) ' KG071301 END SUB 5100 ' $SUBTITLE: 'RemNonAlf - removes non-alpha chars from a string' ' $PAGE ' ' NAME -- RemNonAlf ' ' INPUTS -- PARAMETER MEANING ' Strng$ String to check ' MinChar Remove chars with this ' ASCII value or lower ' MaxChar Remove chars with this ' ASCII value or higher ' ' OUTPUTS -- Strng$ String returned ' PURPOSE -- CALCULATE THE ELASPED TIME A USER HAS BEEN ON ' SUB RemNonAlf (Strng$,MinChar,MaxChar) STATIC Last = LEN(Strng$) WasJ = 1 WHILE WasJ <= Last WasK = ASC(MID$(Strng$,WasJ)) IF WasK > MinChar AND WasK < MaxChar THEN _ WasJ = WasJ + 1 _ ELSE Strng$ = LEFT$(Strng$,WasJ - 1) + _ RIGHT$(Strng$,Last - WasJ) : _ Last = Last - 1 WEND END SUB 5200 ' $SUBTITLE: 'PageLen - Sets lines per page' ' $PAGE ' ' NAME -- PageLen ' ' INPUTS -- PARAMETER MEANING ' ZPageLength Current page length ' ' OUTPUTS -- ZPageLength New page length ' ' PURPOSE -- Change default lines per page ' SUB PageLen STATIC 5202 ZOutTxt$ = "CHANGE page length from" + _ STR$(ZPageLength) + _ " TO (0-255, 0=continuous)" CALL PopCmdStack IF ZWasQ = 0 OR ZSubParm = -1 THEN _ CALL QuickTPut1 ("No change") : _ EXIT SUB 5230 CALL CheckInt (ZUserIn$(ZAnsIndex)) IF ZErrCode <> 0 THEN _ GOTO 5202 IF ZTestedIntValue < 0 OR _ ZTestedIntValue > 255 THEN _ GOTO 5202 ZPageLength = ZTestedIntValue CALL QuickTPut1 ("Page Length Set to" + STR$(ZPageLength)) END SUB 5507 ' $SUBTITLE: 'Baud450 -- Changes 300 baud to 450' ' $PAGE ' NAME -- Baud450 ' ' INPUTS -- PARAMETER MEANING ' ZBPS ' ' OUTPUTS -- ZBPS ' ' PURPOSE -- Allow 300 baud modems to bump up to 450 baud ' SUB Baud450 STATIC IF ZBPS <> -1 THEN _ CALL QuickTPut1 ("Sorry, only 300 baud can change speed") : _ EXIT SUB IF ZFossil THEN _ CALL QuickTPut1 ("Sorry, no 450 baud under FOSSIL") : _ ' KG071301 EXIT SUB ZOutTxt$ = "Change to 450 baud (Y,[N])" ZTurboKey = -ZTurboKeyUser ZSubParm = 1 CALL TGet IF ZSubParm = -1 OR NOT ZYes THEN _ EXIT SUB 5510 CALL QuickTPut1 ("Change your baud rate to 450") CALL DelayTime (9) ZWasC = 0 ZBPS = -2 CALL SetBaud ZOutTxt$ = " and then press [ENTER] until I respond" ZSubParm = 9 CALL TGet 5530 ZWasC = ZWasC + 1 CALL Carrier IF ZSubParm = -1 THEN _ EXIT SUB IF ZWasC = 20 THEN _ CALL UpdtCalr ("Baud change failed",1) : _ ZBPS = -1 : _ CALL SetBaud : _ EXIT SUB CALL DelayTime (1) 5535 CALL EofComm (Char) IF Char = -1 THEN _ GOTO 5530 5536 CALL PutCom(ZOutTxt$) IF ZOutTxt$ = "" THEN _ ZOutTxt$ = " " IF ASC(ZOutTxt$) = 13 THEN _ GOTO 5540 IF ZSubParm = -1 THEN _ EXIT SUB 5537 GOTO 5530 5540 ZOutTxt$ = "Changed to 450 baud" CALL QuickTPut1 (ZOutTxt$) CALL UpdtCalr (ZOutTxt$,1) ZBPS = -2 ZOutTxt$ = "" END SUB 9140 ' $SUBTITLE: 'GetTime - subroutine to calculate elapsed time' ' $PAGE ' ' NAME -- GetTime ' ' INPUTS -- PARAMETER MEANING ' ZTimeLoggedOn$ ' ' OUTPUTS -- ZSessionHour NUMBER OF HOURS ON ' ZSessionMin NUMBER OF MINUTES ON ' ZSessionSec NUMBER OF SECONDS ON ' ' PURPOSE -- Calculate the elapsed time a user has been on ' SUB GetTime STATIC CALL CheckTime(ZUserLogonTime!, TempElapsed!, 2) ZSessionHour = TempElapsed! / 3600 ZSessionMin = (TempElapsed! - ZSessionHour * 3600!) / 60 ZSessionSec = TempElapsed! - (ZSessionHour * 3600! + ZSessionMin * 60!) IF ZSessionSec < 0 THEN _ ZSessionSec = ZSessionSec + 60 : _ ZSessionMin = ZSessionMin - 1 IF ZSessionMin < 0 THEN _ ZSessionMin = ZSessionMin + 60 : _ ZSessionHour = ZSessionHour - 1 END SUB 9600 ' $SUBTITLE: 'DefaultU - subroutine to update user defauts' ' $PAGE ' ' NAME -- DefaultU ' ' INPUTS -- PARAMETER MEANING ' ZAutoDownDesired ' ZBoldText$ Ansi bold (0 no, 1 yes) ' ZCheckBulletLogon ' ZExpertUser ' ZWasGR ' ZLastMsgRead ' ZLineFeeds ' ZNulls ' ZPageLength ' ZPromptBell ' ZRegDate$ ' ZReqQuesAnswered ' ZRightMargin ' ZSkipFilesLogon ' ZTimesLoggedOn ' ZUpperCase ' ZUserOption$ ' ZUserTextColor Ansi of color (31-37) ' ZUserXferDefault$ ' ' OUTPUTS-- USER.OPTONS$ ' ' PURPOSE -- To update the user's record with their options. ' Meaning of graphics preference stored is as follows: where # is ' value stored for the color. E.g. if graphics perference for text ' files is color, and preference for normal text is light yellow, ' graphics preference stored is 38. Colors are Red, Green, Yellow, ' Blue, Purple, Cyan, and White. ' ' normal bold ' Graphics R G Y B P C W R G Y B P C W ' none 30 33 36 39 42 45 48 | 51 54 57 60 63 66 69 ' ansi 31 34 37 40 43 46 49 | 52 55 58 61 64 67 70 ' color 32 35 38 41 44 47 50 | 53 56 59 62 65 68 71 ' SUB DefaultU STATIC ZWasA = -ZPromptBell -2 * ZExpertUser _ -4 * ZNulls -8 * ZUpperCase _ -16 * ZLineFeeds -32 * ZCheckBulletLogon _ -64 * ZSkipFilesLogon -128 * ZAutoDownDesired _ -256 * ZReqQuesAnswered -512 * ZMailWaiting _ -1024 * (NOT ZHiLiteOff) -2048 * ZTurboKeyUser WasX = 3*ZUserTextColor - 63 + 21*VAL(ZBoldText$) + ZWasGR IF WasX < 1 OR WasX > 255 THEN _ WasX = 48 LSET ZUserOption$ = _ MKI$(ZTimesLoggedOn) + _ MKI$(ZLastMsgRead) + _ ZUserXferDefault$ + _ CHR$(WasX) + _ MKI$(ZRightMargin) + _ MKI$(ZWasA) + _ ZRegDate$ + _ CHR$(ZPageLength) + _ ZEchoer$ END SUB 9801 ' $SUBTITLE: 'WhosOn - subroutine to display who is on' ' $PAGE ' ' NAME -- WhosOn ' ' INPUTS -- PARAMETER MEANING ' NumNodes # of nodes to check ' ZActiveMessageFile$ Current message file ' ZOrigMsgFile$ Main msg file ' ' OUTPUTS -- None ' ' PURPOSE -- To display who is on each node. ' SUB WhosOn (NumNodes) STATIC WasA1$ = ZActiveMessageFile$ ZActiveMessageFile$ = ZOrigMsgFile$ CALL OpenMsg FIELD 1, 128 AS ZMsgRec$ FOR NodeIndex = 2 TO NumNodes + 1 GET 1,NodeIndex ZOutTxt$ = ZFG1$ + "Node" + _ STR$(NodeIndex - 1) + ZFG2$ RecIndex = VAL(MID$(ZMsgRec$,44,2)) IF RecIndex = 0 THEN _ RecIndex = -1 WasAX$ = MID$(ZBaudRates$,(-5 * RecIndex ),5) + _ " BAUD: " IF MID$(ZMsgRec$,55,2) = "-1" AND NOT ZSysop THEN _ ZWasY$ = "SYSOP" + SPACE$(21) _ ELSE ZWasY$ = MID$(ZMsgRec$,1,26) WasAX$ = WasAX$ + ZFG3$ + ZWasY$ IF MID$(ZMsgRec$,40,2) <> "-1" THEN _ WasAX$ = WasAX$ + ZFG4$ + MID$(ZMsgRec$,93,22) IF MID$(ZMsgRec$,57,1) = "A" THEN _ ZOutTxt$ = ZOutTxt$ + " Online at " + _ WasAX$ _ ELSE IF NOT ZSysop THEN _ ZOutTxt$ = ZOutTxt$ + _ " Waiting for next caller" _ ELSE ZOutTxt$ = ZOutTxt$ + _ " Offline at " + _ WasAX$ CALL QuickTPut1 (ZOutTxt$) CALL AskMore ("",ZTrue,ZTrue,ZAnsIndex,ZFalse) IF ZNo THEN _ NodeIndex = NumNodes + 2 NEXT ZActiveMessageFile$ = WasA1$ CALL QuickTPut (ZEmphasizeOff$,0) END SUB 10410 ' $SUBTITLE: 'RecoverMsg - sub to recover deleted messages' ' $PAGE ' ' NAME -- RecoverMsg ' ' INPUTS -- PARAMETER MEANING ' MsgToRecover MESSAGE NUMBER TO RECOVER ' FirstMsgRecord RECORD # FOR First MSG ' ' OUTPUTS -- ActionFlag SET TO 0 IF ERROR ' SET TO -1 IF No ERROR ' ' PURPOSE -- To recover deleted messages. Note that this is only ' possible if you have not compressed your message file ' using config. ' SUB RecoverMsg (MsgToRecover,FirstMsgRecord,ActionFlag) STATIC FIELD #1,128 AS ZMsgRec$ MsgRec = FirstMsgRecord 10420 GET 1,MsgRec NumRecsInMsg = VAL(MID$(ZMsgRec$,117,4)) IF NumRecsInMsg < 1 OR MsgRec => ZNextMsgRec THEN _ ZWasY$ = "No Msg #" + _ STR$(MsgToRecover) : _ GOTO 10485 10440 IF VAL(MID$(ZMsgRec$,2,4)) <> MsgToRecover THEN _ MsgRec = MsgRec + NumRecsInMsg : _ GOTO 10420 10450 IF INSTR(ZMsgRec$,ZDeletedMsg$) <> 0 THEN _ LSET ZMsgRec$ = LEFT$(ZMsgRec$,115) + _ ZActiveMessage$ + _ MID$(ZMsgRec$,117) : _ PUT 1,LOC(1) : _ ZWasY$ = "Restored Msg #" + _ STR$(MsgToRecover) : _ ActionFlag = ZTrue : _ GOTO 10485 10480 ZWasY$ = "Msg #" + _ STR$(MsgToRecover) + _ " not Dead" 10485 CALL QuickTPut1 (ZWasY$) END SUB 10600 ' $SUBTITLE: 'UpdateU -- Update the users record at logoff' ' $PAGE ' NAME -- UpdateU ' ' INPUTS -- PARAMETER MEANING ' ZAdjustedSecurity ' ZCurDate$ ' ZDnlds ' ZElapsedTime ' ZListDir ' ZMainUserFileIndex ' ZSecsPerSession! ' ZUplds ' ZUserSecLevel ' ' OUTPUTS -- ZElapsedTime$ ' ZListNewDate$ ' ZSecLevel$ ' ZUserDnlds$ ' ZUserUplds$ ' ' PURPOSE -- Update the user record for the user when the user ' exits RBBS-PC. ' SUB UpdateU (LoggingOff) STATIC IF ZActiveUserName$ = "" OR ZFirstName$ = "" THEN _ EXIT SUB IF ZActiveUserFile$ = ZOrigUserFile$ THEN _ ZUplds = ZGlobalUplds : _ ZDnlds = ZGlobalDnlds : _ ZDLToday! = ZGlobalDLToday! : _ ZBytesToday! = ZGlobalBytesToday! : _ ZDLBytes! = ZGlobalDLBytes! : _ ZULBytes! = ZGlobalULBytes! IF ZUserFileIndex < 1 THEN _ GOTO 10607 UpdateDefaults = ZTrue 10602 ZSubParm = 6 ZWasY$ = ZLastDateTimeOn$ ' KG070601 CALL FileLock CALL OpenUser (HighestUserRecord) FIELD 5,31 AS ZUserName$, _ 15 AS ZPswd$, _ 2 AS ZSecLevel$, _ 14 AS ZUserOption$, _ 24 AS ZCityState$, _ 3 AS MachineType$, _ 4 AS ZTodayDl$, _ 4 AS ZTodayBytes$, _ 4 AS ZDlBytes$, _ 4 AS ZULBytes$, _ 14 AS ZLastDateTimeOn$, _ 3 AS ZListNewDate$, _ 2 AS ZUserDnlds$, _ 2 AS ZUserUplds$, _ 2 AS ZElapsedTime$ 10604 GET 5,ZUserFileIndex LSET ZLastDateTimeOn$ = ZWasY$ ' KG070601 IF UpdateDefaults THEN _ CALL DefaultU IF ZListDir THEN _ LSET ZListNewDate$ = CHR$(VAL(MID$(ZCurDate$,7,2))) + _ CHR$(VAL(MID$(ZCurDate$,1,2))) + _ CHR$(VAL(MID$(ZCurDate$,4,2))) 10605 LSET ZUserDnlds$ = MKI$(ZDnlds) LSET ZUserUplds$ = MKI$(ZUplds) IF ZEnforceRatios THEN _ LSET ZTodayDl$ = MKS$(ZDLToday!) : _ LSET ZTodayBytes$ = MKS$(ZBytesToday!) : _ LSET ZDlBytes$ = MKS$(ZDLBytes!) : _ LSET ZULBytes$ = MKS$(ZULBytes!) CALL CheckTime (ZUserLogonTime!, ZSecsUsedSession!, 2) IF (NOT ZExitToDoors) AND LoggingOff THEN _ TempElapsed! = ZElapsedTime + _ (ZSecsUsedSession! - ZTimeCredits!) / 60 : _ ZTimeCredits! = 0 _ ELSE TempElapsed! = ZElapsedTime IF TempElapsed! < -32767 THEN _ TempElapsed! = -32767 _ ELSE IF TempElapsed! > 32767 THEN _ TempElapsed! = 32767 LSET ZElapsedTime$ = MKI$(TempElapsed!) IF ZAdjustedSecurity THEN _ LSET ZSecLevel$ = MKI$(ZUserSecLevel) PUT 5,ZUserFileIndex ZSubParm = 8 CALL FileLock IF ZActiveUserFile$ <> ZOrigUserFile$ AND LoggingOff THEN _ ZActiveUserFile$ = ZOrigUserFile$ : _ ZUserFileIndex = ZOrigUserFileIndex : _ UpdateDefaults = ZFalse : _ LSET ZLastDateTimeOn$ = ZOrigDateTimeOn$ : _ ' KG070601 GOTO 10602 10607 IF ZExitToDoors OR NOT LoggingOff THEN _ EXIT SUB Temp = ZMinsPerSession IF ZMaxPerDay > 0 THEN _ Temp = ZMaxPerDay - TempElapsed! : _ IF Temp > ZMinsPerSession THEN _ Temp = ZMinsPerSession Temp = -(Temp > 0) * Temp CALL QuickTPut1 (STR$(Temp)+" min left for next call today") CALL QuickTPut1 (ZFirstName$ + ", Thanks and please call again!") IF NOT ZHiLiteOff THEN _ CALL QuickTPut1 (ZColorReset$) CALL DelayTime (8 + ZBPS) END SUB 10935 ' $SUBTITLE: 'DosExit -- Setup to exit to DOS for ZSysop' ' $PAGE ' NAME -- DosExit ' ' INPUTS -- PARAMETER MEANING ' ZComPort$ ' ZDoorsTermType ' ZMultiLinkPresent ' ZRBBSBat$ ' ZRedirectIOMethod ' ZUseDeviceDriver$ ' ' OUTPUTS -- ZWasQ NUMBER OF LINES TO WRITE OUT TO ' ZRCTTYBat$ ' ZUserIn$() LINES TO WRITE OUT TO ZRCTTYBat$ ' ' PURPOSE -- Set up ZUserIn$() and ZWasQ in order to call "RBBSExit" and ' exit to DOS for the remote RBBS-PC sysop ' SUB DosExit STATIC IF ZMultiLinkPresent AND _ ZDoorsTermType > 0 THEN _ ZFF = 0 : _ GOTO 10950 ZOutTxt$(1) = "ECHO OFF" IF ZUseDeviceDriver$ <> "" THEN _ Port$ = ZUseDeviceDriver$ _ ELSE Port$ = "COM" + RIGHT$(ZComPort$,1) IF ZRedirectIOMethod THEN _ ZFF = 5 : _ ZOutTxt$(2) = "CTTY " + _ Port$ : _ ZOutTxt$(3) = ZDiskForDos$ + _ "COMMAND" : _ ZOutTxt$(4) = "CTTY CON" : _ ZOutTxt$(5) = ZRBBSBat$ _ ELSE ZFF = 3 : _ ZOutTxt$(2) = ZDiskForDos$ + _ "COMMAND >" + _ Port$ + _ " <" + _ Port$ : _ ZOutTxt$(3) = ZRBBSBat$ 10950 CALL AMorPM CALL UpdtCalr ("Exited to DOS at " + ZTime$,2) CALL QuickTPut1 ("RBBS-PC " + ZVersionID$) CALL QuickTPut1 ("SYSOP in Remote Console Mode") CALL RBBSExit (ZOutTxt$(),ZFF) END SUB 10976 ' $SUBTITLE: 'WordInFile -- Searches a file to find a word' ' $PAGE ' NAME -- WordInFile ' ' INPUTS -- PARAMETER MEANING ' FilName$ FILE TO SEARCH IN ' Strng$ STRING TO SEARCH FOR ' ' OUTPUTS -- InFile WHETHER STRING Found IN FILE ' ' PURPOSE -- Searches for "Strng$" in file "FILNAME$." Used to ' limit doors and questionnaires to those specified ' in their menu files. The "Strng$" is capitalized ' but not the lines in the file, so must be exact ' case-sensitive match to be found. The only character ' that can immediately proceed or end a name to be ' found must be a blank. ' SUB WordInFile (FilName$,Strng$,InFile) STATIC InFile = ZFalse CALL FindIt (FilName$) IF NOT ZOK THEN _ EXIT SUB WasX = 0 CALL AllCaps (Strng$) WHILE NOT EOF(2) AND WasX < 1 LINE INPUT #2,ZOutTxt$ WasY = 1 10978 WasX = INSTR(WasY,ZOutTxt$,Strng$) IF WasX < 1 THEN _ GOTO 10980 WasY = WasX + 1 IF WasX > 1 THEN _ IF MID$(ZOutTxt$,WasX - 1,1) <> " " THEN _ WasX = 0 IF WasX > 0 THEN _ WasL = LEN(Strng$) : _ IF LEN(ZOutTxt$) => (WasX + WasL) THEN _ IF MID$(ZOutTxt$,WasX + WasL,1) <> " " THEN _ WasX = 0 IF WasX = 0 THEN _ GOTO 10978 10980 WEND CLOSE 2 InFile = (WasX > 0) END SUB 10983 ' $SUBTITLE: 'DoorExit -- Setup to exit to a "door"' ' $PAGE ' NAME -- DoorExit ' ' INPUTS -- PARAMETER MEANING ' ZMultiLinkPresent ' ZNodeID$ ' ZRBBSBat$ ' ZWasZ$ ' ' OUTPUTS -- ZWasQ NUMBER OF LINES TO WRITE OUT TO ' ZRCTTYBat$ ' ZUserIn$() LINES TO WRITE OUT TO ZRCTTYBat$ ' ' PURPOSE -- Set up ZUserIn$() and ZWasQ in order to call "EXITRBBS" and ' exit RBBS-PC to invoke another program ' SUB DoorExit (ReqDoorsDef) STATIC ' KG032502 IF ZWasZ$ = "" OR _ ZWasZ$ = "NONE" THEN _ EXIT SUB CALL FindIt (ZWasZ$) IF NOT ZOK THEN _ GOTO 10986 CALL BreakFileName (ZWasZ$,WasX$,ExitTo$,ExitMethod$,ZFalse) ' KG032501 ExitMethod$ = "" ZDooredTo$ = ExitTo$ CALL FindIt (ZDoorsDef$) IF NOT ZOK THEN _ IF ReqDoorsDef THEN _ ' KG032502 EXIT SUB _ ' KG032502 ELSE ExitTo$ = ExitTo$ + " " + ZNodeID$ : _ ' KG032502 GOTO 10989 ' KG032502 10985 CALL ReadParms (ZOutTxt$(),8,1) IF ZErrCode > 0 THEN _ IF ReqDoorsDef THEN _ ' KG032502 EXIT SUB _ ' KG032502 ELSE ExitTo$ = ExitTo$ + " " + ZNodeID$ : _ ' KG032502 GOTO 10989 ' KG032502 IF ExitTo$ <> ZOutTxt$(1) THEN _ GOTO 10985 CALL CheckInt (ZOutTxt$(2)) IF ZErrCode > 0 THEN _ ZErrCode = 0 : _ GOTO 10985 IF ZUserSecLevel < ZTestedIntValue THEN _ CALL QuickTPut1 ("Insufficient security for door") : _ EXIT SUB WasX$ = LEFT$(ZOutTxt$(5),INSTR(ZOutTxt$(5)+" "," ")-1) CALL FindIt (WasX$) IF NOT ZOK THEN _ GOTO 10986 ZFileName$ = ZOutTxt$(3) ExitMethod$ = ZOutTxt$(4) ExitTemplate$ = ZOutTxt$(5) ZDoorDisplay$ = ZOutTxt$(7) DoorTime$ = ZOutTxt$(8) CALL AskUsers CALL SmartText (ExitTemplate$,ZFalse,ZFalse) CALL MetaGSR (ExitTemplate$,ZFalse) ExitTo$ = ExitTemplate$ GOTO 10989 10986 ZOutTxt$ = "Missing door program" CALL UpdtCalr (ZOutTxt$ + " " + ZWasZ$,1) ZSnoop = ZTrue CALL LPrnt (ZOutTxt$,1) EXIT SUB 10989 IF ZTransferFunction = 3 THEN _ ZWasY$ = "Registration" _ ELSE ZWasY$ = ZDooredTo$ ZOutTxt$ = ZWasY$ + _ " door opened at " + _ TIME$ + _ " on " + _ DATE$ ZSubParm = 5 CALL TPut CALL UpdtCalr (ZDooredTo$ + " door opened!",2) CLOSE 2 OPEN "O",2,"DORINFO" + _ ZNodeFileID$ + _ ".DEF" PRINT #2,ZRBBSName$ PRINT #2,ZSysopFirstName$ PRINT #2,ZSysopLastName$ IF ZLocalUser THEN _ PRINT #2,"COM0" _ ELSE PRINT #2,ZComPort$ ZUserIn$ = MID$(ZBaudParity$,INSTR(ZBaudParity$," B")) PRINT #2,ZTalkToModemAt$;ZUserIn$ PRINT #2,ZNetworkType IF ZGlobalSysop THEN _ PRINT #2,"SYSOP" : _ PRINT #2,"" _ ELSE PRINT #2,ZFirstName$ : _ PRINT #2,ZLastName$ PRINT #2,ZCityState$ PRINT #2,ZWasGR PRINT #2,ZUserSecLevel CALL TimeRemain (MinsRemaining) CALL CheckInt (DoorTime$) IF ZErrCode = 0 AND ZTestedIntValue > 0 THEN _ IF MinsRemaining > ZTestedIntValue THEN _ MinsRemaining = ZTestedIntValue PRINT #2,INT(MinsRemaining) PRINT #2,ZFossil IF ExitMethod$ = "S" THEN _ CLOSE 4 : _ ' KG052401 CALL ShellExit (ExitTemplate$) : _ ZPrevCaller$ = "" : _ ' KG052401 CALL SetCall : _ ' KG052401 ZExitToDoors = ZTrue : _ CALL BufFile (ZDoorDisplay$,WasX) : _ CALL DoorReturn _ ELSE ZOutTxt$(1) = ZDiskForDos$ + _ "COMMAND /C " + _ ExitTo$ : _ ZOutTxt$(2) = ZRBBSBat$ : _ CALL RBBSExit (ZOutTxt$(),2) END SUB 10992 ' $SUBTITLE: 'RBBSExit -- Setup to exit RBBS' ' $PAGE ' NAME -- RBBSExit ' ' INPUTS -- PARAMETER MEANING ' LINE.ARA Array of lines to write to batch file ' NumLines How many lines in array ' ' OUTPUTS -- ZRCTTYBat$ ' ' PURPOSE -- To create a batch file that control can be passed to ' and to exit RBBS-PC while still keeping carrier up ' SUB RBBSExit (LineAra$(1),NumLines) STATIC CLOSE 2 IF NumLines = 0 THEN _ GOTO 10994 OPEN "O",2,ZRCTTYBat$ FOR WasI = 1 TO NumLines IF LineAra$(WasI) <> "" THEN _ PRINT #2,LineAra$(WasI) NEXT CLOSE 2 10994 CLOSE 3 ZExitToDoors = ZTrue IF NOT ZFossil THEN _ OUT ZModemCntlReg,INP(ZModemCntlReg) OR 1 IF NOT ZPrivateDoor THEN _ CALL MLInit (2) 10996 CALL UpdateU (ZTrue) CALL GetTime CALL SaveProf (1) IF NumLines = 0 THEN _ EXIT SUB CALL DelayTime (9 + ZBPS) IF ZFossil THEN _ CALL FOSExit(ZComPort) SYSTEM END SUB 12000 ' $SUBTITLE: 'SetSection -- Setup section prompts' ' $PAGE ' NAME -- SetSection Doug Azzarito ' ' INPUTS -- PARAMETER MEANING ' ZMenuIndex 2 = user is in MAIN section ' 3 = user is in FILE section ' 4 = user is in UTIL section ' 6 = user is in LIBR section ' ' OUTPUTS -- ZSection$ 4 character section name ' ZActiveMenu$ 1 character section name ' ZSectionPrompt$ Section name (if ZShowSection config) ' ZCmdPrompt$ Command input prompt string ' ZSectionOpts$ List of options valid in this sect ' ZInvalidOpts$ List of options invalid in this sect ' ZSubSection Index into security array for section ' ' PURPOSE -- To build the prompt strings for the current section ' SUB SetSection STATIC IF ZMenuIndex <> 6 THEN _ ZCurDirPath$ = ZDirPath$ ON ZMenuIndex GOTO 12001, 12010,12005,12020,12001,12015 12001 EXIT SUB 12005 LSET ZSection$ = "FILE" ZSectionOpts$ = ZFileOpts$ ZInvalidOpts$ = ZInvalidFileOpts$ ZSubSection = ZBegFile GOTO 12025 12010 LSET ZSection$ = "MAIN" ZSectionOpts$ = ZMainOpts$ ZInvalidOpts$ = ZInvalidMainOpts$ ZSubSection = ZBegMain GOTO 12025 12015 LSET ZSection$ = "LIBR" ZSectionOpts$ = ZLibOpts$ ZInvalidOpts$ = ZInvalidLibraryOpts$ ZSubSection = ZBegLibrary ZCurDirPath$ = ZLibDirPath$ GOTO 12025 12020 LSET ZSection$ = "UTIL" ZSectionOpts$ = ZUtilOpts$ ZInvalidOpts$ = ZInvalidUtilOpts$ ZSubSection = ZBegUtil 12025 ZActiveMenu$ = LEFT$(ZSection$,1) LSET ZLastCommand$ = ZActiveMenu$ + " " IF ZShowSection THEN _ ZSectionPrompt$ = ZSection$ _ ELSE ZSectionPrompt$ = "Your" IF ZCmndsInPrompt=0 THEN _ ZSectionOpts$ = "" ZCmdPrompt$ = ZSectionPrompt$ + _ " command" + _ ZSectionOpts$ END SUB 12878 ' $SUBTITLE: 'UntilRight - asks question until answer okay' ' $PAGE ' ' NAME -- UntilRight ' ' INPUTS -- PARAMETER MEANING ' Ques$ QUESTION TO BE ASKED THE USER ' Ans$ LOCATION TO STORE THE ANSWER ' MinLen MINIMUM LENGTH OF ANSWER ' MaxLen MAX LENGTH OF ANSWER ' ' OUTPUTS -- Ans$ RESPONSE TO THE QUESTION WHICH THE ' CALLERS SAYS IS CORRECT ' ' PURPOSE -- Subroutine to ask a user a question until the caller ' responds that the answer is correct ' SUB UntilRight (Ques$,Ans$,MinLen,MaxLen) STATIC 12880 ZSubParm = 1 ZOutTxt$ = Ques$ CALL TGet IF ZSubParm = -1 THEN _ GOTO 12882 IF ZWasQ = 0 THEN _ GOTO 12880 IF LEN(ZUserIn$(1)) > MaxLen THEN _ CALL QuickTPut1 (STR$(MaxLen) + " chars max") : _ GOTO 12880_ ELSE IF LEN(ZUserIn$(1)) < MinLen THEN _ CALL QuickTPut1 (STR$(MinLen) + " chars min") : _ GOTO 12880 Ans$ = ZUserIn$(1) ZOutTxt$ = ZUserIn$(1) + _ ", right ([Y],N)" ZTurboKey = -ZTurboKeyUser ZSubParm = 1 CALL TGet IF ZSubParm = -1 THEN _ GOTO 12882 IF ZNo THEN _ GOTO 12880 CALL AllCaps (Ans$) EXIT SUB 12882 Ans$ = "GUEST" END SUB 13660 ' $SUBTITLE: 'LogError - sub to log errors to CALLERS file' ' $PAGE ' ' NAME -- LogError ' ' INPUTS -- PARAMETER MEANING ' ERR ERROR NUMBER DETECTED BY BASIC ' ERL Last LINE NUMBER ENCOUNTERED ' PRIOR TO ENCOUNTERNING ERROR ' ' OUTPUTS -- NONE ' ' PURPOSE -- To set up a string to write to the callers log ' indicating the date, time, error, and error line ' SUB LogError STATIC WasIX = ERR IF ERR < 1 THEN _ WasIX = ZErrCode CALL UpdtCalr("+++ Error " + _ STR$(WasIX) + _ " line " + _ STR$(ERL) + _ " at " + _ TIME$ + _ " on " + _ DATE$,2) END SUB ' 20096 ' $SUBTITLE: 'CheckRatio - subroutine to print ul/dl ratio' ' $PAGE ' ' NAME -- CheckRatio ' ' INPUTS -- PARAMETER MEANING ' TellUser TELL USER THEIR RATIO ' ZDnlds FILES DOWNLOADED ' ZDLBytes! BYTES DOWNLOADED ' ZUplds FILES UPLOADED ' ZULBytes! BYTES UPLOADED ' ' OUTPUTS -- ZOK -1 if okay to download, 0 otherwise ' ' PURPOSE -- To determine whether the users violated ' their upload to download restriction ' SUB CheckRatio (TellUser) STATIC ZOK = ZTrue IF NOT ZEnforceRatios THEN _ GOTO 20110 IF ZRatioRestrict# <= 0 THEN _ GOTO 20110 ' ' Detemine method of ratio checking. Look ahead to amount downloaded ' IF ZByteMethod = 1 OR ZByteMethod = 3 THEN _ Method$ = "Bytes" : _ ULWork# = ZULBytes! : _ DLWork# = ZDLBytes! + ZNumDnldBytes! IF ZByteMethod = 0 OR ZByteMethod = 2 THEN _ Method$ = "Files" : _ ULWork# = ZUplds : _ DLWork# = ZDnlds + ZDownFiles IF ULWork# < ZInitialCredit# THEN _ ULWork# = ZInitialCredit# IF ZByteMethod = 2 THEN _ Today# = ZRatioRestrict# - ZDLToday! - ZDownFiles IF ZByteMethod = 3 THEN _ Today# = ZRatioRestrict# - ZBytesToday! - ZNumDnldBytes! ' Ratio# = 0 RatioSuffix$ = ":0" IF ULWork# > 0 THEN _ Ratio# = (DLWork# / ULWork#) : _ RatioSuffix$ = ":1" IF ZByteMethod > 1 THEN _ ZOutTxt$ = "Today Downloaded Files: " + STR$(ZDLToday! + ZDownFiles) + _ " Bytes:" + STR$(ZBytesToday! + ZNumDnldBytes!) : _ ZSubParm = 5 : _ CALL TPut : _ CALL SkipLine (1) : _ GOTO 20100 WasX$ = STR$(Ratio#) X = INSTR(WasX$,".") IF X > 0 THEN _ WasX$ = LEFT$(WasX$,X+1) ZOutTxt$ = Method$ + " Downloaded:" + STR$(DLWork#) + _ " Uploaded:" + _ STR$(ULWork#) + _ " Ratio:" + _ WasX$ + _ RatioSuffix$ ZSubParm = 5 CALL TPut ' ' CHECK TO SEE IF THE USER HAS VIOLATED THEIR UL/DL RESTRICTION ' 20100 IF NOT (ZRatioRestrict# > 0 AND TellUser) THEN _ EXIT SUB IF ZByteMethod <= 1 THEN _ GOTO 20105 IF Today# < 0 THEN _ ZOutTxt$ = "Sorry, Daily download limit of" + _ STR$(ZRatioRestrict#) + " " + _ Method$ + " Reached" : _ ZOK = ZFalse _ ELSE ZOutTxt$ = "Download balance:" + _ ' KG071301 STR$(Today#) + _ " " + _ Method$ : _ ZOK = ZTrue ZSubParm = 5 CALL TPut CALL SkipLine(1) EXIT SUB ' 20105 IF Ratio# > ZRatioRestrict# OR ULWork# = 0 THEN _ ZOK = ZFalse : _ ZOutTxt$ = "Sorry, DL/UL ratio of" + _ STR$(ZRatioRestrict#) + _ ":1 " + _ Method$ + " exceeded" : _ ZSubParm = 5 : _ CALL TPut : _ ZOutTxt$ = "Minimum upload of" + _ STR$(INT(((DLWork# - (ULWork# * ZRatioRestrict#)) _ / ZRatioRestrict#) + 1)) + _ + " " + Method$ + " required to download" _ ELSE ZOutTxt$ = "Balance remaining before upload required:" + _ STR$(INT((ULWork# * ZRatioRestrict#)-DLWork#)) + _ " " + Method$ ZSubParm = 5 CALL TPut CALL SkipLine (1) 20110 END SUB 20140 ' $SUBTITLE: 'GetArc - sub to get what files to verbose list' ' $PAGE ' ' NAME -- GetArc ' ' INPUTS -- PARAMETER MEANING ' ZWasQ NUMBER OF ENTRIES TYPED ' ZUserIn$() ENTRIES TYPED ' ' OUTPUTS -- ' ' PURPOSE -- Process the V)erbose list command. ' Takes what user types and tries to list it. ' SUB GetArc STATIC 20141 IF ZAnsIndex >= ZLastIndex THEN _ IF LEN(ZDefaultExtension$) > 0 THEN _ ' KG080101 CALL QuickTPut1 ("Default extension is "+ZDefaultExtension$) ' KG080101 ZOutTxt$ = "What compressed file(s)" + ZPressEnterExpert$ CALL PopCmdStack IF ZSubParm = -1 OR ZWasQ = 0 THEN _ EXIT SUB 20142 ZViolation$ = "View ARC" WasX = ZAnsIndex FOR ZAnsIndex = WasX TO ZLastIndex GOSUB 20143 IF ZSubParm < 0 THEN _ ZAnsIndex = ZLastIndex + 1 NEXT IF ZLastIndex > 1 THEN _ EXIT SUB _ ELSE GOTO 20141 20143 ZWasZ$ = ZUserIn$(ZAnsIndex) WasZ$ = ZWasZ$ ' KG022205 CALL AllCaps (ZWasZ$) CALL BreakFileName (ZWasZ$,Drive$,Prefix$,Ext$,ZFalse) IF Ext$ = "" THEN _ Ext$ = ZDefaultExtension$ : _ ZWasZ$ = ZWasZ$ + "." + ZDefaultExtension$ ZFileNameHold$ = ZWasZ$ ZFileName$ = ZWasZ$ CALL BadFile (Prefix$,BadFileNameIndex) ON BadFileNameIndex GOTO 20144,20146,20147 20144 CALL BadFile (ZFileName$,BadFileNameIndex) ON BadFileNameIndex GOTO 20145,20146,20147 20145 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount + (NOT ZSysop),ZTrue,"V") ' KG022204 IF ZOK THEN _ GOTO 20148 20146 ZWasZ$ = WasZ$ + _ ' KG022205 " not found!" CALL UpdtCalr (ZWasZ$,2) ZOutTxt$ = ZWasZ$ + _ " Type correct filename" + ZPressEnterExpert$ ZSubParm = 1 CALL TGet IF ZSubParm = -1 OR ZWasQ = 0 THEN _ RETURN ZUserIn$(ZAnsIndex) = ZUserIn$(1) GOTO 20143 20147 CALL SecViolation IF ZDenyAccess THEN _ EXIT SUB GOTO 20146 20148 WasX$ = ZDiskForDos$ + "V" + Ext$ + ".BAT" CALL FindIt (WasX$) IF NOT ZOK THEN _ GOTO 20150 ZGSRAra$(3) = MID$(RIGHT$(ZComPort$,1)+"0",1-ZLocalUser, 1) CALL ReadDir (2,1) IF EOF(2) THEN _ ZWasZ$ = ZOutTxt$ : _ ZGSRAra$(1) = ZFileName$ : _ ZGSRAra$(2) = ZArcWork$ _ ELSE ZWasZ$ = WasX$ + " " + ZFileName$ + _ " " + ZArcWork$ + " " + ZGSRAra$(3) CALL ShellExit (ZWasZ$) CALL BufFile (ZArcWork$,WasX) RETURN 20150 WasX = INSTR(".ARC.PAK.ZIP.LZH.","."+Ext$+".") 'IF (WasX < 1) OR (WasX = 1 AND NOT ZTurboRBBS) THEN _ IF (WasX < 1) THEN _ CALL QuickTPut1 ("View for "+Ext$+" not implemented") : _ RETURN CALL QuickTPut1 (ZFileNameHold$ + " has these files") CALL ViewArc RETURN END SUB 20235 ' $SUBTITLE: 'BadName - subroutine to find bad file names' ' $PAGE ' ' NAME -- BadName ' ' INPUTS -- PARAMETER MEANING ' ZActiveMessageFile$ ' ZActiveUserFile$ ' ZCallersFile$ ' ZCmntsFile$ ' CONFIG.FILEANAME$ ' ZMainMsgBackup$ ' ZMainMsgFile$ ' ZMaxViolations ' ZPswdFile$ ' ZRBBSBat$ ' ZRCTTYBat$ ' ZSubDir$() ' ZSubDirIndex ' ZViolation$ ' ZViolationsThisSession ' ZWasZ$ NAME OF FILE ' ' OUTPUTS -- BadFileNameIndex 1 = FILE NAME IS OK ' 2 = SECURITY BREACH TRIED ' ZViolationsThisSession NUMBER OF VIOLATIONS ' FileSpec$ NAME OF FILE ' ' PURPOSE -- To protect RBBS-PC against the use of bad file names ' to either crash the system or to breach RBBS-PC's security ' SUB BadName (BadFileNameIndex) STATIC ' ' ' * TEST FOR SYSTEM FILE ATTEMPT ' BadFileNameIndex = 2 ZWasZ$ = ZFileName$ CALL BreakFileName (ZFileName$,DR$,Prefix$,Extension$,ZFalse) IF LEN(Extension$) = 3 THEN _ IF INSTR("DEF,MNU,OLD,PUI,BAK,",Extension$+",") > 0 THEN _ EXIT SUB ZOK = 0 CALL FileNameCheck (ZActiveMessageFile$,Prefix$,Extension$) CALL FileNameCheck (ZActiveUserFile$,Prefix$,Extension$) CALL FileNameCheck (ZCallersFile$,Prefix$,Extension$) CALL FileNameCheck (ZCmntsFile$,Prefix$,Extension$) CALL FileNameCheck (ZFileSecFile$,Prefix$,Extension$) CALL FileNameCheck (ZMainMsgBackup$,Prefix$,Extension$) CALL FileNameCheck (ZOrigMsgFile$,Prefix$,Extension$) CALL FileNameCheck (ZOrigUserFile$,Prefix$,Extension$) CALL FileNameCheck (ZPswdFile$,Prefix$,Extension$) CALL FileNameCheck (ZRBBSBat$,Prefix$,Extension$) CALL FileNameCheck (ZRCTTYBat$,Prefix$,Extension$) CALL FileNameCheck (ZConfigFileName$,Prefix$,Extension$) IF ZOK > 0 THEN _ EXIT SUB BadFileNameIndex = 1 END SUB 20240 ' $SUBTITLE: 'FileNameCheck - checks file match except for drive' ' $PAGE ' ' NAME -- FileNameCheck ' ' INPUTS -- PARAMETER MEANING ' CheckThis$ Name of file to check ' Pref2$ Prefix to match against ' Ext2$ Extension to match against ' ' OUTPUTS -- ZOK 1 if got match ' ' PURPOSE -- Checks for match on both prefix and extension of a file ' name. Used to catch match on system files not to be ' downloaded. ' SUB FileNameCheck (CheckThis$,Pref2$,Ext2$) STATIC IF ZOK > 0 THEN _ EXIT SUB CALL BreakFileName (CheckThis$,DR$,Pref1$,Ext1$,ZFalse) IF Pref1$ = Pref2$ THEN _ IF Ext1$ = Ext2$ THEN _ ZOK = 1 END SUB