* ------------[ BLED merge (c) Ken Goosens ]------------- * Merge this against D:\172B\RBBSSUB3.BAS to produce RBBSSUB3.BAS * D:\172B\RBBSSUB3.BAS: Date 2-11-1990 Size 114935 bytes * ------------[ Created 08-26-1990 11:30:19 ]------------ * REPLACING old line(s) by new ' $linesize:132 * ------[ first line different ]------ ' $title: 'RBBSSUB3.BAS 17.3A, Copyright 1986 - 90 by D. Thomas Mack' ' DA081003 ' Copyright 1990 by D. Thomas Mack, all rights reserved. ' Name ...............: RBBSSUB3.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 ' AllCaps 58050 Convert a string to all upper case characters ' AMorPM 41498 Calculate the current time as AM or PM ' AskGraphics 43004 Determine users graphic default ' BadFile 20741 Check for system crash attempt with bad device name ' Carrier 42000 Test for whether to continue in RBBS ' CheckRatio 20096 Test upload/download ratio ' CheckTime 58070 Test to insure that users don't exceed their time ' CheckCarrier 42005 Checks whether still have carrier ' CheckNewBul 58110 Check for new bulletins based on their file creation date ' CheckTimeRemain 41008 Set up to log off if time exceeded ' CommInfo 44020 Get users baud rate and parity in a string format ' CountLines 58160 Count categories a file can be classified into ' CountNewFiles 58150 Check for number of files uploaded after a specific date ' DelayTime 50495 Wait number of seconds specified before returning ' DispCall 57001 Display callers file ' DispTimeRemain 41032 Compute and display time remaining ' DispUpDir 58165 Display the shared directory of the FMS mng. sys. ' FileLock 21993 Allow files to be shared among multiple RBBS-PC's ' FindFKey 30595 Handle local keyboard's function & ZSysop's keys ' FindLast 58600 Finds last occurence of a string in a string ' FlushKeys 35000 Completely flush all user input ' Graphic 43031 Determines if graphic ver of file exists, opens as #2 ' GraphicX 43031 Determines if graphic ver of file exists, any file # ' HashRBBS 58080 "Hash" to a user's record in the USERS file ' InitFMS 58162 Initialize the RBBS-PC's File Management System ' InitIBM 30000 Open/create NetBIOS semaphore file ' AddCommas 58130 Format commands in the command prompt ' Library 21105 Provide support for "library" drives ' LinesInFile 58161 Counts lines in a file ' LoadNew 58140 Find the latest uploads ' ModemPut 52070 Write a modem command string to the modem ' NameCaps 58060 Convert a string to Proper Case (for name output) ' OpenMsg 30500 Open the messages file as file number 1 ' PageUp 33202 Display user info. on local screen for ZSysop ' ReadProf 44000 Read user's profile on return from a "door" ' SaveProf 43068 Save the user's provile when exiting to "doors" or DOS ' SendName 20293 Send filename via EXEC-PC protocol during autodownload ' SetOpts 58100 Set correct prompt line for each subsystem ' SortString 58120 Sort characters in a string ' TestUser 20310 Check if user's software can do auto downloading ' TimeRemain 41010 Compute time remaining in minutes ' UpdtUpload 20705 Updates upload directory file ' WildFile 20290 Determines whether string matches a pattern ' XferType 21600 Identify the file transfer protocol ' ' $INCLUDE: 'RBBS-VAR.BAS' ' * REPLACING old line(s) by new 20293 ' $SUBTITLE: 'SendName - send FILENAME using EXEC-PC protocol' ' $PAGE ' ' NAME -- SendName ' ' INPUTS -- PARAMETER MEANING ' ZUserIn$() ARRAY OF FILENAME FOR AUTODOWNLOAD * ------[ first line different ]------ ' ZAnsIndex Index OF FILENAME TO Transfer ' RH021501 ' ' OUTPUTS -- ZAbort -1 FOR AN ABORTED ATTEMPT ' ' PURPOSE -- Send the download filename to user during an autodownload ' SUB SendName STATIC ' ' ' * Transfer FILENAME TO USER ' * PROCESS - SEND USER THE "ALERT" CHARACTER SEQUENCE -- OD ' * THEN THIS IS FOLLOWED BY CHARACTER-BY-CHARACTER ' * TRANSMISSION OF THE FILENAME WITH ECHO. IF ANY OF THE ' * CHARACTERS OF THE FILENMAE ARE GARBLED A SERIES OF ' * ARE SENT, OTHERWISE AN IS SENT AT ' * COMPLETION AND FILE Transfer BEGINS. ' ' ZAbort = ZFalse ' RESET ABORT FLAG Attempts = 0 ' RESET COUNT FOR # OF TRANS Attempts * REPLACING old line(s) by new 20296 CALL FlushCom(ZWasY$) ' CLEAR THE COMM BUFFER OF GARBAGE IF ZSubParm = -1 THEN _ EXIT SUB CALL PutCom (ZEscape$+"OD") ' SEND "ALERT" STRING IF ZSubParm = -1 THEN _ EXIT SUB IF ZAbort = ZTrue THEN _ GOTO 20306 CALL LPrnt("Sending FILENAME -- ",1) CALL LPrnt(ZReturnLineFeed$ + CHR$(9),0) CALL DelayTime (1) ' WAIT 1 SECOND FOR SETUP ' ' SEND ONE CHARACTER AT A TIME ' * ------[ first line different ]------ CALL BreakFileName (ZUserIn$(ZAnsIndex),WasX$,ZOutTxt$,ZWasY$,ZTrue) ' RH021501 ZOutTxt$ = ZOutTxt$ + ZWasY$ + "=X" ' RH021501 FOR WasX = 1 TO LEN(ZOutTxt$) CALL PutCom (MID$(ZOutTxt$,WasX,1)) ' SEND 1 CHARACTER IF ZSubParm = -1 THEN _ EXIT SUB IF ZAbort = ZTrue THEN _ GOTO 20306 CALL LPrnt(MID$(ZOutTxt$,WasX,1),0) ' DISPLAY IF NEEDED ZDelay! = TIMER + 10 ' SET MAXIMUM TIME TO WAIT FOR Reply Char = ZTrue WHILE Char = -1 CALL CheckTime(ZDelay!, TempElapsed!, 1) IF TempElapsed! <= 0 THEN _ GOTO 20300 ' IF ZNo ECHO, CANCEL FILENAME Transfer CALL EofComm (Char) WEND ' JUMP OUT IF CHARACTER IS RECEIVED * REPLACING old line(s) by new 20705 ' $SUBTITLE: 'UpdtUpload -- Updates upload directory' ' $PAGE ' NAME -- UpdtUpload ' ' INPUTS -- PARAMETER MEANING ' ZFileName$ ' ZUpldDir$ ' ZFileNameHold$ ' ZShareIt ' ZFMSDirectory$ ' ZWasQ! ' ZSecsUsedSession! ' ' OUTPUTS -- ZBytesInFile# ' ZSecsPerSession! ' ' PURPOSE -- Upon a successful upload, add entry to the upload ' directory and give any session time credit. ' SUB UpdtUpload (ZCategoryName$(1),ZCategoryCode$(1), LinesInDesc) STATIC IF ZGetExtDesc THEN _ GOTO 20723 GOSUB 20734 CALL TimeRemain (MinsRemaining) IF ZPrivateDoor THEN _ WasX! = ZUpldTimeFactor! * ZWasQ! _ ELSE WasX! = ZUpldTimeFactor! * (ZSecsUsedSession! - ZWasQ!) CALL BreakFileName (ZFileName$,Pre$,Body$,Ext$,ZFalse) WasX$ = ZDiskForDos$ + "T" + Ext$ + ".BAT" CALL FindIt (WasX$) IF NOT ZOK THEN _ GOTO 20708 * ------[ first line different ]------ CALL QuickTPut1 ("Testing if file OK...") : _ ' KG072601 CALL ReadDir (2,1) IF EOF(2) THEN _ WasX$ = ZOutTxt$ : _ ZGSRAra$(1) = ZFileName$ : _ ZGSRAra$(2) = ZNodeWorkFile$ _ ELSE WasX$ = WasX$ + " " + _ ZFileName$ + " " + ZNodeWorkFile$ CALL ShellExit (WasX$) CALL FindIt (ZNodeWorkFile$) IF ZOK THEN _ IF LOF(2) > 2 THEN _ ZBytesInFile# = 0.0 : _ WasX$ = "Deleting BAD upload " + ZFileNameHold$ : _ CALL QuickTPut1 (WasX$) : _ CALL UpdtCalr (WasX$,2) : _ CALL KillWork (ZFileName$) : _ EXIT SUB * REPLACING old line(s) by new 20712 ZOK = 0 CALL CheckNovell (ZOK) IF ZOK <> -1 THEN _ CALL SetSharedAttr (ZFileName$, ZOK) : _ IF ZOK <> 0 THEN _ * ------[ first line different ]------ CALL PScrn ("Error setting to shared") ' KG072701 Desc$ = ZUserIn$ IF NOT ZLimitSearchToFMS THEN _ IF ZFMSDirectory$ <> ZUpldDir$ THEN _ IF LEFT$(ZUserIn$,1) = "/" THEN _ CALL UpdtCalr (ZUserIn$,2) : _ GOTO 20726_ ELSE GOTO 20717 * REPLACING old line(s) by new 20720 ZOutTxt$= "Upload best fits what category (D=default,H=help)" ZSubParm = 1 CALL TGet CALL AllCaps (ZUserIn$(1)) IF ZSubParm = -1 OR ZUserIn$(1) = "D" THEN _ * ------[ first line different ]------ UCat$ = ZDefaultCatCode$ : _ ' KG071704 GOTO 20722 IF ZWasQ = 0 THEN _ GOTO 20719 IF ZUserIn$(1) = "H" OR _ ZUserIn$(1) = "*" OR _ ZUserIn$(1) = "?" THEN _ GOTO 20719 CALL SearchArray (ZUserIn$(1),ZCategoryName$(),ZNumCategories,Found) IF Found > 0 THEN _ UCat$ = ZCategoryCode$(Found) : _ IF LEN(UCat$) > 0 AND LEN(UCat$) < 4 AND INSTR(UCat$,",") = 0 THEN _ GOTO 20722 UCat$ = "" IF NOT ZLimitSearchToFMS THEN _ StrewTo$ = ZDirPath$ + _ ZUserIn$(1) + _ "." + _ ZDirExtension$ : _ CALL FindIt (StrewTo$) : _ IF ZOK THEN _ GOTO 20722 _ ELSE CALL WordInFile (ZUpcatHelp$,ZUserIn$(1),ZOK) : _ IF ZOK THEN _ GOTO 20722 StrewTo$ = "" CALL QuickTPut1 ("No such category " + ZUserIn$(1)) GOTO 20719 * REPLACING old line(s) by new 20722 IF ZUserSecLevel >= ZAskExtendedDesc AND _ ZMaxExtendedLines > 0 AND ZSubParm <> -1 THEN _ * ------[ first line different ]------ ZOutTxt$ = "Add an extended description of " + _ ' DA071701 ZFileNameHold$ + " ([Y],N)" : _ ZTurboKey = -ZTurboKeyUser : _ ZSubParm = 1 : _ CALL TGet : _ IF ZSubParm <> -1 THEN _ IF NOT ZNo THEN _ ZGetExtDesc = ZTrue : _ EXIT SUB * REPLACING old line(s) by new 20726 ZWasDF$ = " >> uploaded << " ZUplds = ZUplds + 1 ZGlobalUplds = ZGlobalUplds + 1 ZULBytes! = ZULBytes! + ZBytesInFile# ZGlobalULBytes! = ZGlobalULBytes! + ZBytesInFile# CALL Muzak (7) CALL TimeRemain (MinsRemaining) ZTimeCredits! = ZTimeCredits! + WasX! ZSecsPerSession! = ZSecsPerSession! + WasX! IF ZPrivateDoor THEN _ WasX! = (WasX! - ZWasQ!) / 60 _ ELSE WasX! = (WasX! - ZSecsUsedSession! + ZWasQ!)/60.0 WasX$ = STR$(FIX(WasX!*10.0)) WasX$ = LEFT$(WasX$,LEN(WasX$)-1) + "." + RIGHT$(WasX$,1) IF WasX! > 1 THEN _ * ------[ first line different ]------ CALL QuickTPut1 ("Increased session time by"+WasX$+" minutes") ' KG072701 CALL QuickTPut1 ("Thanks for the upload!") ZGetExtDesc = ZFalse EXIT SUB * REPLACING old line(s) by new 21110 IF ZLibDiskChar$ = "0000" THEN _ ZOutTxt$ = "No Library disk currently selected" _ ELSE ZOutTxt$ = "Library disk " + _ ZLibDiskChar$ + _ " selected - " + _ DiskTitle$ CALL QuickTPut1 (ZOutTxt$) IF LibDiskArc$ = "" THEN _ EXIT SUB * ------[ first line different ]------ IF INSTR(ZLibArcProgram$,"ARC") THEN _ ' KG080401 Extension$ = "ARC" _ ELSE IF INSTR(ZLibArcProgram$,"ZIP") THEN _ ' KG080401 Extension$ = "ZIP" _ ELSE IF INSTR(ZLibArcProgram$,"LHA") THEN _ ' KG080401 Extension$ = "LHZ" _ ELSE Extension$ = ZDefaultExtension$ FOR LibDisplayCount = 0 TO LibLoopCount - 1 IF LibSubdirName$(LibDisplayCount) <> "" THEN _ CALL QuickTPut1 (LibSubdirName$(LibDisplayCount) + _ "." + Extension$ + " ready for transmission!") NEXT EXIT SUB * REPLACING old line(s) by new 21130 IF ZLibType <> 1 THEN _ EXIT SUB CALL SkipLine(1) * ------[ first line different ]------ ZOutTxt$ = "The PC-SIG Library file that you are about to" ' KG080401 CALL QuickTPut1 (ZOutTxt$) ZOutTxt$ = "download can also be ordered as DISK " + _ ZLibDiskChar$ CALL QuickTPut1 (ZOutTxt$) ZOutTxt$ = "from PC-SIG, 1030D East Duane Ave. Sunnyvale, Ca. 94086" CALL QuickTPut (ZOutTxt$,2) EXIT SUB * REPLACING old line(s) by new 21153 CALL OpenWork (2,Treedir$) LibSubdirCount = 0 WHILE NOT EOF(2) LINE INPUT #2, Dirrec$ IF LEFT$(Dirrec$,1) <> "." THEN _ LibSubdirCount = LibSubdirCount + 1 : _ LibSubdirName$(LibSubdirCount) = _ LEFT$(Dirrec$,8) WEND CLOSE 2 LibLoopCount = 1 IF LibSubdirCount = 0 THEN _ GOTO 21156 ZOutTxt$ = STR$(LibSubdirCount) + _ " Subdirectories on Library disk - " + _ ZLibDiskChar$ CALL QuickTPut1 (ZOutTxt$) FOR LibLoopCount = 1 TO LibSubdirCount IF NOT ZLocalUser THEN _ CALL Carrier : _ IF ZSubParm THEN _ GOTO 21155 LibSubdirChar$ = MID$("ABCDEFGHI",LibLoopCount,1) ZOutTxt$ = "Creating " + _ ZLibNodeID$ + _ "DK" + _ ZLibDiskChar$ + _ * ------[ first line different ]------ LibSubdirChar$ + "." + Extension$ + _ ' KG080401 " using " + ZLibArcProgram$ CALL QuickTPut1 (ZOutTxt$) CHDIR ChdirLib$ + _ "\" + _ LibSubdirName$(LibLoopCount) GOSUB 21157 ZOutTxt$ = "Disk - " + _ ZLibDiskChar$ + _ "; Subdirectory" + _ " -" + _ STR$(LibLoopCount) + _ " archived for download" CALL QuickTPut1 (ZOutTxt$) GOSUB 21158 * REPLACING old line(s) by new 21610 CALL AllCaps (ZWasZ$) * ------[ first line different ]------ ZFF = INSTR(ZDefaultXfer$,ZWasZ$) ' KG071903 IF ZFF > 0 THEN _ ' KG071903 GOTO 21612 ' KG071903 IF INSTR("H?",ZWasZ$) > 0 THEN _ ' KG071903 GOTO 21602 ' KG071903 GOTO 21600 ' KG071903 * REPLACING old line(s) by new 35000 ' $SUBTITLE: 'FlushKeys - Completely flush all user input' ' $PAGE ' ' NAME -- FlushKeys ' SUB FlushKeys STATIC * ------[ first line different ]------ CALL FlushCom (ZWasY$) ' KG071901 ZLastIndex = 0 REDIM ZUserIn$(ZMsgDim) END SUB * REPLACING old line(s) by new 41010 ' $SUBTITLE: 'TimeRemain - calculates time remaining in a session' ' $PAGE ' ' NAME -- TimeRemain ' ' INPUTS -- PARAMETER MEANING ' ZUserLogonTime! WHEN DID THE CALLER GET HERE ' ZSecsPerSession! HOW LONG MAY THE CALLER STAY ON ' ZTimeToDropToDos! WHEN ARE WE DOING OUR DAILY EVENT ' ZBypassTimeCheck DO WE CARE HOW LONG THEY CAN STAY ' ' OUTPUTS -- PARAMETER MEANING ' MinsRemaining TIME IN MINUTES LEFT IN SESSION ' ZSecsUsedSession! TIME USED IN SECONDS ' SUB TimeRemain (MinsRemaining) STATIC TOA! = FRE("A") IF ZBypassTimeCheck THEN _ MinsRemaining = ZSecsPerSession! / 60 : _ EXIT SUB CALL CheckTime (ZUserLogonTime!, ZSecsUsedSession!, 2) IF ZTimeToDropToDos! = 0 OR _ ZOldDate$ = DATE$ THEN _ GOTO 41020 CALL CheckTime (ZTimeToDropToDos!, HowMuchTimeLeft!, 1) * ------[ first line different ]------ IF HowMuchTimeLeft! < 0 THEN _ ' ML080801 HowMuchTimeLeft! = (HowMuchTimeLeft! * -1) + 43200 ' ML080801 IF (ZSecsPerSession! - ZSecsUsedSession!) > HowMuchTimeLeft! THEN _ ' DA080101 ZSecsPerSession! = HowMuchTimeLeft! + ZSecsUsedSession! : _ ' DA080101 IF NOT ToldShort THEN _ ToldShort = ZTrue : _ ZOutTxt$ = "Shortened session time to" + _ ' DA080101 STR$(INT((ZSecsPerSession! - ZSecsUsedSession!) / 60)) + _ ' DA080101 " min for scheduled event" : _ ' DA080101 CALL RingCaller * REPLACING old line(s) by new * ------[ first line different ]------ 41020 MinsRemaining = INT((ZSecsPerSession! - ZSecsUsedSession!) / 60) ' ML080802 END SUB * REPLACING old line(s) by new 41032 ' $SUBTITLE: 'DispTimeRemain - Display users time remaining' ' $PAGE ' ' NAME -- DispTimeRemain ' ' INPUTS -- PARAMETER MEANING ' MinsRemaining ' ' OUTPUTS -- PARAMETER MEANING ' MinsRemaining TIME IN MINUTES LEFT IN SESSION ' SUB DispTimeRemain (MinsRemaining) STATIC CALL TimeRemain (MinsRemaining) * ------[ first line different ]------ CALL QuickTPut1 (ZEmphasizeOff$ + STR$(MinsRemaining) + " min left") ' MB052101 END SUB * REPLACING old line(s) by new 43070 ZActiveMessageFile$ = ZOrigMsgFile$ ZSubParm = 3 CALL FileLock CALL OpenMsg FIELD 1, 128 AS ZMsgRec$ GET 1,ZNodeRecIndex IF ZGlobalSysop THEN _ MID$(ZMsgRec$,1,30) = "SYSOP" + SPACE$(25) MID$(ZMsgRec$,40,2) = STR$(ZExitToDoors) MID$(ZMsgRec$,42,2) = STR$(ZEightBit) MID$(ZMsgRec$,44,2) = STR$(ZBPS) MID$(ZMsgRec$,46,2) = STR$(ZUpperCase) * ------[ first line different ]------ MID$(ZMsgRec$,48,5) = MKS$(ZNumDnldBytes!) + MID$(STR$(-ZBatchTransfer),2) ' KG022101 MID$(ZMsgRec$,53,2) = STR$(ZWasGR) MID$(ZMsgRec$,55,2) = STR$(ZSysop) MID$(ZMsgRec$,65,3) = CHR$(VAL(LEFT$(ZTimeLoggedOn$,2))) + _ CHR$(VAL(MID$(ZTimeLoggedOn$,4,2))) + _ CHR$(VAL(MID$(ZTimeLoggedOn$,7,2))) MID$(ZMsgRec$,72,2) = STR$(ZPrivateDoor) MID$(ZMsgRec$,74,1) = MID$(STR$(ZTransferFunction),2,1) MID$(ZMsgRec$,75,1) = ZWasFT$ MID$(ZMsgRec$,113,2) = MKI$(CINT(ZTimeCredits!)/60) MID$(ZMsgRec$,79,8) = LEFT$(ZDooredTo$+" ",8) MID$(ZMsgRec$,91,2) = STR$(ZReliableMode) CALL BreakFileName (ZCurPUI$,ZOutTxt$,ZUserIn$,ZWasZ$,ZFalse) MID$(ZMsgRec$,93,8) = ZUserIn$ + SPACE$(8 - LEN(ZUserIn$)) IF ZLocalUser THEN _ ZWasZ$ = ZCarriageReturn$ + ZCarriageReturn$ _ ' KG030601 ELSE ZWasZ$ = " 0" ' KG030601 MID$(ZMsgRec$,101,2) = ZWasZ$ ' KG030601 MID$(ZMsgRec$,103,2) = STR$(ZLocalUserMode) ' KG030601 ZConfName$ = LEFT$(ZConfName$,INSTR(ZConfName$ + " "," ") - 1) MID$(ZMsgRec$,105,8) = ZConfName$ + SPACE$(8 - LEN(ZConfName$)) MID$(ZMsgRec$,115,1) = MID$(STR$(ZAutoLogoffReq),2,1) MID$(ZMsgRec$,117,2) = STR$(ZMenuIndex) MID$(ZMsgRec$,119,2) = LEFT$(DATE$,2) MID$(ZMsgRec$,121,2) = MID$(DATE$,4,2) MID$(ZMsgRec$,123,2) = RIGHT$(DATE$,2) MID$(ZMsgRec$,125,2) = LEFT$(TIME$,2) MID$(ZMsgRec$,127,2) = MID$(TIME$,4,2) ' *** Save additional parameters for door restoral CALL OpenOutW (ZNodeWorkDrvPath$+"DRST"+ZNodeFileID$+".DEF") CALL PrintWorkA (STR$(ZLimitMinsPerSession)) CALL PrintWorkA (ZWasNG$) ' KG052701 CALL PrintWorkA (ZIndivValue$) ' NC050901 CALL PrintWorkA (ZOrigDateTimeOn$) ' KG070601 CALL PrintWorkA (ZOrigTimeLoggedOn$) ' KG070601 CLOSE 2 * REPLACING old line(s) by new 44000 ' $SUBTITLE: 'ReadProf - subroutine to restore a user profile' ' $PAGE ' ' NAME -- ReadProf ' ' INPUTS -- PARAMETER MEANING ' ZNodeRecIndex NODE RECORD TO USE ' ZSysopPswd1$ Sysop'S PSEUDONYM 1 ' ZSysopPswd2$ Sysop'S PSEUDONYM 2 ' ' OUTPUTS -- USER'S OPTIONS AND COMMUNICATIONS PARAMETERS ' UPON EXITING RBBS-PC TO A "DOOR" ' ' PURPOSE -- Reset a user's options and communications parameters ' that were saved in the node record when a user exited ' to a "door" so that he is in the same status as when ' he exited. ' SUB ReadProf STATIC FIELD 1, 128 AS ZMsgRec$ GET 1,ZNodeRecIndex ZReliableMode = VAL(MID$(ZMsgRec$,91,2)) MID$(ZMsgRec$,40,2) = "00" ZEightBit = VAL(MID$(ZMsgRec$,42,2)) ZBPS = VAL(MID$(ZMsgRec$,44,2)) CALL CommInfo ZBaudTest! = VAL(MID$(ZBaudRates$,(-5 * ZBPS),5)) ZUpperCase = VAL(MID$(ZMsgRec$,46,2)) * ------[ first line different ]------ ZNumDnldBytes! = CVS(MID$(ZMsgRec$,48,4)) ' KG022101 ZBatchTransfer = (MID$(ZMsgRec$,52,1) = "1") ZWasGR = VAL(MID$(ZMsgRec$,53,2)) HourLoggedOn$ = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,65,1))),2),2) MinLoggedOn$ = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,66,1))),2),2) SecLoggedOn$ = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,67,1))),2),2) ZTimeLoggedOn$ = HourLoggedOn$ + _ ":" + _ MinLoggedOn$ + _ ":" + _ SecLoggedOn$ ZTransferFunction = VAL(MID$(ZMsgRec$,74,1)) ZWasFT$ = MID$(ZMsgRec$,75,1) ZTimeCredits! = 60!*CVI(MID$(ZMsgRec$,113,2)) ' KKG030901 ZDooredTo$ = MID$(ZMsgRec$,79,8) CALL Trim (ZDooredTo$) IF ZExitToDoors AND ZDooredTo$ <> "" THEN _ CALL OpenWork (2,ZDoorsDef$) : _ IF ZErrCode = 0 THEN _ CALL ReadParms (ZOutTxt$(),8,1) : _ WHILE ZErrCode = 0 AND ZOutTxt$(1) <> ZDooredTo$ : _ CALL ReadParms (ZOutTxt$(),8,1) : _ WEND : _ IF ZOutTxt$(1) = ZDooredTo$ THEN _ ZDoorSkipsPswd = (ZOutTxt$(6) <> "Y") ' ML082001 ZErrCode = 0 ZMenuIndex = VAL(MID$(ZMsgRec$,117,2)) ZCurPUI$ = MID$(ZMsgRec$,93,8) CALL Remove (ZCurPUI$," ") IF ZCurPUI$ <> "" THEN _ CALL BreakFileName (ZMainPUI$,ZOutTxt$,ZUserIn$,ZWasZ$,ZTrue) : _ ZCurPUI$ = ZOutTxt$ + ZCurPUI$ + ZWasZ$ ZCustomPUI = (ZCurPUI$ <> "") ZLocalUser = (MID$(ZMsgRec$,101,2) = ZCarriageReturn$ + ZCarriageReturn$) ' KG030601 ZLocalUserMode = VAL(MID$(ZMsgRec$,103,2)) ZHomeConf$ = MID$(ZMsgRec$,105,8) ZAutoLogoffReq = (VAL(MID$(ZMsgRec$,115,1)) <> 0) CALL Trim (ZHomeConf$) IF ZRequiredRings > 0 AND _ INSTR(ZModemInitCmd$,"S0=255") THEN _ COLOR 7,0,0 _ ELSE COLOR ZFG,ZBG,ZBorder IF ZLocalUserMode THEN _ GOTO 44003 CALL SetBaud * REPLACING old line(s) by new * ------[ first line different ]------ 44003 ZUserLogonTime! = VAL(HourLoggedOn$) * 3600! + _ ' KK030901 VAL(MinLoggedOn$) * 60! + _ ' KK030901 VAL(SecLoggedOn$) HourLoggedOn$ = "" MinLoggedOn$ = "" SecLoggedOn$ = "" IF ZMinsPerSession < 1 THEN _ ZMinsPerSession = 3 IF NOT ZEightBit THEN _ OUT ZLineCntlReg,&H1A IF LEFT$(ZMsgRec$,7) = "SYSOP " THEN _ ZFirstName$ = ZSysopPswd1$ : _ ZActiveUserName$ = ZSysopPswd1$ + " " + ZSysopPswd2$ _ ELSE ZFirstNameEnd = INSTR(ZMsgRec$," ") : _ ZLastNameEnd = INSTR(ZFirstNameEnd + 1,ZMsgRec$ + " "," ") : _ ZFirstName$ = LEFT$(ZMsgRec$,ZFirstNameEnd-1) : _ ZLastName$ = MID$(ZMsgRec$,ZFirstNameEnd + 1,ZLastNameEnd - (ZFirstNameEnd + 1)) : _ ZActiveUserName$ = MID$(ZFirstName$ + " " + ZLastName$,1,31) ZWasZ$ = ZFirstName$ CALL OpenWork (2,ZNodeWorkDrvPath$+"DRST"+ZNodeFileID$+".DEF") CALL ReadDir (2,1) ZLimitMinsPerSession = VAL (ZOutTxt$) CALL ReadDir (2,1) ' KG052701 ZWasNG$ = ZOutTxt$ ' KG052701 CALL ReadDir (2,1) ' RC050901 ZIndivValue$ = ZOutTxt$ ' RC050901 CALL ReadDir (2,1) ' KG070601 ZOrigDateTimeOn$ = ZOutTxt$ ' KG070601 CALL ReadDir (2,1) ' KG070601 ZOrigTimeLoggedOn$ = ZOutTxt$ ' KG070601 CLOSE 2 END SUB * REPLACING old line(s) by new 58050 ' $SUBTITLE: 'AllCaps - sub to convert string to upper case' ' $PAGE ' ' NAME -- AllCaps ' ' INPUTS -- PARAMETER MEANING ' ConvertField$ STRING TO MAKE UPPER CASE ' ' OUTPUTS -- ConvertField$ CONVERTED STRINGS ' ' PURPOSE -- Subroutine to convert a string to upper case ' SUB AllCaps (ConvertField$) STATIC IF ZTurboRBBS THEN _ CALL RBBSULC (ConvertField$) : _ EXIT SUB FOR WasZ = 1 TO LEN(ConvertField$) * ------[ first line different ]------ WasX = ASC(MID$(ConvertField$,WasZ,1)) ' KG072601 IF WasX > 96 THEN IF WasX < 123 THEN _ ' KG072601 MID$(ConvertField$,WasZ,1) = CHR$(WasX AND 223) ' KG072601 NEXT END SUB * REPLACING old line(s) by new 58110 ' $SUBTITLE: 'CheckNewBul - sub to check whether got new bulletins' ' $PAGE ' ' NAME -- CheckNewBul ' ' INPUTS -- PARAMETER MEANING ' LastOn$ Last DATE OF LOGON ' FORMAT MM/DD/YY ' ZActiveBulletins # OF BULLETING ' ZBulletinPrefix$ FILESPEC FOR BULLETINS ' ' OUTPUTS -- NumNewBullets NUMBER OF NEW BULLETINS ' NewBullets$ LIST OF NEW BULLET #'S ' ZWasQ WHERE Last BULLETIN STORED ' IN ZUserIn$() ' ZUserIn$() BULLETINS #'S THAT ARE NEW ' (2,3,4,...) ' ' PURPOSE -- Checks how many bulletins have system date ' at or later than date caller last logged on ' SUB CheckNewBul (LastOn$,NumNewBullets,NewBullets$) STATIC IF ZExitToDoors OR ZBulletinPrefix$ = ZPrevPrefix$ THEN _ EXIT SUB ZPrevPrefix$ = ZBulletinPrefix$ NumNewBullets = 0 NewBullets$ = ": " BaseDate# = VAL(MID$(LastOn$,4,2)) + (100 * VAL(MID$(LastOn$,1,2))) + _ (10000# * (1900 + VAL(MID$(LastOn$,7,2)))) CALL FindIt (ZBulletinPrefix$ + ".FCK") WasX = 0 CALL QuickTPut ("Checking new bulletins",0) IF ZOK THEN _ WHILE NOT EOF(2) : _ LINE INPUT #2,WasBN$ : _ GOSUB 58112 : _ WEND _ ELSE FOR WasI = 1 TO ZActiveBulletins : _ WasBN$ = MID$(STR$(WasI),2) : _ GOSUB 58112 : _ NEXT ZWasQ = NumNewBullets + 1 IF NumNewBullets < 1 THEN _ NewBullets$ = "" CALL SkipLine (1) ZOutTxt$ = STR$(NumNewBullets) + _ * ------[ first line different ]------ " New bulletin(s) since last call" + _ ' DA071701 NewBullets$ CALL QuickTPut1 (ZOutTxt$) EXIT SUB * REPLACING old line(s) by new 58140 ' $SUBTITLE: 'LoadNew - subroutine to get latest uploads' ' $PAGE ' ' NAME -- LoadNew ' ' INPUTS -- PARAMETER MEANING ' ZUpldDir$ LIST OF FILES UPLOADED ' ' OUTPUTS -- ZOutTxt$ LATEST UPLOADS ' ' PURPOSE -- Loads table of most recent number of uploads by date ' SUB LoadNew (Ara(2)) STATIC IF ZFMSDirectory$ = "" THEN _ EXIT SUB ZPrevBase$ = "" * ------[ first line different ]------ FirstWarning = ZTrue ' KG041103 IF PrevLoadNew$ = ZFMSDirectory$ THEN _ Ara(1,1) = 0 : _ EXIT SUB PrevLoadNew$ = ZFMSDirectory$ CALL OpenFMS (LastRec) FIELD 2, 23 AS PreDate$, _ 2 AS WasMM$, _ 1 AS Fill1$, _ 2 AS WasDD$, _ 1 AS Fill2$, _ 2 AS Year$, _ (2 + ZMaxDescLen) AS Desc$, _ ' KG071001 3 AS Category$, _ 2 AS Fill4$ MaxRecs = UBOUND(Ara,1) IF MaxRecs < 1 THEN _ MaxRecs = 1 _ ELSE IF MaxRecs > 23 THEN _ MaxRecs = 23 WasL = 0 WasK = LastRec WHILE WasK > 0 AND WasL < MaxRecs GET #2,WasK IF INSTR("\ ",LEFT$(PreDate$,1)) > 0 THEN _ ' KG071001 GOTO 58142 IF (ZCanDnldFromUp OR Category$ <> ZDefaultCatCode$) THEN _ IF VAL(Year$) > 79 THEN _ ' KG041103 WasL = WasL + 1 : _ ' KG041103 Ara(WasL,1) = 372! * (VAL(Year$) - 80!) + 31! * VAL(WasMM$) + VAL(WasDD$) _' KK030901 ELSE IF FirstWarning THEN _ ' KG041103 FirstWarning = ZFalse : _ ' KG041103 ZWasZ$ = "Invalid FMS format " + ZFMSDirectory$ : _ ' KG041103 CALL PScrn (ZWasZ$) : _ ' KG041103 CALL UpdtCalr (ZWasZ$,2) ' KG041103 IF NOT ZCanDnldFromUp THEN _ WasX = ZMinSecToView _ ELSE IF Category$ = "***" THEN _ WasX = ZSysopSecLevel _ ELSE IF Category$ = ZDefaultCatCode$ THEN _ WasX = ZMinSecToView _ ELSE IF LEFT$(PreDate$,1) = "=" THEN _ ' KG071001 CALL CheckInt (Desc$) : _ ' KG071001 WasX = ZTestedIntValue _ ' KG071001 ELSE WasX = ZOptSec(19) ' KG071001 Ara(WasL,2) = WasX * REPLACING old line(s) by new 58150 ' $SUBTITLE: 'CountNewFiles - sub to count how many files new' ' $PAGE ' ' NAME -- CountNewFiles ' ' INPUTS -- PARAMETER MEANING ' LastOn$ Date of last logon ' UPLDS$ Latest uploads ' ' OUTPUTS -- NumNewFiles How many after last logon ' RptPrefix$ Set to "At least " if ' above is a minimum ' ' PURPOSE -- Checks how many files in UPLDS$ were uploaded on or ' after date of last logon that the user can download ' SUB CountNewFiles (LastOn$,Upld(2),NumUserFiles,RptPrefix$) STATIC BaseDate = 372 * (VAL(MID$(LastOn$,7,2)) - 80) + _ 31 * (VAL(MID$(LastOn$,1,2))) + _ VAL(MID$(LastOn$,4,2)) NumNewFiles = 1 NumUserFiles = 0 WHILE (BaseDate <= Upld(NumNewFiles,1) AND _ Upld(NumNewFiles,1) > 0 AND _ NumNewFiles < UBOUND(Upld,1)) IF ZUserSecLevel => Upld(NumNewFiles,2) THEN _ NumUserFiles = NumUserFiles + 1 NumNewFiles = NumNewFiles + 1 WEND IF Upld(NumNewFiles,1) < 1 THEN _ NumNewFiles = NumNewFiles - 1 IF BaseDate <= Upld(NumNewFiles,1) THEN _ * ------[ first line different ]------ RptPrefix$ = "At least" _ ' KG072701 ELSE RptPrefix$ = "" END SUB * REPLACING old line(s) by new 58165 ' $SUBTITLE: 'DispUpDir - sub to display upload direcotry' ' $PAGE ' ' NAME -- DispUpDir ' ' INPUTS -- PARAMETER MEANING ' PassedCats$ FILE "CATEGORIES" TO BE INCLUDED IN ' THE SEARCH. ' SearchString$ STRING TO SEARCH ON WITHIN THE ' FILE "CATEGORIES" SELECTED ' SearchDate$ DATE EQUAL TO OR GREATER THAN TO BE ' SEARCHED FOR WITH THE "CATEGORIES" ' AND THE STRING TO SEARCH. ' DnldFlag SET TO RECORD # OF LINE TO BEGIN ' VIEWING - 0 IF AT END ' ' OUTPUTS -- DnldFlag WHENEVER DOWNLOAD REQUESTED, SETS ' TO NEXT RECORD TO VIEW. OTHERWISE ' LEAVES AT ZERO ' PURPOSE -- Display the files that meet the criteria selected in ' RBBS-PC upload management system on the users screen. ' SUB DispUpDir (PassedCats$,SearchString$, _ SearchDate$,DnldFlag,AbortIndex) STATIC CALL AllCaps (SearchString$) Blank$ = " " ZStopInterrupts = ZFalse ZLastIndex = 0 Categories$ = "," + _ PassedCats$ + _ "," CanDnld = (ZUserSecLevel => ZOptSec(19)) * ------[ first line different ]------ CanView = (ZUserSecLevel => ZOptSec(26)) ' KG082001 ZJumpSupported = ZTrue ZJumpSearching = ZFalse GOSUB 58185 IF DnldFlag > 0 THEN _ UpldIndex = DnldFlag : _ DnldFlag = 0 : _ GOTO 58180 ZJumpLast$ = "" SearchFor$ = SearchString$ ExtraPrompt$ = LEFT$(",V)iew",-(6+4*ZExpertUser)*CanView) ' KG082001 IF CanDnld THEN _ IF ZTurboKeyUser THEN _ ExtraPrompt$ = ExtraPrompt$ + ",D)ownload" _ ELSE ExtraPrompt$ = ExtraPrompt$ + ", file(s) to dwnld" MaxPrint = ZPageLength - 1 BelowMinSec = (ZUserSecLevel < ZMinSecToView) ZNonStop = ZNonStop OR (ZPageLength < 1) FMSCheckPoint = 0 WildSearch = (INSTR(SearchString$,"?") > 0) _ OR (INSTR(SearchString$,"*") > 0) * REPLACING old line(s) by new 58169 CALL CheckInt (MID$(PartToPrint$,34)) IF ZUserSecLevel < ZTestedIntValue THEN _ LastOK = ZFalse : _ * ------[ first line different ]------ FailedSearch = ZFalse : _ ' DA042401 GOTO 58168 MID$(PartToPrint$,1,13) = MID$(PartToPrint$,2,12) + " " ZWasA = LEN(STR$(ZTestedIntValue)) MID$(PartToPrint$,34) = MID$(PartToPrint$,34 + ZWasA) + SPACE$(ZWasA) GOTO 58172 * REPLACING old line(s) by new * ------[ first line different ]------ 58178 IF ZLinesPrinted <= MaxPrint AND (FMSCheckPoint MOD 1000 <> 0) THEN _ ' DA071803 GOTO 58168 CALL CheckCarrier IF ZSubParm = -1 THEN _ GOTO 58183 CALL TimeRemain (MinsRemaining) IF MinsRemaining <= 0 THEN _ ZSubParm = -1 : _ GOTO 58183 IF ZNonStop THEN _ GOTO 58168 IF ZLinesPrinted <= MaxPrint THEN _ IF ZDateOrderedFMS THEN _ ' DA071803 CALL QuickTPut1 (ZEmphasizeOff$ + _ ' DA071803 "Files checked thru " + MID$(PartToPrint$,24,8)) _ ' DA071803 ELSE _ ' DA071803 CALL QuickTPut1 (ZEmphasizeOff$ + STR$(FMSCheckPoint) + _ ' DA071803 " files checked") ' DA071803 * REPLACING old line(s) by new 58180 ZTurboKey = -ZTurboKeyUser ZStackC = ZTrue CALL AskMore (ExtraPrompt$, ZTrue, ZFalse,AbortIndex,ZFalse) IF ZSubParm = -1 THEN _ GOTO 58183 IF ZNo THEN _ GOTO 58183 CALL AllCaps (ZUserIn$(1)) * ------[ first line different ]------ IF ZUserIn$(1) = "V" THEN IF CanView THEN _ ' KG082001 ZLastIndex = ZWasQ : _ ZAnsIndex = 1 : _ CALL GetArc : _ ZJumpSupported = ZTrue : _ ' KG022201 ZWasA = UpldIndex : _ GOSUB 58185 : _ UpldIndex = ZWasA : _ GOTO 58180 IF ZUserIn$(1) = "D" THEN IF CanDwld THEN _ ' KG082001 ZOutTxt$ = "Download what file(s)" : _ ZStackC = ZTrue : _ CALL PopCmdStack : _ IF ZWasQ = 0 THEN _ GOTO 58180 IF ZJumpSearching THEN _ PrevSearch$ = SearchFor$ : _ SearchFor$ = ZJumpTo$ _ ELSE SearchFor$ = SearchString$ : _ IF LEN(ZUserIn$(1)) > 1 THEN _ IF NOT ZYes AND CanDnld THEN _ CALL SkipLine (1) : _ DnldFlag = UpldIndex : _ ZLastIndex = ZWasQ : _ ZAnsIndex = 1 : _ EXIT SUB IF ZNonStop THEN IF UpldIndex > 999 THEN _ IF (SearchDate$ = "" OR NOT ZExpertUser) THEN _ ZOutTxt$ = STR$(UpldIndex) + _ " lines left to search. Really go non-stop? (Y/[N])" : _ ZNoAdvance = ZTrue : _ ZTurboKey = -ZTurboKeyUser : _ ZSubParm = 1 : _ CALL TGet : _ CALL WipeLine (79) : _ ZNonStop = ZYes ' DA071803 GOTO 58168 * REPLACING old line(s) by new 58183 CLOSE 2 ZNonStop = (ZPageLength < 1) ZStopInterrupts = ZFalse ZOutTxt$ = "" * ------[ first line different ]------ ZActiveFMSDir$ = "" ' KG031801 ZJumpSupported = ZFalse EXIT SUB