* ------------[ 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 05-20-1990 20:27:33 ]------------ * 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 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 * ------[ 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 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 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$, _ BackOpt$,ReturnOn$,GRDefault$,VerifyInMenu, _ * ------[ first line different ]------ 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 59538 FilName$ = FPre$ + ZWasZ$ CALL BadFile (FilName$,WasBF) IF WasBF > 1 THEN _ ZOK = ZFalse : _ RETURN 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 _ * ------[ first line different ]------ 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) : _ MenuFront$ = MenuDrv$ + WasX$ : _ RETURN * ------[ first line different ]------ IF VerifyInMenu AND InMenu AND NOT RequireInMenu THEN _ ' KG032502 CALL UpdtCalr("Option " + ZWasZ$ + " on menu " + _ CurMenu$ + " but not found",1) RETURN * REPLACING old line(s) by new 59852 IF EOF(2) OR NOT ZOK THEN _ GOTO 59854 CALL ReadAny ZActiveUserFile$ = ZOutTxt$ CALL ReadAny IF ZErrCode > 0 THEN _ GOTO 59854 ZActiveMessageFile$ = ZOutTxt$ 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 59852 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 _ * ------[ first line different ]------ 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$ : _ ZWasZ$ = ZEmphasizeOff$ _ ELSE WasX$ = "" : _ ZWasZ$ = "" ZOutTxt$ = ZWasY$ + ": " + ZOutTxt$ + " new message(s): " + _ WasX$ + MID$(" None *Some*",-6 * WasX + 1,6) + " to you" + ZWasZ$ ZSubParm = 5 CALL TPut IF SkipJoinUnjoin THEN _ CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue) : _ GOTO 59853 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$)