* ------------[ BLED merge (c) Ken Goosens ]------------- * Merge this against D:\172B\RBBSSUB4.BAS to produce RBBSSUB4.BAS * D:\172B\RBBSSUB4.BAS: Date 2-11-1990 Size 120641 bytes * ------------[ Created 08-26-1990 11:31:42 ]------------ * REPLACING old line(s) by new ' $linesize:132 * ------[ first line different ]------ ' $title: 'RBBSSUB4.BAS 17.3A, Copyright 1986 - 90 by D. Thomas Mack' ' DA081003 ' Copyright 1990 by D. Thomas Mack, all rights reserved. ' Name ...............: RBBSSUB4.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 64K code segment used by RBBS-PC.BAS. ' Parameters..........: Most parameters are passed via a COMMON statement. ' ' Subroutine Line Function of Subroutine ' Name Number ' AnyBut 59760 Determine where a "word" begins ' AskUsers 64003 Ask users questions based on a script and save answers ' AskMore 59858 Check whether screen full ' AutoPage 60300 Check whether to notify sysop caller is on ' BadFileChar 59800 Check file name for bad character ' Bracket 59960 Puts strings around a substring ' BufFile 58400 Write a file to the user quickly ' BufString 58300 Write a string with imbedded CR/LF to the user quickly ' CheckColor 59930 Highlighting based on search string ' SearchArray 58190 Check for the occurance of a string in an array ' ColorDir 59920 Adds colorization to FMS directory entry ' ColorPrompt 59940 Colorizes prompts ' CompDate 59880+ Produces a computational data from YY, MM, DD ' ConfMail 59854 Check conference mail waiting ' ConvertDir 58950 Checks for U & A (shorthand) and converts appropriately ' PackDate 59201 Compress date in string format to 2 characters ' EofComm 60000 Determine whether any chars in comm port buffer ' ExpireDate 59890 Calculate registration expiration date ' FakeXRpt 62650 Write out file transfer report for protocols that don't ' FindEnd 58770 Find where a "word" ends ' FindFile 58790 Determine whether a file exists without opening it ' FindLast 58600 Find last occurence of a string ' FMS 58200 Search the upload management system for entries ' GetAll 59780 Get list of all directories to display ' GetDirs 58895 Prompts for directories for file list/new/search cmds ' GetMsgAttr 62530 Restore attributes of original message ' GetYMD 59204 Pulls YY, MM, or DD from a 2 byte stored date ' GlobalSrchRepl 60100 Global search and replace ' LogPDown 59400 Records download in private directory ' MarkTime 60200 Give visual feedback during lengthy process ' MetaGSR 60130 Meta statement global search and replace ' MsgImport 59698 Allow local user to import a text file to a message ' Muzak 59100 Play musical themes for different RBBS functions ' NewPassword 60668 Get a new password ' PersFile 59300 View and select personal files for downloading ' Protocol 62600 Determine if external protocols are available ' PutMsgAttr 62520 Save attributes of original message ' Remove 58210 Remove characters from within strings ' RotorsDir 58700 Searches for a file using list of subdirs ' RptTime 62540 Report date/time and time on ' SetEcho 59600 Set RBBS properly for who is to echo ' SetHiLite 59934 Set user preference on highlighting ' SetGraphic 59980 Sets graphic preference for text file display ' SmartText 58250 Process SMART TEXT control strings ' SubMenu 59500 Processes options that have sub-menus ' TimedOut 63000 Write timed exit semaphore file ' TimeLock 60180 Check for TIME LOCK on certain features ' Transfer 62624 RBBS-PC support for external protocols for file transfer ' Toggle 57000 Toggles or views user options ' TwoByteDate 59200 Reduces a data to 2 byte string for space compression ' UnPackDate 59902 Uncompresses a 2 byte date ' UserColor 59965 Lets user set color for text and whether bold ' UserFace 59450 Processes programmable user interface ' ViewArc 64600 Display .ARC file contents to user ' PrivDoorRtn 62629 Private door exit routine ' WipeLine 58800 Wipes away a line so next prints in its place ' WordWrap 59710 Adjust a msg -- wrap lines and perserve paragraphs ' ' $INCLUDE: 'RBBS-VAR.BAS' ' * REPLACING old line(s) by new * ------[ first line different ]------ 57130 ZOutTxt$ = MID$("Skip Check",1 -5 * ZCheckBulletLogon,5) + _ ' DA071701 " old Bulletins in logon" ' DA071701 CALL QuickTPut1 (ZOutTxt$) RETURN * REPLACING old line(s) by new * ------[ first line different ]------ 57160 ZOutTxt$ = MID$("CheckSkip",1 -5 * ZSkipFilesLogon,5) + _ ' DA071701 " new files in logon" CALL QuickTPut1 (ZOutTxt$) RETURN * REPLACING old line(s) by new * ------[ first line different ]------ 58266 SmartHold$ = DATE$ ' DT Date ' KG021801 RETURN * REPLACING old line(s) by new 58267 CALL AMorPM * ------[ first line different ]------ SmartHold$ = ZTime$ ' TM Time ' KG021801 RETURN * REPLACING old line(s) by new 58301 CRat = INSTR(StartByte,Strng$,ZCarriageReturn$) IF CRat > 0 AND CRat < WasL THEN _ CRFound = (MID$(Strng$,CRat + 1,1) = ZLineFeed$) _ ELSE CRFound = ZFalse EOLlen = -2 * CRFound IF CRFound THEN _ EOD = CRat _ ELSE EOD = WasL + 1 NumBytes = EOD - StartByte StringWork$ = MID$(Strng$,StartByte,NumBytes) IF NOT ZDeleteInvalid THEN _ * ------[ first line different ]------ GOTO 58302 ' DA061002 Index = INSTR(StringWork$,"[") WasJ = LEN(StringWork$) - 1 WHILE Index > 0 AND Index < WasJ IF MID$(StringWork$,Index + 2,1) = "]" THEN _ IF INSTR (ZInvalidOpts$,MID$(StringWork$,Index + 1,1)) THEN _ MID$(StringWork$,Index + 1,1) = "*" Index = INSTR(Index + 1,StringWork$,"[") WEND * INSERTING new line(s) 58302 IF ZJumpSearching THEN _ ' DA061002 Temp$ = StringWork$ : _ CALL AllCaps (Temp$) : _ HiLitePos = INSTR (Temp$,ZJumpTo$) : _ IF HiLitePos = 0 THEN _ GOTO 58307 _ ELSE CALL Bracket (StringWork$,HiLitePos,HiLitePos+LEN(ZJumpTo$)-1,ZEmphasizeOn$,ZEmphasizeOff$) : _ ZJumpSearching = ZFalse IF ZSmartTextCode THEN _ CALL SmartText (StringWork$, CRFound, ZFalse) IF NOT ZLocalUser THEN _ ' DA061002 CALL EofComm (Char) : _ ' DA061002 IF Char <> -1 THEN _ ' DA061002 GOTO 58303 ' comm port input ' DA061002 ZKeyboardStack$ = INKEY$ : _ ' DA061002 IF ZKeyboardStack$ <> "" THEN _ ' keyboard input ' DA061002 GOTO 58303 ' DA061002 CALL QuickTPut (StringWork$, - (CRFound)) ' DA061002 GOTO 58304 ' DA061002 58303 ZOutTxt$ = StringWork$ ' DA061002 ZSubParm = 4 ' DA061002 IF CRFound THEN ZSubParm = 5 ' DA061002 CALL TPut ' DA061002 * REPLACING old line(s) by new * ------[ first line different ]------ 58304 IF ZRet THEN _ ' DA061002 EXIT SUB IF ZLinesPrinted < ZFF THEN _ GOTO 58307 * REPLACING old line(s) by new 58405 WasTU = WasTU + 1 IF WasTU < NumRecs THEN _ GET 2,WasTU _ ELSE IF WasTU = NumRecs THEN _ GET 2,WasTU : _ WasX = INSTR(SeqRec$,CHR$(26)) : _ IF WasX = 0 OR WasX > LenLastRec THEN _ DataSize = LenLastRec _ ELSE DataSize = WasX - 1 _ ELSE GOTO 58419 * ------[ first line different ]------ CALL BufString (SeqRec$,DataSize,AbortIndex) ' DA061002 * DELETING old line(s) 58406 58407 * REPLACING old line(s) by new 58700 ' $SUBTITLE: 'RotorsDir - search thru a list of subdirs for a file' ' $PAGE ' ' NAME -- RotorsDir ' ' INPUTS -- PARAMETER MEANING ' FilName$ FILE NAME TO LOOK FOR ' SDIR.ARA ARRAY OF SUBDIRECTORIES ' MaxSearch MAX # OF SUBDIRECTORIES ' MarkingTime WHETHER TO MARK TIME ' ' OUTPUTS -- FNAME$ ADD SUBDIRECTORY TO THE ' FILE NAME IF FOUND. OTHER- ' WISE DON'T. ' ZOK TRUE IF FILE WAS Found ' ' PURPOSE -- Hunt through a list of subdirectories to determine ' if a file is in any of them. If file is found, open ' the file as file #2, add the drive/path to the file ' name, and sets ZOK to true. If file isn't found, set ' file name to the last subdirectory searched -- which ' should be the upload subdirectory. ' ' If the library menu is selected (ZMenuIndex = 6), then ' only 2 subdirectories are searched. The first being ' the work disk and the second being the selected ' library disk. ' * ------[ first line different ]------ SUB RotorsDir (FilName$,SDirAra$(1),MaxSearch,MarkingTime,PassToMacro$) STATIC ' KG022204 ZOK = ZFalse ZDotFlag = ZFalse IF MarkingTime THEN _ CALL QuickTPut ("Searching for "+FilName$,0) IF ZMenuIndex = 6 THEN _ GOTO 58705 NumSearch = 1 WasX = 0 WHILE (NOT ZOK) AND NumSearch <= MaxSearch AND _ SDirAra$(NumSearch) <> "" IF MarkingTime THEN _ CALL MarkTime (WasX) WasX$ = SDirAra$(NumSearch) + _ FilName$ CALL FindFile (WasX$,ZOK) NumSearch = NumSearch + 1 WEND IF ZOK OR NOT ZFastFileSearch THEN _ ' KG022301 GOTO 58710 ' KG022301 CALL OpenRSeq (ZFastFileList$,HighRec,WasX,18) ' KG022301 IF ZErrCode <> 0 THEN _ ' KG022301 GOTO 58710 ' KG022301 CALL TrimTrail (FilName$,".") CALL BinSearch (FilName$,1,12,18,HighRec,RecFoundAt, RecFound$) ZOK = (RecFoundAt > 0) IF NOT ZOK THEN _ ' KG022301 GOTO 58710 ' KG022301 ZOK = ZFalse CALL CheckInt (MID$(RecFound$,13,4)) IF ZTestedIntValue < 1 THEN _ ' KG022301 GOTO 58710 ' KG022301 CALL OpenRSeq (ZFastFileLocator$,HighRec,WasX,66) IF ZErrCode <> 0 OR ZTestedIntValue > HighRec THEN _ ' KG022301 GOTO 58710 ' KG022301 FIELD 2, 66 AS LocatorRec$ GET 2, ZTestedIntValue WasX$ = LEFT$(LocatorRec$,63) CALL Trim (WasX$) IF LEFT$(WasX$,2) = "M!" THEN _ ZOK = ZFalse : _ ' KG022301 ZGSRAra$(1) = PassToMacro$ : _ ' KG022204 WasX$ = RIGHT$(WasX$,LEN(WasX$)-2) : _ ' KG022204 CALL Trim (WasX$) : _ ' KG022204 ZFileLocation$ = "" : _ ' KG022301 CALL MacroExe (WasX$) : _ ' KG022204 IF ZFileLocation$ = "" THEN _ ' KG022301 ZOK = ZFalse : _ ' KG022204 GOTO 58711 _ ' KG022301 ELSE WasX$ = ZFileLocation$ ' KG022301 WasX$ = WasX$ + FilName$ ' KG022301 CALL FindFile (WasX$,ZOK) ' KG022301 GOTO 58710 ' KG022301 * REPLACING old line(s) by new 58710 FilName$ = WasX$ * INSERTING new line(s) 58711 CALL SkipLine (-MarkingTime) ' KG021802 END SUB * REPLACING old line(s) by new 58900 ZOutTxt$ = ZDirPrompt$ ZMacroMin = 2 CALL PopCmdStack IF ZWasQ = 0 OR ZSubParm = -1 THEN _ EXIT SUB CALL AllCaps (ZUserIn$(ZAnsIndex)) IF ZUserIn$(ZAnsIndex) = "Q" THEN _ ZWasQ = 0 : _ EXIT SUB ZWasA = INSTR("E+.E-.E.L.H.?.",ZUserIn$(ZAnsIndex)+".") IF ZWasA = 0 THEN _ EXIT SUB IF ZWasA > 8 THEN _ IF ZAnsIndex < ZLastIndex THEN _ GOTO 58900 _ ELSE GOTO 58902 IF ZWasA = 7 THEN _ ZExtendedOff = NOT ZExtendedOff _ ELSE ZExtendedOff = (ZWasA > 3) * ------[ first line different ]------ CALL QuickTPut1 ("Extended directory display "+FNOffOn$(NOT ZExtendedOff)) ' DA071801 GOTO 58900 * REPLACING old line(s) by new * ------[ first line different ]------ 59303 CALL QuickTPut (ZEmphasizeOff$,0) ' KG030202 ZOutTxt$ = "Download what: L)ist, * = new, or file(s)" + _ ZPressEnterExpert$ ZMacroMin = 99 ZStackC = ZTrue CALL PopCmdStack IF ZSubParm = -1 OR ZWasQ = 0 THEN _ ZLastIndex = 0 : _ EXIT SUB * REPLACING old line(s) by new 59304 SelectedProtocol$ = "" IF ZLastIndex > 1 THEN _ IF LEN(ZUserIn$(ZLastIndex)) = 1 THEN _ SelectedProtocol$ = ZUserIn$(ZLastIndex) : _ * ------[ first line different ]------ CALL AllCaps (SelectedProtocol$) : _ ' KG081501 IF INSTR(ZDefaultXfer$,SelectedProtocol$) = 0 THEN _ ' KG081501 SelectedProtocol$ = "" _ ' KG081501 ELSE ZLastIndex = ZLastIndex - 1 ' KG081501 IF LEN(ZUserIn$(ZAnsIndex)) > 1 THEN _ GOTO 59330 CALL AllCaps (ZUserIn$(ZAnsIndex)) ON INSTR("L*",ZUserIn$(ZAnsIndex)) GOTO 59305,59327 GOTO 59303 * REPLACING old line(s) by new 59320 ZOutTxt$ = PartToPrint$ * ------[ first line different ]------ IF PersonalStatus$ = "*" AND LEFT$(ZOutTxt$,1) <> " " THEN _ MID$(ZOutTxt$, INSTR(ZOutTxt$," ")) = "*" ' DA080903 CALL ColorDir (ZOutTxt$,"Y") IF ZLocalUser THEN _ GOTO 59322 CALL EofComm (Char) IF Char <> -1 THEN _ GOTO 59323 ' comm port input * REPLACING old line(s) by new 59336 ZUserIn$(WasI) = LEFT$(PartToPrint$,INSTR(PartToPrint$," ") - 1) CALL FindFile (ZPersonalDrvPath$ + ZUserIn$(WasI),ZOK) IF ZOK THEN _ ZUserIn$(WasI) = ZPersonalDrvPath$ + ZUserIn$(WasI) _ ELSE CALL RotorsDir (ZUserIn$(WasI),ZSubDir$(),ZSubDirCount + _ ((ZUserSecLevel < ZMinSecToView) OR _ * ------[ first line different ]------ NOT ZCanDnldFromUp),ZTrue,"D") : _ ' KG022204 GOSUB 59338 RETURN * REPLACING old line(s) by new 59400 ' $SUBTITLE: 'LogPDown -- subroutine to record private downloads' ' $PAGE ' ' NAME -- LogPDown ' ' INPUTS -- PARAMETER MEANING ' ' OUTPUTS -- ' ' PURPOSE -- Puts a "!" in place of an "*" in private directory ' after downloaded ' * ------[ first line different ]------ SUB LogPDown (PrivateDnld,DwnIndex) STATIC ' RH021501 IF NOT PrivateDnld THEN _ EXIT SUB ZWasEN$ = ZPersonalDir$ WasBX = &H4 ZSubParm = 9 CALL FileLock WasL = 36 + ZMaxDescLen + ZPersonalLen CLOSE 2 IF ZShareIt THEN _ OPEN ZWasEN$ FOR RANDOM SHARED AS #2 LEN=WasL _ ELSE OPEN "R",2,ZPersonalDir$,WasL FIELD #2,WasL AS PersonalRec$ ZWasA = VAL(MID$(ZUserIn$(0),5 * (DwnIndex - 1) + 1,5)) ' RH021501 GET #2,ZWasA MID$(PersonalRec$,WasL-2,1) = "!" PUT #2,ZWasA CALL UnLockAppend END SUB * REPLACING old line(s) by new * ------[ first line different ]------ 59492 CALL QuickTPut1 ("No such option <" + ZWasZ$ + ">") ' DA071701 Call FlushKeys ' KG081703 GOTO 59460 END SUB * REPLACING old line(s) by new 59500 ' $SUBTITLE: 'SubMenu -- subroutine to process menus' ' $PAGE ' ' NAME -- SubMenu ' ' INPUTS -- PARAMETER MEANING ' PassedPrompt$ PROMPT TO DISPLAY ' CurMenu$ NOVICE MENU TO DISPLAY ' FrontOpt$ DRIVE/PATH/PREFIX OF FILE ' NEEDED FOR TYPED OPTION ' BackOpt$ SUFFIX/EXTENSION OF FILE ' NEEDED WITH TYPED OPTION ' ReturnOn$ LETTERS CALLING PROGRAM WANTS ' CONTROL ON ' GRDefault$ GRAPHICS DEFAULT TO USE ' VerifyInMenu WHETHER VERIFY OPTION IS IN MENU ' AllMenuOK WHETHER CONTROL SHOULD RETURN ' WHEN IN MENU ' ZAnsIndex # OF COMMANDS IN TYPE AHEAD ' RequireInMenu WHETHER OPTION MUST BE IN MENU ' ' OUTPUTS -- ZWasZ$ OPTION PICKED ' ZFileName$ NAME OF FILE SUPPORTING OPTION ' ' ' PURPOSE -- Handles menus - including conference, bulletins, ' doors, questionnaires. Supports sub-menus (i.e. ' an option on the menu that invokes another menu) ' SUB SubMenu (PassedPrompt$,CurMenu$,FrontOpt$, _ * ------[ first line different ]------ BackOpt$,ReturnOn$,GRDefault$,PassedVerifyInMenu, _' KG082005 AllMenuOK,RequireInMenu,BackOpt2$,InMenu) STATIC ' KG032502 * REPLACING old line(s) by new 59510 ZFileName$ = CurMenu$ * ------[ first line different ]------ InMenu = ZTrue ' KG041701 CALL BreakFileName (CurMenu$,MenuDrv$,WasX$,ZWasDF$,ZTrue) MenuFront$ = MenuDrv$ + WasX$ CALL Graphic (GRDefault$,ZFileName$) CurMenuVer$ = ZFileName$ ZStopInterrupts = ZFalse IF ZAnsIndex < ZLastIndex OR ZExpertUser THEN _ GOTO 59520 * REPLACING old line(s) by new 59530 ZWasZ$ = ZUserIn$(ZAnsIndex) CALL AllCaps (ZWasZ$) IF INSTR(ReturnOn$,ZWasZ$) THEN _ 'check whether calling pgm wants EXIT SUB IF INSTR("LH?",ZWasZ$) THEN _ 'check whether caller wants help GOTO 59515 IF INSTR(ZWasZ$,".") > 0 THEN _ GOTO 59532 * ------[ first line different ]------ CALL BadFile (ZWasZ$,WasBF) ' KG081705 IF WasBF > 1 THEN _ ' KG081705 GOTO 59532 ' KG081705 FPre$ = MenuFront$ ' check for sub-option ' KG081603 CALL BadFile (FPRE$ + ZWasZ$,WasBF) ' KG082401 ZOK = ZFalse ' KG082401 IF WasBF < 2 THEN _ ' KG082401 VerifyInMenu = ZFalse : _ ' KG082401 GOSUB 59538 ' KG082401 VerifyInMenu = PassedVerifyInMenu ' KG082005 IF NOT ZOK THEN _ ' KG081603 FPre$ = FrontOpt$ : _ ' check standard option ' KG081603 GOSUB 59538 : _ IF NOT ZOK THEN _ ' check option where menu is ' KG081603 FPre$ = MenuDrv$ : _ ' KG081603 GOSUB 59538 IF NewMenu THEN _ NewMenu = ZFalse : _ GOTO 59515 IF ZOK THEN _ EXIT SUB * REPLACING old line(s) by new * ------[ first line different ]------ 59538 FilName$ = FPre$ + ZWasZ$ ' KG081705 ZFileName$ = FilName$ + _ BackOpt$ CALL Graphic (GRDefault$,ZFileName$) IF NOT ZOK THEN _ IF BackOpt2$ <> "" THEN _ ZFileName$ = FilName$ + _ BackOpt2$ : _ CALL Graphic (GRDefault$,ZFileName$) IF ZOK THEN _ IF ZSysop OR (NOT RequireInMenu) THEN _ RETURN _ ELSE CALL WordInFile (CurMenu$,ZWasZ$,InMenu) : _ ' KG032502 IF InMenu THEN _ ' KG032502 RETURN _ ELSE GOTO 59540 IF (NOT VerifyInMenu) THEN _ GOTO 59540 CALL WordInFile (CurMenu$,ZWasZ$,InMenu) 'verify against menu itself ' KG032502 IF InMenu THEN _ ' KG032502 IF AllMenuOK THEN _ RETURN * REPLACING old line(s) by new 59540 WasX$ = FPre$ + _ ZWasZ$ + _ ".MNU" 'check whether option is a menu ZFileName$ = WasX$ CALL Graphic (GRDefault$,ZFileName$) IF ZOK THEN _ NewMenu = ZTrue : _ CurMenuVer$ = ZFileName$ : _ CurMenu$ = WasX$ : _ CALL BreakFileName (CurMenu$,MenuDrv$,WasX$,ZWasDF$,ZTrue) : _ * ------[ first line different ]------ MenuFront$ = MenuDrv$ + WasX$ ' KG082005 RETURN * REPLACING old line(s) by new 59547 CALL QuickTPut1 ("No such option " + ZWasZ$) ZLastIndex = 0 * ------[ first line different ]------ IF VerifyInMenu AND InMenu AND NOT RequireInMenu THEN _ ' KG082005 CALL UpdtCalr("Option " + ZWasZ$ + " on menu " + _ ' KG082005 CurMenu$ + " but not found",1) ' KG082005 RETURN * REPLACING old line(s) by new 59850 ' $SUBTITLE: 'ConfMail -- quickly checks mail waiting' ' $PAGE ' ' NAME -- ConfMail ' ' INPUTS -- PARAMETER MEANING ' SKIP.CONFIRM Whether to skip confirm of option ' ZConfMailList$ File of user/message pairs to check ' ZActiveUserFile$ Active user file (restored on exit) ' ZActiveMessageFile$ Active msg file (restored) ' OUTPUTS -- None ' ' PURPOSE -- Quicking scans message header record to get ' last msg # and user record to get whether any ' new mail and last msg read, reports both, using ' highlighting if new mail to caller. ' SUB ConfMail (MailCheckConfirm) STATIC SkipJoinUnjoin = ZNonStop IF ZStartHash = 1 AND ZUserFileIndex > 0 THEN _ CALL FindIt (ZConfMailList$) _ ELSE ZOK = ZFalse IF NOT ZOK THEN _ EXIT SUB * ------[ first line different ]------ IF PrevMailList$ <> ZConfMailList$ THEN _ ' KG072101 SkipParms = 0 ' KG072101 PrevMailList$ = ZConfMailList$ ' KG072101 IF MailCheckConfirm THEN _ ZOutTxt$ = "Check conferences for mail ([Y],N)" : _ ZTurboKey = -ZTurboKeyUser : _ CALL PopCmdStack : _ IF ZNo OR ZSubParm < 0 THEN _ EXIT SUB CALL BreakFileName (ZActiveUserFile$,WasX$,NowInPre$,NowInExt$,ZFalse) CALL BreakFileName (ZOrigUserFile$,WasX$,OrigPre$,OrigExt$,ZFalse) CALL SkipLine (1) CALL QuickTPut1 ("Checking Message Bases...") ' DA071701 AnyMail = ZFalse ZStopInterrupts = ZFalse WasA1$ = ZActiveUserFile$ MsgFileSave$ = ZActiveMessageFile$ TempIndivValue$ = "" UserFileIndexSave = ZUserFileIndex UserRecordHold$ = ZUserRecord$ ZOK = ZTrue CALL ReadParms (ZWorkAra$(),1,SkipParms) ' KG072101 IF SkipParms = 0 THEN _ ' KG072101 LogicalEOF$ = "" _ ' KG072101 ELSE LogicalEOF$ = ZWorkAra$(1) ' KG072101 * REPLACING old line(s) by new * ------[ first line different ]------ 59852 IF NOT ZOK THEN _ GOTO 59854 _ ' KG072101 ELSE IF EOF(2) THEN _ ' KG072101 IF LogicalEOF$ = "" OR SkipParms = 0 THEN _ ' KG073104 GOTO 59854 _ ' KG072101 ELSE CALL FindIt (ZConfMailList$) : _ ' KG072101 SkipParms = 0 : _ ' KG072901 GOTO 59852 ' KG072101 CALL ReadAny ZActiveUserFile$ = ZOutTxt$ CALL ReadAny IF ZErrCode > 0 THEN _ GOTO 59854 SkipParms = SkipParms + 2 ' KG080701 ZActiveMessageFile$ = ZOutTxt$ ' KG072901 CALL FindFile (ZActiveUserFile$,ZOK) IF NOT ZOK THEN _ GOTO 59854 CALL OpenUser (HighestUserRecord) FIELD 5, 128 AS ZUserRecord$ CALL FindFile (ZActiveMessageFile$,ZOK) IF NOT ZOK THEN _ GOTO 59854 CALL FindUser (ZOrigUserName$,"",ZStartHash,ZLenHash,_ 0,0,HighestUserRecord,_ Found,HoldUserFileIndex,ZWasSL) IF NOT Found THEN _ GOTO 59853 ' KG080701 CALL OpenMsg FIELD 1, 128 AS ZMsgRec$ GET 1,1 AnyMail = ZTrue WasX = CVI(MID$(ZUserRecord$,57,2)) WasX = (WasX AND 512) > 0 CALL BreakFileName (ZActiveUserFile$,WasX$,CurPre$,CurExt$,ZFalse) InCur = (CurPre$ = NowInPre$ AND CurExt$ = NowInExt$) IF InCur THEN _ WasX = ZMailWaiting : _ ' KG030101 ZWasA = ZLastMsgRead _ ELSE ZWasA = CVI(MID$(ZUserRecord$,51,2)) ZWasB = VAL(LEFT$(ZMsgRec$,8)) WasZ = (ZWasB - ZWasA) IF WasZ < 0 THEN _ ZWasA = 0 : _ WasZ = ZWasB _ ELSE IF WasZ = 0 THEN _ WasX = ZFalse ZOutTxt$ = MID$(STR$((ZWasB > ZWasA) * WasZ),2) ZWasSL = LEN(ZOutTxt$) ZOutTxt$ = SPACE$(-(ZWasSL<4) * (4-ZWasSL)) + ZOutTxt$ ZWasSL = LEN(CurPre$) IF CurPre$ = "USERS" AND CurExt$ = "" THEN _ Conf$ = "MAIN" _ ELSE Conf$ = LEFT$(CurPre$,ZWasSL-1) ZWasY$ = Conf$ + SPACE$(-(ZWasSL<8) * (8-ZWasSL)) IF WasX THEN _ WasX$ = ZEmphasizeOn$ + "*Some* to you" + ZEmphasizeOff$ _ ' KG081405 ELSE WasX$ = "" ' KG081405 ZOutTxt$ = ZWasY$ + ": " + ZOutTxt$ + " new message(s) " + _ ' KG081405 WasX$ ' KG081405 ZSubParm = 5 CALL TPut ZJumpSupported = ZFalse ' DA080901 IF SkipJoinUnjoin THEN _ CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue) : _ GOTO 59853 ' KG080701 ZTurboKey = -ZTurboKeyUser CALL AskMore (",J)oin,U)njoin",ZTrue,ZFalse,WasX,ZFalse) IF ZNo THEN _ GOTO 59854 WasX$ = LEFT$(ZUserIn$(1),1) CALL AllCaps (WasX$) IF WasX$ = "J" THEN _ ZHomeConf$ = Conf$ : _ GOTO 59854 IF WasX$ = "U" THEN _ IF InCur OR (OrigPre$ = CurPre$ AND OrigExt$ = CurExt$) THEN _ CALL QuickTPut1 ("Can't omit yourself from the board or conference you're in") _ ELSE LSET ZUserRecord$ = CHR$(0) + "deleted user" : _ ZUserFileIndex = HoldUserFileIndex : _ ZSubParm = 6 : _ CALL FileLock : _ PUT 5, HoldUserFileIndex : _ ZSubParm = 8 : _ CALL FileLock : _ CALL QuickTPut1 ("Omitted you from " + Conf$) ' KG073104 * REPLACING old line(s) by new * ------[ first line different ]------ 59853 IF ZActiveMessageFile$ = LogicalEOF$ THEN _ ' KG073104 GOTO 59854 ' KG073104 IF NOT ZRet THEN _ ' KG073104 GOTO 59852 ' KG080701 * REPLACING old line(s) by new 59854 ZActiveUserFile$ = WasA1$ CALL OpenUser (HighestUserRecord) FIELD 5, 128 AS ZUserRecord$ IF (NOT ZRet) AND NOT AnyMail THEN _ CALL QuickTPut1 ("You have not joined any conferences") ZUserFileIndex = UserFileIndexSave LSET ZUserRecord$ = UserRecordHold$ ZActiveMessageFile$ = MsgFileSave$ CALL OpenMsg FIELD 1, 128 AS ZMsgRec$ GET 1,1 ZNonStop = (ZPageLength > 0) * ------[ first line different ]------ WasX$ = ZUserIn$(ZAnsIndex+1) ' KG071202 CALL AllCaps (WasX$) ' KG071202 ZAnsIndex = ZAnsIndex - (WasX$ = "C") ' KG071202 SkipParms = -(NOT EOF(2))*SkipParms ' KG072101 END SUB * REPLACING old line(s) by new 60180 ' $SUBTITLE: 'TimeLock - Test TIME LOCK for premium features' ' $PAGE ' ' NAME -- TimeLock (written by Doug Azzarito) ' ' INPUTS -- PARAMETER MEANING ' ZTimeLockSet SECONDS/SESSION TO LOCK ' ' OUTPUTS -- ZSubParm -1 if feature is LOCKED ' ' PURPOSE -- Check elapsed time for lock duration ' SUB TimeLock STATIC CALL TimeRemain(MinsRemaining) IF ZSecsUsedSession! >= ZTimeLockSet THEN _ ZOK = ZTrue : _ EXIT SUB ZOutTxt$ = ZFirstName$ CALL NameCaps(ZOutTxt$) CALL QuickTPut1 ("Sorry, " + ZOutTxt$ + ", function locked" + _ STR$(INT((ZTimeLockSet-ZSecsUsedSession!)/60)) + _' DA11102 " more minutes" + _ STR$(INT(ZTimeLockSet-ZSecsUsedSession!) MOD 60) + " seconds") CALL BufFile(ZHelpPath$+"TIMELOCK"+ZHelpExtension$,WasX) ZOK = ZFalse * ------[ first line different ]------ ZLastIndex = 0 ' KG061501 END SUB * REPLACING old line(s) by new 60300 ' $SUBTITLE: 'AutoPage - NOTIFIES ZSysop WHEN SPECIFIC USER CALLS' ' $PAGE ' ' NAME -- AutoPage 'Contributed by Gregg and Bob Snyder ' 'and RoseMarie Siddiqui ' ' INPUTS -- ZAutoPageDef$ List of conditions that trigger ' notification and how ' ' OUTPUTS -- NONE ' ' PURPOSE -- Search ZAutoPageDef$ for match on whether ' on name, security level, whether new user. ' Also controls whether caller notified and ' number of times sysop has bell rung. ' And what tune to play (if any). ' SUB AutoPage STATIC CALL FindIt (ZAutoPageDef$) IF NOT ZOK THEN _ EXIT SUB ZErrCode = 0 ZOK = ZFalse WHILE NOT EOF(2) AND ZOK = ZFalse AND ZErrCode = 0 CALL ReadParms (ZWorkAra$(),4,1) IF ZErrCode = 0 THEN _ ZOK = (ZWorkAra$(1) = ZActiveUserName$) : _ IF NOT ZOK THEN _ IF ZNewUser AND ZWorkAra$(1) = "NEWUSER" THEN _ ZOK = ZTrue _ ELSE IF LEFT$(ZWorkAra$(1),1) = "/" AND LEN(ZWorkAra$(1)) > 2 THEN _ ZWasB = INSTR (2,ZWorkAra$(1),"/") : _ IF ZWasB > 0 AND LEN(ZWorkAra$(1)) > ZWasB THEN _ IF ZUserSecLevel <= VAL(MID$(ZWorkAra$(1),ZWasB+1)) AND _ ZUserSecLevel >= VAL(MID$(ZWorkAra$(1),2)) THEN _ ZOK = ZTrue WEND CLOSE 2 IF ZErrCode > 0 OR NOT ZOK THEN _ ZErrCode = 0 : _ EXIT SUB * ------[ first line different ]------ ZPageStatus$ = "AP!" ' DA080902 IF LEFT$(ZWorkAra$(2),1) = "N" THEN _ ZOutTxt$ = "Telling sysop you're on..." : _ CALL RingCaller ZWasB = (ZWorkAra$(4) = "") ZWorkAra$(5) = "" FOR WasI = 1 TO VAL(ZWorkAra$(3)) IF ZWasB THEN _ CALL LPrnt (ZBellRinger$,0) : _ ELSE ZWorkAra$(5) = ZWorkAra$(5) + "O4 X" + VARPTR$(ZWorkAra$(4)) NEXT IF NOT ZWasB THEN _ CALL RBBSPlay (ZWorkAra$(5)) END SUB * REPLACING old line(s) by new 62620 ' $SUBTITLE: 'Transfer - Subroutine for external protocols' ' $PAGE ' ' NAME -- Transfer ' ' INPUTS -- PARAMETER MEANING ' ZTransferFunction = 1 DOWNLOAD FILE TO USER ' = 2 UPLOAD FILE TO RBBS-PC ' ZFileName$ NAME OF FILE FOR Transfer ' ZComPort$ NAME OF COMMUNICATIONS PORT ' TO BE USED BY KERMIT (COM1 ' OR COM2) ' ZBPS = -1 FOR 300 BAUD ' = -2 FOR 450 BAUD ' = -3 FOR 1200 BAUD ' = -4 FOR 2400 BAUD ' = -5 FOR 4800 BAUD ' = -6 FOR 9600 BAUD ' = -7 FOR 19200 BAUD ' ' OUTPUTS -- NONE ' ' PURPOSE -- To transfer files using external protocols ' SUB Transfer STATIC IF ZPrivateDoor THEN _ CALL PrivDoorRtn : _ EXIT SUB IF ZTransferFunction = 1 THEN _ ZUserIn$ = ZDownTemplate$ : _ ZWasZ$ = "send " _ ELSE IF ZTransferFunction = 2 THEN _ ZUserIn$ = ZUpTemplate$ : _ ZWasZ$ = "receive " CALL MetaGSR (ZUserIn$,ZFalse) CALL QuickTPut1 ("Protocol : "+ZProtoPrompt$) CALL QuickTPut ("Ready to " + ZWasZ$ + " ",0) IF ZBatchTransfer THEN _ CALL QuickTPut1 ("(BATCH)") : _ CALL OpenWork (2,ZNodeWorkFile$) : _ WHILE NOT EOF(2) : _ CALL ReadAny : _ CALL BreakFileName (ZOutTxt$,ZWasZ$,ZWasY$,WasX$,ZTrue) : _ CALL QuickTPut1 (" "+ZWasY$+WasX$) : _ WEND _ ELSE CALL QuickTPut1 (ZFileNameHold$) IF ZAutoLogoffReq THEN _ * ------[ first line different ]------ CALL QuickTPut1 ("Automatic logoff, if download OK") ' KG071902 CALL PrivDoorRtn END SUB * REPLACING old line(s) by new 63000 ' $SUBTITLE: 'TimedOut - exits based on time of day' ' $PAGE ' ' NAME -- TimedOut ' ' INPUTS -- PARAMETER MEANING ' ZRCTTYBat$ ' ZNodeRecIndex ' ZMsgRec$ ' ZModemInitBaud$ ' ZModemGoOffHookCmnd$ ' ' OUTPUTS -- NONE ' ' PURPOSE -- When RBBS-PC is to exit to DOS at a specific time of ' day, this routine writes out to the file specified * ------[ first line different ]------ ' in "RCTTY.BAT" the one-line entry: ' RBBSxTM.BAT ' WHERE "x" is the node id. ' SUB TimedOut STATIC FIELD #1,128 AS ZMsgRec$ ZSubParm = 3 CALL FileLock GET 1,ZNodeRecIndex WasX$ = DATE$ CALL PackDate (WasX$,ZWasY$) MID$(ZMsgRec$,77,2) = ZWasY$ 'MID$(ZMsgRec$,86,5) = LEFT$(TIME$,5) PUT 1,ZNodeRecIndex ZSubParm = 2 CALL FileLock CLOSE 2 ZFileName$ = ZNodeWorkDrvPath$ + "RBBS" + ZNodeFileID$ + "TM.DEF" OPEN "O",2,ZFileName$ PRINT #2,MID$(ZFileName$,3,7) CLOSE 2 IF ZLocalUserMode THEN _ EXIT SUB IF ZSubParm <> 7 THEN _ ZSubParm = 4 : _ CALL FileLock : _ CALL OpenCom(ZModemInitBaud$,",N,8,1") CALL TakeOffHook END SUB