' $linesize:132 ' $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' ' 20290 ' $SUBTITLE: 'WildFile -- Matches file to a filespec' ' $PAGE ' NAME -- WildFile ' ' INPUTS -- PARAMETER MEANING ' Pattern$ PATTERN TO CHECK AGAINST ' ItemToMatch$ FILE NAME TO MATCH ' ' OUTPUTS -- DoesMatch WHETHER MATCHES ' ' PURPOSE Determine whether a file name is an instance of ' a file specification. Exactly like DOS except that ? must have a ' character. ' SUB WildFile (Pattern$,ItemToMatch$,DoesMatch) STATIC IF Pattern$ <> PrevPattern$ THEN _ CALL BreakFileName (Pattern$,PDrive$,PPrefix$,PExt$,ZFalse) : _ PrevPattern$ = Pattern$ CALL BreakFileName (ItemToMatch$,IDrive$,IPrefix$,IExt$,ZFalse) DoesMatch = ZFalse IF PDrive$ <> "" AND PDrive$ <> IDrive$ THEN _ EXIT SUB CALL WildCard (PPrefix$,IPrefix$) IF NOT ZOK THEN _ EXIT SUB CALL WildCard (PExt$,IExt$) DoesMatch = ZOK END SUB 20293 ' $SUBTITLE: 'SendName - send FILENAME using EXEC-PC protocol' ' $PAGE ' ' NAME -- SendName ' ' INPUTS -- PARAMETER MEANING ' ZUserIn$() ARRAY OF FILENAME FOR AUTODOWNLOAD ' 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 20295 CALL DelayTime (1) ' ONE SECOND DELAY 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 ' 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 20298 CALL FlushCom(ZWasY$) ' COLLECT CHARACTER(ZWasS) USER ECHOED IF ZSubParm = -1 THEN _ EXIT SUB IF MID$(ZOutTxt$,WasX,1) = ZWasY$ THEN _ GOTO 20305 ' IF CORRECTLY ECHOED, THEN CONTINUE IF INSTR(ZWasY$,ZCancel$) THEN _ ZAbort = ZTrue : _ GOTO 20306 ' CHECK FOR USER ZAbort 20300 CALL PutCom (STRING$(5,24)) ' TELL USER THAT FILE NAME IS GARBLED IF ZSubParm = - 1 THEN _ EXIT SUB IF ZAbort = ZTrue THEN _ GOTO 20306 CALL LPrnt("Name Trans Failure",1) ' DISPLAY FAILURE ON SCREEN Attempts = Attempts + 1 ' INCREMENT COUNTER FOR # WasOF TRIES IF Attempts < 6 THEN _ ' TRY IT FIVE TIMES, THEN GIVE UP GOTO 20295 CALL PutCom (STRING$(50,24)) ' GUARANTEE CANCELLATION WasOF USER IF ZSubParm = -1 THEN _ EXIT SUB IF ZAbort = ZTrue THEN _ GOTO 20306 IF ZSnoop THEN _ CALL LPrnt("ABORTING AUTODOWNLOAD!",1) : _ ZAbort = ZTrue : _ GOTO 20306 ' 20305 NEXT ' LOOP BACK FOR NEXT CHARACTER ' CALL PutCom (ZAcknowledge$) ' WHEN FILENAME SENT, ACKNOWLEDGE IF ZSubParm = -1 THEN _ EXIT SUB CALL SkipLine(1) ' CLEAN UP Sysop's DISPLAY ' ' COMPLETION OF AUTODOWNLOAD FILENAME Transfer ' 20306 END SUB 20310 ' $SUBTITLE: 'TestUser - interrogate user for AUTO-Downloading support' ' $PAGE ' ' NAME -- TestUser ' ' INPUTS -- NONE ' ' OUTPUTS -- ZAutoDownYes -1 IF USER'S COMMUNICATION ' SOFTWARE CAN DO AUTODOWNLOADING ' ' ZAutoDownVerified TRUE IF COMMUNICATIONS PGM ' EVER CHECKED ' ' PURPOSE -- Send the user an and if response ' is a recognized package, set appropriate flag. ' SUB TestUser STATIC ' ' ' * TEST FOR COMMUNICATIONS USING WasN,8,1 Protocol AND EXECPC Talk VER 2.0+ ' * TO SEE IF CALLER CAN USE THE AUTODOWNLOAD FEATURE ' ' ZAbort = ZFalse ZAutoDownVerified = ZTrue CALL FlushCom(ZWasY$) ' FLUSH THE COMM BUFFER IF ZSubParm = -1 THEN _ EXIT SUB CALL PutCom (ZEscape$ + ZXOn$) IF ZAbort = ZTrue THEN _ GOTO 20315 CALL DelayTime (2) ' WAIT TWO SECONDS FOR Reply 20313 CALL FlushCom(ZWasY$) ' GET CONTENTS OF COMM BUFFER IF ZSubParm = -1 THEN _ EXIT SUB IF INSTR(ZWasY$,"EXECPC") THEN _ ZComProgram = 1 IF INSTR(ZWasY$,"PIBTERM") THEN _ ZComProgram = 2 IF INSTR(ZWasY$,"PROCOMM") THEN _ ZComProgram = 3 IF INSTR(ZWasY$,"QMODEM") THEN _ ZComProgram = 4 ZAutoDownYes = (ZComProgram > 0 AND ZComProgram < 3) 20315 END SUB 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 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 20708 WasX$ = ZDiskForDos$ + "C" + Ext$ + ZDefaultExtension$ + ".BAT" CALL FindIt (WasX$) IF NOT ZOK THEN _ GOTO 20709 ZOutTxt$ = "Converting" IF Ext$ = ZDefaultExtension$ THEN _ ZOutTxt$ = "Re-" + ZOutTxt$ CALL QuickTPut1 (ZOutTxt$ + " upload to "+ZDefaultExtension$+". Please wait...") CALL ReadDir (2,1) IF EOF(2) THEN _ WasX$ = ZOutTxt$ ZGSRAra$(1) = ZFileName$ CALL BreakFileName (ZFileName$,Pre$,Body$,Ext$,ZTrue) ZFileNameHold$ = Body$ + "." + ZDefaultExtension$ ZUserIn$(0) = ZFileName$ ZFileName$ = Pre$ + ZFileNameHold$ CALL ShellExit (WasX$ + " " + Body$ + " " + ZNodeID$) CALL FindIt (ZFileName$) IF NOT ZOK THEN _ ZFileName$ = ZGSRAra$(1) : _ CALL FindIt (ZFileName$) : _ ZFileNameHold$ = Body$ + Ext$ : _ IF ZOK THEN _ GOTO 20709 GOSUB 20736 20709 CALL QuickTPut1 ("Upload successful") WasX$ = DATE$ ZWasZ$ = LEFT$(WasX$,6) + _ RIGHT$(WasX$,2) StrewTo$ = "" UCat$ = "" 20710 CALL QuickTPut1 ("Describe " + ZFileNameHold$ + _ " (Begin with '/' if for SYSOP only)") CALL QuickTPut1 (LEFT$(" |----+--Min<..-+---2+0---+---3+0---+---4+0---+-", _ ZMaxDescLen - 4) + "..Max>") CALL QuickTPut ("? ",0) ZOutTxt$ = "" ZSubParm = 1 ZParseOff = ZTrue CALL TGet CALL Carrier IF ZSubParm = -1 THEN _ ZUserIn$ = "": _ GOTO 20712 IF LEN(ZUserIn$) > ZMaxDescLen OR LEN(ZUserIn$) < 10 THEN _ CALL QuickTPut1 ("10 chars min," + STR$(ZMaxDescLen) + " max") : _ GOTO 20710 20712 ZOK = 0 CALL CheckNovell (ZOK) IF ZOK <> -1 THEN _ CALL SetSharedAttr (ZFileName$, ZOK) : _ IF ZOK <> 0 THEN _ 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 20715 IF LEFT$(ZUserIn$,1) = "/" THEN _ UCat$ = "***" : _ GOTO 20722 UCat$ = ZDefaultCatCode$ 20717 IF ZSubParm = -1 OR _ ZUserSecLevel < ZSLCategorizeUplds THEN _ GOTO 20722 20719 CALL BufFile (ZUpcatHelp$,WasX) 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 _ 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 20722 IF ZUserSecLevel >= ZAskExtendedDesc AND _ ZMaxExtendedLines > 0 AND ZSubParm <> -1 THEN _ 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 20723 ZUserIn$ = Desc$ WasX$ = DATE$ ZWasZ$ = LEFT$(WasX$,6) + _ RIGHT$(WasX$,2) ZWasEN$ = StrewTo$ GOSUB 20730 ZWasEN$ = ZAllwaysStrewTo$ GOSUB 20730 20725 ZWasEN$ = ZUpldDir$ GOSUB 20730 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 _ CALL QuickTPut1 ("Increased session time by"+WasX$+" minutes") ' KG072701 CALL QuickTPut1 ("Thanks for the upload!") ZGetExtDesc = ZFalse EXIT SUB 20730 ' ---[ lock file ]--- IF ZWasEN$ = "" THEN _ RETURN FMSFormat = ZFalse IF ZWasEN$ = ZFMSDirectory$ OR ZLimitSearchToFMS THEN _ FMSFormat = ZTrue _ ELSE CALL FindIt (ZWasEN$) : _ IF ZOK THEN _ CALL ReadDir (2,1) : _ IF ZErrCode = 0 THEN _ FMSFormat = (LEFT$(ZOutTxt$,4) = "\FMS") IF NOT FMSFormat THEN _ ReadBackwards = ZFalse : _ FixedLen = 0 : _ ZUserIn$ = Desc$ _ ELSE FixedLen = 34 + ZMaxDescLen : _ ZUserIn$ = Desc$ + _ SPACE$(ZMaxDescLen - LEN(Desc$)) + _ UCat$ + _ SPACE$(3 - LEN(UCat$)) : _ ReadBackwards = ZTrue : _ CALL FindIt (ZWasEN$) : _ IF ZOK THEN _ CALL ReadDir (2,1) : _ IF ZErrCode = 0 THEN _ ReadBackwards = (INSTR(ZOutTxt$," TOP ") = 0) CALL LockAppend IF ZErrCode <> 0 THEN _ GOTO 20731 ' ---[ append ]--- IF ZGetExtDesc THEN _ IF ReadBackwards THEN _ FOR WasI = LinesInDesc TO 1 STEP -1 : _ GOSUB 20732 : _ NEXT PRINT #2,USING "\ \######## & &"; _ ZFileNameHold$; _ ZBytesInFile#; _ ZWasZ$; _ ZUserIn$ IF ZGetExtDesc THEN _ IF NOT ReadBackwards THEN _ FOR WasI = 1 TO LinesInDesc : _ GOSUB 20732 : _ NEXT 20731 CALL UnLockAppend FixedLen = 0 RETURN 20732 WasX$ = ZOutTxt$(WasI) CALL Trim (WasX$) IF WasX$ = "" THEN _ RETURN IF NOT FMSFormat THEN _ PRINT #2," ";ZOutTxt$(WasI) : _ RETURN IF FixedLen > LEN(ZOutTxt$(WasI)) THEN _ WasX$ = SPACE$(FixedLen - 1 - LEN(ZOutTxt$(WasI))) + "." _ ELSE WasX$ = "" PRINT #2, " ";LEFT$(ZOutTxt$(WasI),FixedLen);WasX$ RETURN 20734 CALL FindIt (ZFileName$) 20736 IF NOT ZOK THEN _ ZBytesInFile# = 0.0_ ELSE ZBytesInFile# = LOF(2) IF ZBytesInFile# < 2.0 THEN _ EXIT SUB RETURN END SUB 20741 ' $SUBTITLE: 'BadFile - subroutine to find bad file names' ' $PAGE ' ' NAME -- BadFile ' ' INPUTS -- PARAMETER MEANING ' ZViolation$ ' ZViolationsThisSession ' FilName$ NAME OF FILE ' ' OUTPUTS -- Result 1 = FILE NAME IS OK ' 2 = CHARACTER NOT ALLOWED ' 3 = SYSTEM CRASH ATTEMPT ' ZViolationsThisSession NUMBER OF VIOLATIONS ' FilName$ Gets capitalized ' ' 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 BadFile (FilName$,Result) STATIC ' ' ' * TEST FOR INVALID CHARACTERS IN FILENAME ' ' Result = 2 IF LEN(FilName$) < 1 THEN _ EXIT SUB CALL BadFileChar (FilName$,ZOK) IF NOT ZOK THEN _ EXIT SUB CALL AllCaps (FilName$) WasXX = INSTR(FilName$,".") IF WasXX > 0 THEN _ IF WasXX < LEN(FilName$) THEN _ WasXX = INSTR(WasXX + 1,FilName$,".") : _ IF WasXX > 0 THEN _ EXIT SUB WasXX = LEN(FilName$) IF WasXX => 3 THEN _ IF INSTR("PRN:CON:AUX:NUL:",FilName$) THEN _ GOTO 20742 IF WasXX => 4 THEN _ IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",FilName$) THEN _ GOTO 20742 CALL BreakFileName (FilName$,Pre$,Body$,Ext$,ZFalse) IF LEN(Pre$) > 64 OR LEN(Body$) > 8 OR LEN(Body$) < 1 OR LEN(Ext$) > 3 THEN _ EXIT SUB WasXX = LEN(Body$) IF WasXX => 3 THEN _ IF INSTR("PRN:CON:AUX:NUL:",Body$) THEN _ GOTO 20742 IF WasXX => 4 THEN _ IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",Body$) THEN _ GOTO 20742 Result = 1 EXIT SUB 20742 ZViolationsThisSession = ZMaxViolations ZViolation$ = ZViolation$ + _ FilName$ Result = 3 END SUB ' 21105 ' $SUBTITLE: 'Library - sub to support Library downloads' ' $PAGE ' ' NAME -- Library ' ' INPUTS -- PARAMETER MEANING ' ZSubParm 1 = DISPLAY ACTIVE AREA ' 2 = CHANGE ACTIVE AREA ' 3 = DISPLAY PC-SIG ' DISCLAIMER ' 4 = ARCHIVE Library DISK ' 5 = DOWNLOAD COMPLETED ' ZLibType 0 = No Library ACTIVE ' 1 = Library FROM PC-SIG ' ZLibDrive$ Library DRIVE ID ' ' OUTPUTS -- NONE ' ' PURPOSE -- To provide access support for library drives ' SUB Library STATIC STATIC LibSubdirName$(1) STATIC DiskTitle$ ZErrCode = 0 IF ZLibType = 0 THEN _ EXIT SUB IF ZLibDiskChar$ = "" THEN _ ZLibDiskChar$ = "0000" ON ZSubParm GOTO 21110, 21115, 21130, 21140, 21159 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 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 21115 IF ZWasQ = 1 THEN _ ZOutTxt$ = "Change Library disk from " + _ ZLibDiskChar$ + _ " to (1 -" + _ STR$(ZLibMaxDisk) + _ ")" : _ ZSubParm = 1 : _ CALL TGet : _ IF ZSubParm = -1 THEN _ EXIT SUB _ ELSE IF ZWasQ = 0 THEN _ ZLibDiskChar$ = "0000" : _ ChdirLib$ = ZLibDrive$ + _ "\" : _ GOTO 21126 21117 IF VAL(ZUserIn$(ZWasQ)) < 1 OR VAL(ZUserIn$(ZWasQ)) > ZLibMaxDisk THEN _ ZWasQ = 1 : _ GOTO 21115 21120 ZLibDiskChar$ = ZUserIn$(ZWasQ) CLOSE 2 ZLibDiskChar$ = RIGHT$("0000" + ZLibDiskChar$,4) 21121 CALL FindIt("RBBS-CDR.DEF") IF NOT ZOK THEN _ EXIT SUB 21122 IF EOF(2) THEN _ ZLibDiskChar$ = "" : _ EXIT SUB INPUT #2,WorkSubdir$,ChdirLib$ LINE INPUT #2,DiskTitle$ IF ZLibDiskChar$ = WorkSubdir$ THEN _ ChdirLib$ = ZLibDrive$ + _ ChdirLib$ : _ GOTO 21126 GOTO 21122 21126 ZErrCode = 0 CALL ChangeDir (ChdirLib$) IF ZErrCode <> 0 THEN _ ZLibDiskChar$ = "0000" : _ ChdirLib$ = ZLibDrive$ + _ "\" : _ GOTO 21126 EXIT SUB 21130 IF ZLibType <> 1 THEN _ EXIT SUB CALL SkipLine(1) 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 21140 IF ZLibDiskChar$ = "0000" THEN _ CALL QuickTPut1 ("First select a Library disk!") : _ EXIT SUB ZOutTxt$ = "Archive files in Library disk - " + _ ZLibDiskChar$ + _ " for download (Y/[N])" ZSubParm = 1 CALL TGet IF NOT ZLocalUser THEN _ IF ZSubParm = -1 THEN _ EXIT SUB IF NOT ZYes THEN _ EXIT SUB 21145 CALL KillWork (ZLibWorkDiskPath$ + _ ZLibNodeID$ + _ "DK*." + Extension$) 21150 CALL QuickTPut1 ("Work/RAM disk purged") CALL QuickTPut1 ("Archiving with " + _ ZLibArcProgram$ + _ " Please be patient!") REDIM LibSubdirName$(10) LibSubdirChar$ = "" LibLoopCount = 0 GOSUB 21157 ZOutTxt$ = "Contents of Library disk - " + _ ZLibDiskChar$ + _ " now archived for download" CALL QuickTPut1 (ZOutTxt$) ZOutTxt$ = "Searching for Sub-directories" CALL QuickTPut1 (ZOutTxt$) GOSUB 21158 LibDiskArc$ = ZLibDiskChar$ ' ' SEARCH AND ARCHIVE ANY SUBDIRECTORIES ' Treedir$ = ZLibWorkDiskPath$ + _ ZLibNodeID$ + _ "DKDIR.LST" DirCmd$ = "DIR " + _ ZLibDrive$ + _ " | FIND " + _ CHR$(34) + _ " " + _ CHR$(34) + _ " > " + _ Treedir$ 21151 SHELL DirCmd$ CALL SkipLine (2) LOCATE 24,1 ZErrCode = 0 21152 CLOSE 2 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$ + _ 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 21155 NEXT LibLoopCount 21156 CALL Carrier ZOutTxt$ = "" EXIT SUB 21157 LibArc$ = ZLibArcPath$ + _ ZLibArcProgram$ + _ " " + _ ZLibWorkDiskPath$ + _ ZLibNodeID$ + _ "DK" + _ ZLibDiskChar$ + _ LibSubdirChar$ + _ " " + _ ZLibDrive$ + _ "*.*" IF ZUseDeviceDriver$ <> "" AND ZFossil AND NOT ZLocalUser THEN _ LibArc$ = ZDiskForDos$ + _ "COMMAND /C " + _ LibArc$ + _ " > " + _ ZUseDeviceDriver$ SHELL LibArc$ CALL SkipLine (2) LOCATE 24,1 RETURN 21158 LibSubdirName$(LibLoopCount) = ZLibNodeID$ + _ "DK" + _ ZLibDiskChar$ + _ LibSubdirChar$ RETURN 21159 FOR LibDisplayCount = 0 TO LibLoopCount - 1 IF LibSubdirName$(LibDisplayCount) = ZOutTxt$ THEN _ LibSubdirName$(LibDisplayCount) = "" NEXT END SUB 21598 ' $SUBTITLE: 'XferType - sub to identify file xfer protocol' ' $PAGE ' ' NAME -- XferType ' ' INPUTS -- PARAMETER MEANING ' Index = 1 Manual select for up/download ' = 2 Default select ' = 3 Set transfer default ' ZOutTxt$ ' ZUserIn$(1) ' ZWasQ ' ZReliableMode ' ZTransferOption$ ' ZUserXferDefault$ ' ZXferSupport ' ' OUTPUTS -- ZCheckSum ' ZFLen ' ZWasFT$ ' ' PURPOSE -- To identify the file transfer protocol (either ' from the user's default or via explicit selection) ' SUB XferType (Index,SkipHelp) STATIC IF ZTransferOption$ = "" OR ZUserSecLevel <> PrevUSL THEN _ CALL Protocol : _ PrevUSL = ZUserSecLevel WasX$ = ZOutTxt$ + "Protocol" ON Index GOTO 21600,21620,21600 ' ' ' * MANUAL SELECT OF Transfer Protocol ' ' 21600 IF SkipHelp THEN _ GOTO 21604 21602 CALL BufFile (ZHelpPath$ + "UF" + ZHelpExtension$,WasX) IF ZSubParm = -1 THEN _ EXIT SUB 21604 ZStopInterrupts = ZTrue IF Index = 3 THEN _ IF ZAnsIndex < ZLastIndex THEN _ GOTO 21605 CALL QuickTPut1 (WasX$) CALL BufString (ZTransferOption$,4096,WasX) CALL QuickTPut (MID$("?!",1-ZTurboKeyUser,1)+" ",0) 21605 ZOutTxt$ = "" ZTurboKey = -ZTurboKeyUser ZMacroMin = 2 ZSubParm = 1 ZSuspendAutoLogoff = ZTrue ZStackC = ZTrue IF Index = 3 THEN _ CALL PopCmdStack : _ WasX = ZAnsIndex _ ELSE ZSubParm = 1 : _ CALL TGet : _ WasX = 1 ZSuspendAutoLogoff = ZFalse IF ZSubParm = -1 THEN _ EXIT SUB IF ZWasQ = 0 THEN _ GOTO 21604 21606 ZWasZ$ = ZUserIn$(WasX) ' ' ' * DEFAULT SELECT OF Transfer Protocol ' ' 21610 CALL AllCaps (ZWasZ$) 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 21612 ZWasFT$ = MID$(ZDefaultXfer$,ZFF,1) ZInternalProt$ = MID$(ZInternalEquiv$,ZFF,1) GOTO 21621 21620 ZFF = -1 IF ZCmdTransfer$ <> "" THEN _ ZWasZ$ = ZCmdTransfer$ : _ GOTO 21610 WasX = INSTR(ZDefaultXfer$,ZUserXferDefault$) IF WasX > 0 THEN _ IF MID$(ZInternalEquiv$,WasX,1) <> "N" THEN _ ZWasZ$ = ZUserXferDefault$ : _ GOTO 21610 ZProtoPrompt$ = "None" ZFF = 0 EXIT SUB 21621 IF ZFF = PrevFF AND PrevProtoDef$ = ZProtoDef$ THEN _ ZProtoPrompt$ = PrevProtoPrompt$ : _ EXIT SUB PrevFF = ZFF PrevProtoDef$ = ZProtoDef$ ZInternalProt$ = MID$(ZInternalEquiv$,ZFF,1) ZCheckSum = (ZInternalProt$ = "X") CALL FindIt (ZProtoDef$) IF ZOK THEN _ GOTO 21623 WasX = INSTR("AXCYN",ZInternalProt$) IF WasX < 1 THEN _ ZInternalProt$ = "N" ZProtoPrompt$ = MID$("Ascii Xmodem Xmodem/CRCYmodem None",10*INSTR("AXCYN",ZInternalProt$)-9,10) CALL TrimTrail (ZProtoPrompt$," ") ZCheckSum = (ZInternalProt$ = "X") ZFLen = 128 - 896 * (ZInternalProt$ = "Y") ZBlockSize = ZFLen IF ZInternalProt$ = "Y" THEN _ ZSpeedFactor! = 0.87 _ ELSE IF ZInternalProt$ = "A" THEN _ ZSpeedFactor! = 0.92 _ ELSE ZSpeedFactor! = 0.78 GOTO 21625 21623 CALL ReadParms (ZWorkAra$(),13,ZFF) IF ZErrCode > 0 THEN _ ZFF = LEN(ZDefaultXfer$) : _ ZProtoPrompt$ = "None" : _ GOTO 21625 ZProtoPrompt$ = ZWorkAra$(1) IF LEN(ZProtoPrompt$) > 2 THEN _ IF MID$(ZProtoPrompt$,2,1) = ")" THEN _ ZProtoPrompt$ = LEFT$(ZProtoPrompt$,1) + MID$(ZProtoPrompt$,3) WasX = INSTR(ZProtoPrompt$+ZCrLf$,ZCrLf$) ZProtoPrompt$ = LEFT$(ZProtoPrompt$,WasX-1) CALL Trim (ZProtoPrompt$) ZProtoMethod$ = LEFT$(ZWorkAra$(3),1) CALL AllCaps (ZProtoMethod$) ZReq8Bit = (LEFT$(ZWorkAra$(4),1) = "8") ZDownTemplate$ = ZWorkAra$(12) ZUpTemplate$ = ZWorkAra$(13) WasX$ = ZWorkAra$(11) WasX = INSTR(WasX$,"=") ZAdvanceProtoWrite = ZFalse IF WasX < 2 OR WasX >= LEN(WasX$) THEN _ ZFailureParm = 4 : _ ZFailureString$ = "F" _ ELSE ZFailureParm = VAL(LEFT$(WasX$,WasX-1)) : _ ZFailureString$ = MID$(WasX$,WasX+1) : _ WasX = INSTR(ZFailureString$,"=") : _ IF WasX > 0 THEN _ ZAdvanceProtoWrite = (MID$(ZFailureString$,WasX) = "=A") : _ ZFailureString$ = LEFT$(ZFailureString$,WasX-1) ZProtoMacro$ = ZWorkAra$(10) ZFakeXRpt = (LEFT$(ZWorkAra$(8),1) = "F") ZBatchProto = (LEFT$(ZWorkAra$(6),1) = "B") ZSpeedFactor! = VAL(ZWorkAra$(9)) IF ZSpeedFactor! < 0.1 THEN _ ZSpeedFactor! = 0.87 ZBlockSize = VAL(ZWorkAra$(7)) ZFLen = ZBlockSize IF ZFLen < 1 THEN _ ZFLen = 128 21625 PrevProtoPrompt$ = ZProtoPrompt$ END SUB 21993 ' $SUBTITLE: 'FileLock - subroutine to share RBBS-PC files' ' $PAGE ' ' NAME -- FileLock ' ' INPUTS -- PARAMETER MEANING ' ZSubParm = 1 UNLOCK USERS AND MESSAGES ' 2 FLUSH MESSAGE RECORD TO DISK ' AND UNLOCK MESSAGES ' 3 LOCK MESSAGE FILE ' 4 UNLOCK MESSAGE FILE ' 5 LOCK USER FILE ' 6 LOCK 4 RECORD BLOCK IN USER ' FILE ' 7 UNLOCK USER FILE ' 8 UNLOCK 4 RECORD BLOCK IN USER ' FILE ' 9 LOCK UPLOAD DIRECTORY OR ' COMMENTS FILE ' 10 UNLOCK UPLOAD DIRECTORY OR ' COMMENTS FILE ' ACTIVE.MESSAGE FILE$ NAME OF MESSAGE FILE ' ZActiveUserFile$ NAME OF USER FILE ' CONFIG.FILE.NAME$ FILE NAME TO FLUSH RECORD FROM ' ZWasEN$ UPLOAD DIRECTORY OR COMMENTS ' FILE NAME TO LOCK/UNLOCK ' ZNetworkType TYPE OF NETWORK LOCKING TO USE ' ' OUTPUTS -- ZSubParm = -1 TERMINATE RBBS-PC IMMEDATELY ' ZBlk ' ZLockDrive ' ZLockFileName$ ' ZLockStatus$ ' ZMsgFileLock ' ZUserBlockLock ' ZUserFileLock ' ZUserFileIndex ' ' PURPOSE -- To lock and unlock the shared RBBS-PC files when ' multiple copies of RBBS-PC are sharing the same ' files in either a multi-tasking DOS environment or ' in a local area network environment ' SUB FileLock STATIC ON ZSubParm GOSUB 21995,21996,22000,25000,26000, _ 26500,27000,27500,29000,29500 EXIT SUB ' ' ' * UNLOCK USERS AND MESSAGES ' ' 21995 GOSUB 27000 GOSUB 25000 RETURN ' ' ' * FLUSH MESSAGE FILE DATA TO DISK BY OPENING DUMMY FILE # 1 ' ' 21996 CLOSE 1 IF ZShareIt THEN _ OPEN ZConfigFileName$ FOR INPUT SHARED AS #1 _ ELSE OPEN "I",1,ZConfigFileName$ ' ' ' * UNLOCK MESSAGES ' ' GOSUB 25000 CALL OpenMsg RETURN ' ' ' * LOCK MESSAGE FILE ' ' 22000 IF ZMsgFileLock = ZTrue THEN _ RETURN ZMsgFileLock = ZTrue MID$(ZLockStatus$,1,2) = "LM" ZSubParm = 2 CALL Line25 ZLockFileName$ = ZActiveMessageFile$ ON ZNetworkType GOTO 22100,22200,22300,22400,22500,29700 RETURN ' ' ' * LOCK MESSAGE FILE (MULTI-LINK) ' ' 22100 WasAX = &H0 WasBX = &H1 IF ZMultiLinkPresent > 0 THEN _ CALL RBBSML(WasAX,WasBX) RETURN ' ' ' * LOCK MESSAGE FILE (OMNINET) ' ' 22200 CALL BreakFileName (ZActiveMessageFile$,Drive$,Prefix$,Ext$,ZFalse) WasCC$ = CHR$(1) + _ LEFT$(Prefix$ + SPACE$(8),8) GOSUB 28000 IF WasCT = 0 THEN _ RETURN CALL DelayTime (1) GOTO 22200 ' ' ' * LOCK MESSAGE FILE (ORCHID PC-NET) ' * LOCK USER FILE (ORCHID PC-NET) ' * LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (ORCHID PC-NET) ' ' 22300 GOSUB 28100 CALL LPLKIT(ZLockDrive,ZLockFileName$,ZWasA) RETURN ' ' ' * LOCK SYSTEM (DESQview) ' ' 22400 CALL DVLock("MESSAGE") RETURN ' ' ' * LOCK MESSAGE FILE (10 NET) ' * LOCK USER FILE (10 NET) ' * LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (10 NET) ' ' 22500 GOSUB 28100 CALL LPLK10(ZLockDrive,ZLockFileName$,ZWasA) RETURN ' ' ' * UNLOCK MESSAGE FILE ' ' 25000 IF NOT ZMsgFileLock THEN _ RETURN ZMsgFileLock = ZFalse MID$(ZLockStatus$,1,2) = "UM" ZSubParm = 2 CALL Line25 ZLockFileName$ = ZActiveMessageFile$ ON ZNetworkType GOTO 25100,25200,25300,25400,25500,29800 RETURN ' ' ' * UNLOCK MESSAGE FILE (MULTI-LINK) ' ' 25100 WasAX = &H100 WasBX = &H1 IF ZMultiLinkPresent > 0 THEN _ CALL RBBSML(WasAX,WasBX) RETURN ' ' ' * UNLOCK MESSAGE FILE (OMNINET) ' ' 25200 CALL BreakFileName (ZActiveMessageFile$,Drive$,Prefix$,Ext$,ZFalse) WasCC$ = CHR$(17) + _ LEFT$(Prefix$ + SPACE$(8),8) GOSUB 28000 IF WasCT = 128 THEN _ RETURN CALL DelayTime (1) GOTO 25200 ' ' ' * UNLOCK MESSAGE FILE (ORCHID PC-NET) ' * UNLOCK USER FILE (ORCHID PC-NET) ' * UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (ORCHID PC-NET) ' ' 25300 GOSUB 28100 CALL UNLOKIT(ZLockDrive,ZLockFileName$,ZWasA) RETURN ' ' ' * UNLOCK MESSAGE FILE (DESQVIEW) ' ' 25400 CALL DVUnlock("MESSAGE") RETURN ' ' ' * UNLOCK MESSAGE FILE (10 NET) ' * UNLOCK USER FILE (10 NET) ' * UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (10 NET) ' ' 25500 GOSUB 28100 CALL UNLOK10(ZLockDrive,ZLockFileName$,ZWasA) RETURN ' ' ' * LOCK USER FILE ' ' 26000 IF ZUserFileLock = ZTrue THEN _ RETURN ZUserFileLock = ZTrue MID$(ZLockStatus$,4,2) = "LU" ZSubParm = 2 CALL Line25 ZLockFileName$ = ZActiveUserFile$ ON ZNetworkType GOTO 26100,26200,22300,26300,22500,29720 RETURN ' ' ' * LOCK USER FILE (MULTI-LINK) ' ' 26100 WasAX = &H0 WasBX = &H2 IF ZMultiLinkPresent > 0 THEN _ CALL RBBSML(WasAX,WasBX) RETURN ' ' ' * LOCK USER FILE (OMNINET) ' ' 26200 CALL BreakFileName (ZActiveUserFile$,Drive$,Prefix$,Ext$,ZFalse) WasCC$ = CHR$(1) + _ LEFT$(Prefix$ + SPACE$(8),8) GOSUB 28000 IF WasCT = 0 THEN _ RETURN CALL DelayTime (1) GOTO 26200 ' ' ' * LOCK USER FILE (DESQVIEW) ' ' 26300 CALL DVLock("USER") RETURN ' ' ' * LOCK 4 RECORD BLOCK IN USER FILE ' ' 26500 IF ZUserBlockLock = ZTrue THEN _ RETURN ZUserBlockLock = ZTrue ZBlk = (ZUserFileIndex / 4) + .26 MID$(ZLockStatus$,7,2) = "LB" ZSubParm = 2 CALL Line25 ON ZNetworkType GOTO 26600,26700,26800,26750,26900,29730 RETURN ' ' ' * LOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK) ' ' 26600 WasAX = &H0 WasBX = ZBlk + 10 IF ZMultiLinkPresent > 0 THEN _ CALL RBBSML(WasAX,WasBX) RETURN ' ' ' * LOCK 4 RECORD BLOCK IN USER FILE (OMNINET) ' ' 26700 WasCC$ = CHR$(1) + _ "BLK" + _ RIGHT$("0000" + MID$(STR$(ZBlk),2),5) GOSUB 28000 IF WasCT = 0 THEN _ RETURN CALL DelayTime (1) GOTO 26700 ' ' ' * LOCK 4 RECORD BLOCK IN USER FILE (DESKVIEW) ' ' 26750 CALL DVLock("BLK" + RIGHT$("0000" + MID$(STR$(ZBlk),2),5)) RETURN ' ' ' * LOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET) ' ' 26800 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _ "BLK" + _ RIGHT$("0000" + MID$(STR$(ZBlk),2),5) GOTO 22300 ' ' ' * LOCK 4 RECORD BLOCK IN USER FILE (10 NET) ' ' 26900 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _ "BLK" + _ RIGHT$("0000" + MID$(STR$(ZBlk),2),5) GOTO 22500 ' ' ' * UNLOCK USER FILE ' ' 27000 IF NOT ZUserFileLock THEN _ RETURN ZUserFileLock = ZFalse MID$(ZLockStatus$,4,2) = "UU" ZSubParm = 2 CALL Line25 ZLockFileName$ = ZActiveUserFile$ ON ZNetworkType GOTO 27100,27200,25300,27300,25500,29820 RETURN ' ' ' * UNLOCK USER FILE (MULTI-LINK) ' ' 27100 WasAX = &H100 WasBX = &H2 IF ZMultiLinkPresent > 0 THEN _ CALL RBBSML(WasAX,WasBX) RETURN ' ' ' * UNLOCK USER FILE (OMNINET) ' ' 27200 CALL BreakFileName (ZActiveUserFile$,Drive$,Prefix$,Ext$,ZFalse) WasCC$ = CHR$(17) + _ LEFT$(Prefix$ + SPACE$(8),8) GOSUB 28000 IF WasCT = 128 THEN _ RETURN CALL DelayTime (1) GOTO 27200 ' ' ' * UNLOCK USER FILE (DESQVIEW) ' ' 27300 CALL DVUnlock("USER") RETURN ' ' ' * UNLOCK 4 RECORD BLOCK IN USER FILE ' ' 27500 IF NOT ZUserBlockLock THEN _ RETURN ZUserBlockLock = ZFalse ZBlk = (ZUserFileIndex / 4) + .26 MID$(ZLockStatus$,7,2) = "UB" ZSubParm = 2 CALL Line25 ON ZNetworkType GOTO 27600,27700,27800,27750,27900,29830 RETURN ' ' ' * UNLOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK) ' ' 27600 WasAX = &H100 WasBX = ZBlk + 10 IF ZMultiLinkPresent > 0 THEN _ CALL RBBSML(WasAX,WasBX) RETURN ' ' ' * UNLOCK 4 RECORD BLOCK IN USER FILE (OMNINET) ' ' 27700 WasCC$ = CHR$(17) + _ "BLK" + _ RIGHT$("0000" + MID$(STR$(ZBlk),2),5) GOSUB 28000 IF WasCT = 128 THEN _ RETURN CALL DelayTime (1) GOTO 27700 ' ' ' * UNLOCK 4 RECORD BLOCK IN USER FILE (DESQVIEW) ' ' 27750 CALL DVUnlock("BLK" + RIGHT$("0000" + MID$(STR$(ZBlk),2),5)) RETURN ' ' ' * UNLOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET) ' ' 27800 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _ "BLK" + _ RIGHT$("0000" + MID$(STR$(ZBlk),2),5) GOTO 25300 ' ' ' * UNLOCK 4 RECORD BLOCK IN USER FILE (10-NET) ' ' 27900 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _ "BLK" + _ RIGHT$("0000" + MID$(STR$(ZBlk),2),5) GOTO 25500 ' ' ' * CORVUS OMNINET INTERFACE ' ' 28000 WasCC$ = ZLineFeed$ + _ CHR$(0) + _ CHR$(11) + _ WasCC$ CALL CDSend(WasCC$) CALL CDRecv(ZWasCN$) WasCT = ASC(MID$(ZWasCN$,3,1)) IF WasCT => 128 THEN _ CALL LPrnt("CORVUS LOCK FAIL",1) : _ ZSubParm = -1 28010 WasCT = ASC(MID$(ZWasCN$,4,1)) IF WasCT => 129 THEN _ CALL LPrnt("CORVUS FULL",1) : _ ZSubParm = -1 RETURN ' ' ' * ORCHID PC-NET & 10 NET INTERFACE ' ' 28100 CALL AllCaps (ZLockFileName$) ZLockDrive = ASC(LEFT$(ZLockFileName$,1)) - ASC("A") ZLockFileName$ = ZLockFileName$ + _ STRING$(32 - LEN(ZLockFileName$),0) ZWasA = 0 RETURN ' ' ' * LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ ' ' 29000 IF LockedEn$ = ZWasEN$ THEN _ RETURN LockedEn$ = ZWasEN$ MID$(ZLockStatus$,10,2) = "LD" ZSubParm = 2 CALL Line25 ZLockFileName$ = ZWasEN$ ON ZNetworkType GOTO 29100,29010,22300,29300,22500,29710 29010 RETURN ' ' ' * LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (MULTI-LINK) ' ' 29100 WasAX = &H0 WasBX = &H3 IF ZMultiLinkPresent > 0 THEN _ CALL RBBSML(WasAX,WasBX) RETURN ' ' ' * LOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW) ' ' 29300 CALL DVLock("MISC") RETURN ' ' ' * UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ ' ' 29500 IF LockedEn$ <> ZWasEN$ THEN _ RETURN LockedEn$ = "" MID$(ZLockStatus$,10,2) = "UD" ZSubParm = 2 CALL Line25 ZLockFileName$ = ZWasEN$ ON ZNetworkType GOTO 29600,29510,25300,29650,25500,29810 29510 RETURN ' ' ' * UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (MULTI-LINK) ' ' 29600 WasAX = &H100 WasBX = &H3 IF ZMultiLinkPresent > 0 THEN _ CALL RBBSML(WasAX,WasBX) EXIT SUB ' ' ' * UNLOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW) ' ' 29650 CALL DVUnlock("MISC") RETURN ' ' ' * NetBIOS SEMAPHORE LOCK MECHANISM ' * Only the USERS file is actually locked. All other files are locked ' * by means of the semaphore file IBMFLAGS. Each IBMFLAGS record is a ' * file semaphore as follows: ' * RECORD 1 = MESSAGES file lock status ' * RECORD 2 = Comments/Upload dir locked ' * RECORD 3 = entire USERS file lock ' ' ' * Lock MESSAGES 29700 CALL NetBIOS (1,6,1) RETURN ' * Lock Comments/Upload dir 29710 CALL NetBIOS (1,6,2) RETURN ' * Lock USERS file 29720 CALL NetBIOS (1,6,3) RETURN ' * Lock single USERS record 29730 CALL NetBIOS (1,6,3) RETURN ' * UNLOCK MESSAGES 29800 CALL NetBIOS (0,6,1) RETURN ' * UNLOCK Comments/Upload dir 29810 CALL NetBIOS (0,6,2) RETURN ' * UNLOCK USERS file 29820 CALL NetBIOS (0,6,3) RETURN ' * UNLOCK single USERS record 29830 CALL NetBIOS (0,6,3) RETURN END SUB 30000 ' $SUBTITLE: 'InitIBM - sub to create/open NetBIOS semaphore file' ' $PAGE ' ' NAME -- InitIBM (Written by Doug Azzarito) ' ' INPUTS -- NONE ' ' OUTPUTS -- ZSubParm = -1 Abort RBBS ' ' PURPOSE -- Open semaphore file "IBMFLAGS" on default drive as file #6 ' Create file if it does not exits. ' SUB InitIBM STATIC ' ' ' * SEE IF FILE EXISTS ' ' ZShareIt = ZTrue CALL BreakFileName (ZMainMsgFile$,IBMFlagFile$,Dummy$,Dummy$,ZTrue) IBMFlagFile$ = IBMFlagFile$ + _ "IBMFLAGS" CALL FindIt (IBMFlagFile$) CLOSE 2 IF ZOK THEN _ GOTO 30020 ' ' ' * CREATE A NEW FILE, EACH RECORD IS A SEMAPHORE ' ' OPEN IBMFlagFile$ ACCESS WRITE AS #6 LEN=2 FIELD 6, 2 AS LockBuf$ LSET LockBuf$ = MKI$(0) FOR WasI = 1 TO 3 PUT 6 NEXT CLOSE #6 30020 OPEN IBMFlagFile$ ACCESS READ WRITE SHARED AS #6 LEN=2 END SUB 30500 ' $SUBTITLE: 'OpenMsg - open the MESSAGES file' ' $PAGE ' ' NAME -- OpenMsg ' ' INPUTS -- PARAMETER MEANING ' ZActiveMessageFile$ ' ZShareIt ' ' OUTPUTS -- ZMsgRec$ ' SUB OpenMsg STATIC ' ' ' * OPEN AND DEFINE MESSAGE FILE ' ' CLOSE 1 IF ZShareIt THEN _ OPEN ZActiveMessageFile$ ACCESS READ WRITE SHARED AS #1 _ ELSE OPEN "R",1,ZActiveMessageFile$ FIELD 1,128 AS ZMsgRec$ END SUB 30595 ' $SUBTITLE: 'FindFKey - sub to handle local keyboard functions' ' $PAGE ' ' NAME -- FindFKey ' ' INPUTS -- PARAMETER MEANING ' ZActiveMenu$ INDICATOR OF ACTIVE MENU ' ZAdjustedSecurity Switch INDICATING TEMP. SECURITY CHANGE ' ZAutoDownDesired USER'S PREFERENCE FOR AUTODOWNLOADING ' ZCallersFile$ NAME OF CALLERS FILE ' ZChatAvail Toggle INDICATING IF Sysop WILL CHAT ' ZCheckBulletLogon USER'S PREFERENCE FOR BULLETIN CHECK ' ZConfMode INDICATOR THAT USER IS IN A CONFERENCE ' ZCursorLine LINE THAT THE CURSOR IS AT ' ZCursorRow ROW THAT THE CURSOR IS AT ' ZDiskForDos$ DISK TO LOAD COMMAND.COM FROM ' ZDiskFullGoOffline INDICATOR OF WHAT TO DO WHEN DISK FULL ' ZExitToDoors FLAG INDICATING EXITING TO DOORS ' ZExpertUser FLAG FOR EXPERT/NOVICE USER MODE ' ZFirstName$ LOGGED ON USER'S First NAME ' ZF1Key FUNCTION KEY ONE VALUE ' ZF10Key FUNCTION KEY TEN VALUE ' ZWasGR GRAPHICS PREFERENCE OF USER ' ZLineFeeds SWTICH FOR USER'S LINE FEED PREFERENCE ' ZLocalUser FLAG INDICATING USER IS LOCAL ' ZMinLogonSec MINIMUM SECURITY TO LOGON ' ZModemGoOffHookCmd$ COMMAND TO TAKE MODEM OFF-HOOK ' ZModemInitBaud$ BAUD TO INITIALIZE MODEM AT ' ZNodeID$ NODE IDENTIFIER ' ZNodeRecIndex NODE RECORD Index FOR THIS NODE ' ZNulls Switch FOR USER'S PREFERENCE FOR Nulls ' ZPrinter Toggle INDICATING Printer IS AVAILABLE ' ZPromptBell USER'S PREFERENCE FOR BELLS ON PROMPTS ' SECONDS.PER.SESSION TIME LEFT IN CURRENT USER SESSION ' ZSkipFilesLogon USER'S LOGON NOTIFICIATION PREFERENCE ' ZSnoop Toggle INDICATING Snoop STATUS ' ZSubParm -8 = Sysop'S OPTION 6 REMOTELY ' -9 = GOT TO DOS ' -10 = Sysop GET'S SYSTEM NEXT ' ZSysop INDICATOR THAT USER IS Sysop ' ZSysopAnnoy Toggle INDICATING Sysop IS AVAILABLE ' ZSysopNext Toggle SO Sysop GETS SYSTEM NEXT ' ZUpperCase USER'S PREFERENCE FOR UPPER/LOWER CASE ' ZUserFileIndex Index INTO THE USER FILE FOR CALLER ' ZUserSecLevel USER'S SECURITY LEVEL ' USERT.TRANSFER.DEFAULT USER'S FILE Transfer DEFAULT PREFERENCE ' ' OUTPUTS -- ' ZAdjustedSecurity Switch INDICATING TEMP. SECURITY CHANGE ' ZChatAvail Toggle INDICATING IF Sysop WILL CHAT ' ZFunctionKey VALUE 1 TO 10 CORRESPONDING TO ' THE FUNCTION KEY THAT WAS PRESSED ' ZKeyPressed$ CHARACTER STRING GENERATED BY KEY ' ZPrinter TOGGLE INDICATING Printer IS AVAILABLE ' ZSnoop Toggle INDICATING Snoop STATUS ' ZSysop INDICATOR THAT USER IS Sysop ' ZSysopAnnoy Toggle INDICATING Sysop IS AVAILABLE ' ZSysopNext Toggle SO Sysop GETS SYSTEM NEXT ' ZSubParm -1 Carrier LOST ' -2 CHAT MODE ACTIVATED ' -3 FORCE CALLER ON-LINE ' -4 EXIT TO SYSTEM IMMEDIATELY ' -5 EXIT TO SYSTEM AFTER MULTI-LINK CALL ' -6 TELL USER ACCESS IS DENIED ' -7 UPDATE CALLERS FILE AND DENY ACCESS ' ZUserSecLevel USER'S SECURITY LEVEL ' ' PURPOSE -- To determine if a function has been pressed on ' the PC'S keyboard that is running RBBS-PC. ' SUB FindFKey STATIC LookUp = ZSubParm IF ZSubParm < -1 THEN _ ZSubParm = 0 : _ IF LookUp = - 8 THEN _ GOTO 33070 _ ELSE IF LookUp = - 9 THEN _ GOTO 31000 _ ELSE IF LookUp = - 10 THEN _ GOTO 33090 ' ' ' * TEST FOR FUNCTION KEY PRESSED ' ' 30600 IF ZKeyboardStack$ = "" THEN _ ZKeyPressed$ = INKEY$ _ ELSE ZKeyPressed$ = ZKeyboardStack$ : _ ZKeyboardStack$ = "" ZFunctionKey = 0 IF LEN(ZKeyPressed$) <> 2 THEN _ GOTO 33970 ZKeyPressed = ASC(RIGHT$(ZKeyPressed$,1)) IF ZLocalUser AND NOT ZSysop THEN _ ZKeyPressed$ = "" : _ GOTO 33970 IF ZKeyPressed => ZF1Key AND _ ZKeyPressed <= ZF10Key THEN _ ZFunctionKey = ZKeyPressed - 58 : _ GOTO 30610 IF ZKeyPressed = 117 THEN _ 'Ctrl-End ZFunctionKey = 11 IF ZKeyPressed = 73 THEN _ 'PgUp ZFunctionKey = 12 IF ZKeyPressed = 72 THEN _ 'up arrow ZFunctionKey = 13 IF ZKeyPressed = 80 THEN _ 'Down arrow ZFunctionKey = 14 IF ZKeyPressed = 81 THEN _ 'PgDn ZFunctionKey = 15 IF ZKeyPressed = 75 THEN _ 'left arrow ZFunctionKey = 16 IF ZKeyPressed = 77 THEN _ 'Right arrow ZFunctionKey = 17 IF ZKeyPressed = 141 THEN _ 'CTRL-up arrow ZFunctionKey = 18 IF ZKeyPressed = 132 THEN _ 'CTRL-PgUp (same as CTRL-UP) ZFunctionKey = 18 IF ZKeyPressed = 145 THEN _ 'CTRL-down arrow ZFunctionKey = 19 IF ZKeyPressed = 118 THEN _ 'CTRL-PgDn (same as CTRL-DOWN) ZFunctionKey = 19 IF ZKeyPressed = 115 THEN _ 'CTRL-left arrow ZFunctionKey = 20 IF ZKeyPressed = 116 THEN _ 'CTRL-right arrow ZFunctionKey = 21 IF ZKeyPressed = 79 THEN _ 'End (a nice way to kick user off) ZFunctionKey = 22 30610 ZKeyPressed$ = "" IF ZFunctionKey < 1 OR ZFunctionKey > 22 THEN _ GOTO 33970 IF ZFunctionKey < 10 AND (ZFunctionKey <> 8) THEN _ GOTO 30620 IF ZToggleOnly THEN _ ZSubParm = 1 : _ GOTO 33970 30620 ON ZFunctionKey GOTO 31000, _ ' 1 = F1 32000, _ ' 2 = F2 33000, _ ' 3 = F3 33040, _ ' 4 = F4 33060, _ ' 5 = F5 33070, _ ' 6 = F6 33090, _ ' 7 = F7 33110, _ ' 8 = F8 33130, _ ' 9 = F9 33150, _ ' 10 = F10 31398, _ ' 11 = CTRL END 33200, _ ' 12 = PGUP 33170, _ ' 13 = UP ARROW 33180, _ ' 14 = DOWN ARROW 33220, _ ' 15 = PGDN 33240, _ ' 16 = LEFT ARROW 33250, _ ' 17 = RIGHT ARROW 33170, _ ' 18 = CTRL-UP ARROW 33180, _ ' 19 = CTRL-DOWN 33245, _ ' 20 = CTRL-LEFT 33255, _ ' 21 = CTRL-RIGHT 31398 ' 22 = END ' ' ' * F1 - COMMAND FROM LOCAL KEYBOARD (IMMEDIATE EXIT TO DOS) ' ' 31000 ZSubParm = -10 CALL Carrier IF ZSubParm = 0 THEN _ GOTO 33970 ZFileName$ = ZNodeWorkDrvPath$ + "RBBS" + ZNodeFileID$ + "F1.DEF" CLOSE 2 CALL OpenOutW (ZFileName$) PRINT #2,MID$(ZFileName$,3,7) IF ZExitToDoors THEN _ ZSubParm = -4 : _ GOTO 33970 CALL OpenCom(ZModemInitBaud$,",N,8,1") CALL TakeOffHook ZSubParm = -5 GOTO 33970 ' ' ' * END KEY - FORCE CURRENT USER OFF AND LOCK THEM OUT ' ' 31398 IF NOT ZLocalUser THEN _ CALL Carrier : _ IF ZSubParm = -1 THEN _ GOTO 33970 IF INSTR("MUF",ZActiveMenu$) > 0 THEN _ GOTO 31399 ZCursorLine = CSRLIN ZCursorRow = POS(0) LOCATE 25,1 WasD$ = SPACE$(79) GOSUB 33210 LOCATE 25,1 WasD$ ="Cannot FORCE OFF until user reaches MAIN menu" GOSUB 33210 CALL DelayTime (1) LOCATE ZCursorLine,ZCursorRow ZSubParm = 1 CALL Line25 GOTO 33970 31399 IF ZFunctionKey = 22 THEN _ CALL SkipLine (2) : _ CALL QuickTPut1 ("Sorry, " + ZFirstName$ + ", SYSOP needs the system.") : _ CALL DelayTime (8 + ZBPS) : _ ZSubParm = -6 : _ GOTO 33970 CALL QuickTPut1 (ZFirstName$ + ", goodbye and don't call back") CALL DelayTime (8 + ZBPS) : _ IF ZUserFileIndex < 1 THEN _ ZSubParm = -6 : _ GOTO 33970 ZUserSecLevel = ZMinLogonSec - 1 CALL DenyAccess ZSubParm = -7 GOTO 33970 ' ' ' * F2 - COMMAND FROM LOCAL KEYBOARD (SYSOP EXIT TO DOS AND RETURN) ' ' 32000 IF NOT ZLocalUser THEN _ CALL SkipLine (1) : _ CALL QuickTPut1 ("Sysop exiting to DOS. Please wait...") : _ ZFunctionKey = 0 : _ CALL DelayTime (3) CALL ShellExit (ZDiskForDos$ + "COMMAND") 'SHELL ZDiskForDos$ + _ ' "COMMAND" CLS IF NOT ZLocalUser THEN _ CALL Carrier : _ IF ZSubParm = -1 THEN _ GOTO 33970 ZSubParm = 2 CALL Line25 CALL QuickTPut1 ("Sysop back from DOS. Returning control to you.") ZCommPortStack$ = ZCarriageReturn$ GOTO 33970 ' ' ' * F3 - COMMAND FROM LOCAL KEYBOARD (Printer Toggle) ' ' 33000 ZPrinter = NOT ZPrinter ChangeValue = ZPrinter FieldPosition = 38 GOTO 33950 ' ' ' * F4 - COMMAND FROM LOCAL KEYBOARD (Sysop ANNOY) ' ' 33040 ZSysopAnnoy = NOT ZSysopAnnoy ChangeValue = ZSysopAnnoy FieldPosition = 34 GOTO 33950 ' ' ' * F5 - COMMAND FROM LOCAL KEYBOARD (FORCE CALLER ONLINE) ' ' 33060 ZFunctionKey = 0 ZSubParm = -3 GOTO 33970 ' ' ' * F6 - COMMAND FROM LOCAL KEYBOARD (Sysop AVAILABLE Toggle) ' * 6 - COMMAND FROM Sysop MENU (Sysop AVAILABLE Toggle) ' ' 33070 ZSysopAvail = NOT ZSysopAvail ChangeValue = ZSysopAvail FieldPosition = 32 GOTO 33950 ' ' ' * F7 - COMMAND FROM LOCAL KEYBOARD (Sysop GETS SYSTEM NEXT) ' ' 33090 IF ERR=61 AND NOT ZDiskFullGoOffline THEN _ GOTO 33970 ZSysopNext = NOT ZSysopNext ChangeValue = ZSysopNext FieldPosition = 36 GOTO 33950 ' ' ' * F8 - COMMAND FROM LOCAL KEYBOARD (ASSIGN USER TEMPORARY Sysop SECURITY) ' ' 33110 ZSysop = NOT ZSysop ZCursorLine = CSRLIN ZCursorRow = POS(0) LOCATE 25,1 WasD$ = SPACE$(79) NumReturns = 0 CALL LPrnt (WasD$,NumReturns) LOCATE 25,1 ZUserSecLevel = (1 + ZSysop) * _ ZUserSecSave - _ ZSysop * _ ZSysopSecLevel WasD$ = "Sysop Privileges " + FNOffOn$(ZSysop) CALL LPrnt (WasD$,NumReturns) CALL DelayTime (3) LOCATE ZCursorLine,ZCursorRow ZSubParm = 1 CALL Line25 CALL SetPrompt GOTO 33970 ' ' ' * F9 - COMMAND FROM LOCAL KEYBOARD (Snoop Toggle) ' ' 33130 IF NOT ZSnoop THEN _ ZSnoop = ZTrue : _ LOCATE 24,1,0 : _ WasD$ = "SNOOP ON" : _ NumReturns = 0 : _ CALL LPrnt (WasD$,NumReturns) : _ ZSubParm = 2 : _ CALL Line25 _ ELSE LOCATE ,,0 : _ ZSnoop = ZFalse : _ CLS 33140 ChangeValue = ZSnoop FieldPosition = 58 GOTO 33950 ' ' ' * F10 - COMMAND FROM LOCAL KEYBOARD (FORCE CHAT WITH USER) ' ' 33150 GOTO 33160 33155 ZSubParm = 1 CALL Line25 GOTO 33970 33160 CALL UpdtCalr ("Sysop began chat",1) ZPageStatus$ = "" CALL SkipLine (1) CALL QuickTPut1 ("Hi " + _ ZFirstName$ + _ ", this is " + _ ZSysopFirstName$ + _ " " + _ ZSysopLastName$ + _ " Sorry to break in to CHAT but..") CALL TimeBack (1) CALL SysopChat CALL TimeBack (2) ZCommPortStack$ = CHR$(13) GOTO 33155 ' ' ' * UP / CTRL-UP: INCREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE ' ' 33170 ZUserSecLevel = ZUserSecLevel + _ 1 - 4 * (ZFunctionKey = 18) GOTO 33190 ' ' ' * DOWN / CTRL-DOWN: DECREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE ' ' 33180 ZUserSecLevel = ZUserSecLevel - _ 1 + 4 * (ZFunctionKey = 19) 33190 ZAdjustedSecurity = ZTrue ZUserSecSave = ZUserSecLevel IF (NOT ZConfMode) AND (NOT SubBoard) THEN _ ZOrigSec = ZUserSecLevel : _ ZSubParm = 2 CALL Line25 CALL SetPrompt GOTO 33970 ' ' ' * PGUP DISPLAY USER PROFILE ' ' 33200 IF NOT ZLocalUser THEN _ CALL Carrier : _ IF ZSubParm = -1 THEN _ GOTO 33970 IF ZVoiceType <> 0 THEN _ ZTalkAll = ZTrue CALL PageUp WasD$ = MID$("NoviceExPERT",1 -6 * ZExpertUser,6) GOSUB 33210 WasD$ = "GRAPHICS: " + _ MID$("None AsciiColor",ZWasGR * 5 + 1,5) GOSUB 33210 WasD$ = "Protocol : " + _ ZUserXferDefault$ GOSUB 33210 WasD$ = "UPPER CASE " + _ MID$("and lowerONLY", 1 - 9 * ZUpperCase,9) GOSUB 33210 WasD$ = "Line Feeds " + FNOffOn$(ZLineFeeds) GOSUB 33210 WasD$ = "Nulls " + FNOffOn$(ZNulls) GOSUB 33210 WasD$ = "Prompt Bell " + FNOffOn$(ZPromptBell) GOSUB 33210 WasD$ = MID$("SKIP CHECK",1 -5 * ZCheckBulletLogon,5) + _ " old BULLETINS on logon." GOSUB 33210 WasD$ = MID$("CHECKSKIP ",1 -5 * ZSkipFilesLogon,5) + _ " new files on logon." GOSUB 33210 WasD$ = "Autodownload " + FNOffOn$(ZAutoDownDesired) GOSUB 33210 ZTalkAll = ZFalse GOTO 33970 33210 NumReturns = 1 CALL LPrnt(WasD$,NumReturns) RETURN ' ' ' * PGDN CLEAR DISPLAY OF USER'S PROFILE ' ' 33220 IF NOT ZLocalUser THEN _ CALL Carrier : _ IF ZSubParm = -1 THEN _ GOTO 33970 CLS GOTO 33155 ' ' ' * LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY ONE MINUTE ' ' 33240 IF ZSecsPerSession! > 120 THEN _ ZSecsPerSession! = ZSecsPerSession! - 60 GOTO 33970 ' ' ' * CTRL-LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY FIVE MINUTES ' ' 33245 IF ZSecsPerSession! > 360 THEN _ ZSecsPerSession! = ZSecsPerSession! - 300 GOTO 33970 ' ' ' * RIGHT ARROW - INCREASE THE ON-LINE USER'S TIME BY ONE MINUTE ' ' 33250 IF ZSecsPerSession! < 86280 THEN _ ZSecsPerSession! = ZSecsPerSession! + 60 ZTimeLockSet = 0 GOTO 33970 ' ' ' * CTRL-RIGHT ARROW - INCREASE THE ON-LINE USER'S TIME BY FIVE MINUTES ' ' 33255 IF ZSecsPerSession! < 86040 THEN _ ZSecsPerSession! = ZSecsPerSession! + 300 ZTimeLockSet = 0 GOTO 33970 ' ' ' * UPDATE NODE RECORD WITH LOCAL FUNCTION KEY ACTIVITY ' ' 33950 IF ZSnoop THEN _ ZSubParm = 1 : _ CALL Line25 33960 IF ZConfMode = ZTrue THEN _ IF ZLocalUser THEN _ GOTO 33970 _ ELSE WasD$ = "Cannot change status during Conference!" : _ GOSUB 33210 : _ GOTO 33970 ZSubParm = 3 CALL FileLock IF ZSubParm = -1 THEN _ GOTO 33970 CALL OpenMsg FIELD 1,128 AS ZMsgRec$ GET 1,ZNodeRecIndex MID$(ZMsgRec$,FieldPosition,2) = STR$(ChangeValue) CALL SaveProf (2) FIELD 1, 128 AS ZMsgRec$ 33970 END SUB 33990 ' $SUBTITLE: 'PageUp - Display user profile to Sysop' ' $PAGE ' ' NAME -- PageUp ' ' INPUTS -- PARAMETER MEANING ' ZActiveUserName$ CURRENT USER NAME ' ZDnlds # OF FILES DOWNLOADED ' ZExpirationDate$ REGISTRATION EXPIRATION ' ZLastDateTimeOnSave$ Last DATE & TIME ON SYSTEM ' ZLastMsgRead Last MESSAGE READ BY USER ' ZPswdSave$ USERS PASSWORD ' ZTimesLoggedOn TIMES USER HAS LOGGED ON ' ZUplds # OF FILES UPLOADED ' ZUserSecSave USERS SECURITY LEVEL ' ' OUTPUTS -- ZMsgRec$ ' SUB PageUp STATIC CALL LPrnt (" ",1) CALL LPrnt ("USER NAME : " + ZActiveUserName$,1) CALL LPrnt ("SECURITY :" + STR$(ZUserSecSave),1) CALL LPrnt ("PASSWORD :" + ZPswdSave$,1) CALL LPrnt ("READ MSG. :" + STR$(ZLastMsgRead),1) CALL LPrnt ("TIMES ON :" + STR$(ZTimesLoggedOn),1) CALL LPrnt ("LAST ON :" + ZLastDateTimeOnSave$,1) CALL LPrnt ("DOWNLOADS :" + STR$(ZDnlds),1) CALL LPrnt ("UPLOADS :" + STR$(ZUplds),1) IF ZEnforceRatios THEN _ CALL LPrnt ("DL-BYTES :" + STR$(ZDLBytes!),1) : _ CALL LPrnt ("UL-BYTES :" + STR$(ZULBytes!),1) IF ZRestrictByDate THEN _ CALL LPrnt ("EXPIRATION: " + ZExpirationDate$,1) CALL LPrnt ("User's Profile",1) END SUB 35000 ' $SUBTITLE: 'FlushKeys - Completely flush all user input' ' $PAGE ' ' NAME -- FlushKeys ' SUB FlushKeys STATIC CALL FlushCom (ZWasY$) ' KG071901 ZLastIndex = 0 REDIM ZUserIn$(ZMsgDim) END SUB 41008 ' $SUBTITLE: 'CheckTimeRemain - Kicks off if no time remaining' ' $PAGE ' ' NAME -- CheckTimeRemain ' ' INPUTS -- PARAMETER MEANING ' ' OUTPUTS -- PARAMETER MEANING ' MinsRemaining TIME IN MINUTES LEFT IN SESSION ' ZSecsUsedSession! TIME USED IN SECONDS ' ZSubParm -1 IF No TIME LEFT ' SUB CheckTimeRemain (MinsRemaining) STATIC CALL TimeRemain (MinsRemaining) IF ZBypassTimeCheck THEN _ EXIT SUB IF MinsRemaining <= 0 THEN _ ZSubParm = -1 END SUB 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) 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 41020 MinsRemaining = INT((ZSecsPerSession! - ZSecsUsedSession!) / 60) ' ML080802 END SUB 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) CALL QuickTPut1 (ZEmphasizeOff$ + STR$(MinsRemaining) + " min left") ' MB052101 END SUB 41498 ' $SUBTITLE: 'AMorPM - give time of day in AM/PM format' ' $PAGE ' ' NAME -- AMorPM ' ' INPUTS -- PARAMETER MEANING ' ' OUTPUTS -- ZCurDate$ CURRENT DATE (MM-DD-YY) ' ZTime$ CURRENT TIME (I.E. 1:13 PM) ' ' PURPOSE -- To set the time and date and ' describe the time as "AM" or "PM." ' SUB AMorPM STATIC ' ' ' * CALCULATE CURRENT TIME FOR AM OR PM ' ' 41500 ZCurDate$ = DATE$ ZCurDate$ = LEFT$(ZCurDate$ ,6) + _ RIGHT$(ZCurDate$ ,2) 41510 ZTime$ = TIME$ IF VAL(MID$(ZTime$,1,2)) = 12 THEN _ MID$(ZTime$,1,2) = RIGHT$(STR$(VAL(MID$(ZTime$,1,2))),2) : _ ZTime$ = LEFT$(ZTime$,5) + _ " PM" : _ EXIT SUB IF VAL(MID$(ZTime$,1,2)) > 11 THEN _ MID$(ZTime$,1,2) = RIGHT$(STR$(VAL(MID$(ZTime$,1,2))-12),2) : _ ZTime$ = LEFT$(ZTime$,5) + _ " PM" : _ EXIT SUB ZTime$ = LEFT$(ZTime$,5) + _ " AM" END SUB 42000 ' $SUBTITLE: 'Carrier - sub to monitor carrier on comm. port' ' $PAGE ' ' NAME -- Carrier ' ' INPUTS -- PARAMETER MEANING ' ZAutoLogoffReq -1 if in autologoff request ' ' OUTPUTS -- ZSubParm = 0 CONTINUE ' ZSubParm = -1 TERMINATE (No Carrier) ' ' PURPOSE -- To test whether should continue in RBBS. Reasons ' NOT to continue are: autologoff, out of time, or ' carrier dropped. ' SUB Carrier STATIC IF ZAutoLogoffReq THEN _ IF NOT ZSuspendAutologoff THEN _ ZSubParm = -1 : _ EXIT SUB CALL CheckCarrier END SUB 42005 ' $SUBTITLE: 'CheckCarrier - monitors carrier on comm. port' ' $PAGE ' ' NAME -- CheckCarrier ' ' INPUTS -- PARAMETER MEANING ' ZLocalUser = 0 REMOTE USER ' ZLocalUser = -1 LOCAL KEYBOARD USER ' ZModemStatusReg ADDRESS OF THE COMMUNI- ' CATIONS PORT'S REGISTER ' ZSubParm = -9 DON'T WRITE TO CALLERS ' ZSubParm = -10 SAME AS -9, BUT DON'T ' DELAY ' ' OUTPUTS -- ZSubParm = 0 Carrier STILL PRESENT ' ZSubParm = -1 Carrier NOT PRESENT ' ' PURPOSE -- To test if carrier is present (i.e. the user ' is still on line). Ignores whether in autologoff. ' SUB CheckCarrier STATIC IF ZSubParm = -1 THEN _ EXIT SUB Speedy = ZSubParm ZSubParm = 0 ' ' ' * TEST FOR Carrier PRESENT (DROP CALLER IF Carrier NOT PRESENT) ' ' IF ZLocalUser THEN _ EXIT SUB IF ZFossil THEN _ CALL FosStatus(ZComPort,Status) : _ Status = Status AND &H0080 : _ IF Status = &H0080 THEN _ EXIT SUB _ ELSE GOTO 42015 42010 IF INP(ZModemStatusReg) > 127 THEN _ EXIT SUB ' ' ' * IN CASE USER IS 2400 BAUD, PAUSE A SECOND AND CHECK AGAIN FOR Carrier ' * DETECT. SOME 2400 BAUD MODEMS TAKE A WHILE TO SYNCHRONIZE THE Carrier, ' * HENCE A THREE-SECOND PAUSE BEFORE CHECKING AGAIN. ' ' 42015 IF Speedy = -10 THEN _ GOTO 42020 CALL DelayTime (ZModemInitWaitTime) IF ZFossil THEN _ CALL FosStatus(ZComPort,Status) : _ Status = Status AND &H0080 : _ IF Status = &H0080 THEN _ EXIT SUB _ ELSE GOTO 42020 IF INP(ZModemStatusReg) > 127 THEN _ EXIT SUB 42020 ZSubParm = -1 IF Speedy < -8 THEN _ EXIT SUB IF AlreadyWritten = -9 THEN _ EXIT SUB CALL TakeOffHook ZModemOffHook = -1 AlreadyWritten = -9 CALL UpdtCalr ("Carrier dropped",1) END SUB 43004 ' $SUBTITLE: 'AskGraphics -- sub to ask users graphic preference' ' $PAGE ' ' NAME -- AskGraphics ' ' INPUTS -- PARAMETER MEANING ' ZUserGraphicDefault$ USER Graphic DEFAULT ' ' OUTPUTS -- ' ' PURPOSE -- To determine users graphics default ' SUB AskGraphics STATIC IF ZExpertUser THEN _ GOTO 43007 43006 ZFileName$ = ZHelp$(9) CALL BufFile (ZFileName$,WasX) IF ZSubParm = -1 THEN _ EXIT SUB 43007 CALL QuickTPut1 ("GRAPHICS for text files and menus") ZOutTxt$ = "Change from " + MID$("NAC",ZWasGR+1,1) + " to N)one, A)scii-IBM, C)olor-IBM, H)elp" + ZPressEnterExpert$ ZSubParm = 1 ZTurboKey = -ZTurboKeyUser CALL TGet IF ZSubParm = -1 THEN _ EXIT SUB IF ZWasQ = 0 THEN _ CALL QuickTPut1 ("Unchanged") : _ EXIT SUB CALL AllCaps (ZUserIn$(1)) ZWasGR = INSTR("NAC",ZUserIn$(1)) IF ZWasGR = 2 AND NOT ZEightBit THEN _ CALL QuickTPut1 ("Ascii unavailable. Requires 8 bit") : _ GOTO 43007 IF ZWasGR = 0 THEN _ GOTO 43006 ZWasGR = ZWasGR - 1 CALL SetGraphic (ZWasGR,ZUserGraphicDefault$) END SUB ' 43031 ' $SUBTITLE: 'GraphicX - sub to find graphic version of a file' ' $PAGE ' ' NAME -- GraphicX ' ' INPUTS -- PARAMETER MEANING ' Default$ USERS Graphic DEFAULT ' ZWasGR WHETHER GRAPHICS ARE AVAILABLE ' FilName$ FILE TO CHECK ' FileNum # of file to use ' ' OUTPUTS -- FilName$ SUBSTITUTES NAME OF GRAPHICS ' FILE (IF IT EXISTS). ' ' PURPOSE -- Checks whether there is a graphics version of ' a file, based on users graphics perference. ' Sets file name to graphics file if it exists, ' Otherwise leaves file name intact. Returns file ' name to use. ' SUB GraphicX (Default$,FilName$,FileNum) STATIC ZOK = ZFalse IF ZWasGR THEN _ CALL BreakFileName (FilName$,DR$,WasX$,Extension$,ZTrue) : _ IF LEN(WasX$) < 8 THEN _ ZWasDF$ = DR$ + _ WasX$ + _ Default$ + _ Extension$ : _ CALL FINDITX (ZWasDF$,FileNum) : _ IF ZOK THEN _ FilName$ = ZWasDF$ : _ IF Default$ = "C" THEN _ ZLinesPrinted = 0 IF NOT ZOK THEN _ CALL FINDITX (FilName$,FileNum) END SUB ' Sets Graphic version but uses file # 2 always SUB Graphic (Default$,FilName$) STATIC CALL GraphicX (Default$,FilName$,2) END SUB 43068 ' $SUBTITLE: 'SaveProf - subroutine to read a user profile' ' $PAGE ' ' NAME -- SaveProf ' ' INPUTS -- PARAMETER MEANING ' ZBPS ' ZEightBit ' ZExitToDoors ' ZWasGR ' ZMsgRec$ ' ZNodeRecIndex ' ZSysop ' ZUpperCase ' ZTimeLoggedOn$ ' ZPrivateDoor ' ZReliableMode ' ' OUTPUTS -- NONE ' ' PURPOSE -- Saves a user's options and communications parameters ' in the node record when a user exits to a "door" so ' that he is in the same status as when he exited. ' SUB SaveProf (IParm) STATIC ON IParm GOTO 43070,43080 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) 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 43080 PUT 1,ZNodeRecIndex ZSubParm = 2 CALL FileLock CALL OpenMsg END SUB 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)) 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 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 44020 ' $SUBTITLE: 'CommInfo - sub for variable of users baud/parity' ' $PAGE ' ' NAME -- CommInfo ' ' INPUTS -- PARAMETER MEANING ' ZBPS BAUD RATE INDICATOR ' ZEightBit INDICATE FOR N/8/1 ' ' OUTPUTS -- ZBaudParity$ ' ' PURPOSE -- Create a string that shows a users baud rate and parity ' SUB CommInfo STATIC ' ' ' * DETERMINE BAUD AND PARITY ' ' IF ZReliableMode THEN _ ReliableMode$ = "-R," _ ELSE ReliableMode$ = "," ZBaudParity$ = MID$(ZBaudRates$,(-5 * ZBPS),5) + _ " BAUD" + _ ReliableMode$ + _ MID$("N,8,1E,7,1",6 + 5 * ZEightBit,5) ZBaudTest! = VAL(ZBaudParity$) END SUB 50495 ' $SUBTITLE: 'DelayTime - sub to wait number of seconds specified' ' $PAGE ' ' NAME -- DelayTime ' ' INPUTS -- PARAMETER MEANING ' DelaySecs NUMBER OF SECONDS TO DELAY ' (0 TO 3,600) ' ' OUTPUTS -- NONE ' ' PURPOSE -- To wait the number of seconds indicated before ' returning control to the calling routine. ' SUB DelayTime (DelaySecs) STATIC IF DelaySecs < 1 THEN _ EXIT SUB ZDelay! = TIMER + DelaySecs 50500 CALL CheckTime(ZDelay!, TempElapsed!, 1) IF TempElapsed! > 0 THEN _ GOTO 50500 END SUB 52070 ' $SUBTITLE: 'ModemPut - sub to write modem commands to modem' ' $PAGE ' ' SUBROUTINE NAME -- ModemPut ' ' INPUT PARAMETERS -- PARAMETER MEANING ' Strng$ MODEM COMMAND ' ZCmdsBetweenRings INDICATOR TO WAIT FOR ' MODEM TO STOP RINGING ' BEFORE ISSUING COMMANDS ' ZDumbModem INDICATOR THAT MODEM WOULD ' NOT UNDERSTAND COMMANDS ' ' OUTPUT PARAMETERS -- NONE ' ' SUBROUTINE PURPOSE -- TO ISSUE MODEM COMMANDS TO THE MODEM ' SUB ModemPut (Strng$) STATIC ' ' ' * SEND MODEM COMMAND ' ' IF ZDumbModem THEN _ EXIT SUB IF NOT ZCmdsBetweenRings OR _ NOT (INP(ZModemStatusReg) AND &H40) THEN _ GOTO 52080 ConnectDelay! = TIMER + 7 52072 IF (INP(ZModemStatusReg) AND &H40) > 0 THEN _ CALL CheckTime(ConnectDelay!, TempElapsed!, 1) : _ IF ZSubParm = 2 THEN _ GOTO 52080 GOTO 52072 52080 CALL DelayTime (ZModemCmdDelayTime) WasX$ = " " FOR WasI = 1 TO LEN(Strng$) LSET WasX$ = MID$(Strng$,WasI,1) ON INSTR("{~",WasX$) GOTO 52082,52084 GOTO 52085 52082 LSET WasX$ = ZCarriageReturn$ GOTO 52085 52084 CALL DelayTime (1) GOTO 52086 52085 CALL CommPut (WasX$) 52086 NEXT CALL CommPut (ZCarriageReturn$) END SUB 57001 ' $SUBTITLE: 'DispCall - subroutine to display callers file' ' $PAGE ' ' NAME -- DispCall ' ' INPUTS -- PARAMETER MEANING ' ' OUTPUTS -- (NONE) ' ' PURPOSE -- Displays callers file to sysops and callers ' SUB DispCall STATIC IF ZCallersFilePrefix$ = "" THEN _ EXIT SUB CALL SkipLine (1) CallersFileIndexTemp! = ZCallersFileIndex! CLOSE 4 IF ZShareIt THEN _ OPEN ZCallersFile$ FOR RANDOM SHARED AS #4 LEN=64 _ ELSE OPEN "R",4,ZCallersFile$,64 FIELD 4,64 AS ZCallersRecord$ 57005 IF CallersFileIndexTemp! < 1 OR ZRet THEN _ EXIT SUB 57010 GET 4,CallersFileIndexTemp! ZOutTxt$ = ZCallersRecord$ IF LEFT$(ZOutTxt$,3) = " " OR _ INSTR(ZOutTxt$,"on at") = 0 THEN _ GOTO 57030 57025 CallersFileIndexTemp! = CallersFileIndexTemp! - 1 GET 4,CallersFileIndexTemp! WasZ = INSTR(ZCallersRecord$,"{") IF WasZ < 1 OR WasZ > 15 THEN _ WasZ = 15 IF ZSysop OR _ LEFT$(ZOutTxt$,3) <> " " THEN _ ZOutTxt$ = ZOutTxt$ + LEFT$(ZCallersRecord$,WasZ - 1) GOSUB 57100 IF ZSysop THEN _ ZOutTxt$ = MID$(ZCallersRecord$,WasZ) : _ GOSUB 57100 GOTO 57045 57030 IF ZSysop THEN _ GOSUB 57100 57045 CallersFileIndexTemp! = CallersFileIndexTemp! -1 GOTO 57005 57100 IF INSTR(ZOutTxt$,"LOGON DENIED") THEN _ IF NOT ZSysop THEN _ RETURN CALL QuickTPut1 (ZOutTxt$) CALL AskMore ("",ZTrue,ZTrue,WasX,ZFalse) IF ZNo OR ZSubParm = -1 THEN _ EXIT SUB RETURN END SUB 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$) 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 58060 ' $SUBTITLE: 'NameCaps - sub to convert name string to Proper Case' ' $PAGE ' ' NAME -- NameCaps ' ' INPUTS -- PARAMETER MEANING ' ConvertField$ STRING TO CONVERT ' ' OUTPUTS -- ConvertField$ CONVERTED STRINGS ' ' PURPOSE -- Subroutine to convert a string to Proper Case (1st char upper) ' SUB NameCaps (ConvertField$) STATIC CALL AllCaps(ConvertField$) FOR WasZ = 2 TO LEN(ConvertField$) IF MID$(ConvertField$,WasZ,1) > "@" AND _ MID$(ConvertField$,WasZ,1) < "[" AND _ MID$(ConvertField$,WasZ-1,1) <> " " THEN _ MID$(ConvertField$,WasZ,1) = CHR$(ASC(MID$(ConvertField$,WasZ,1)) OR 32) NEXT END SUB 58070 ' $SUBTITLE: 'CheckTime - sub to see how much time is remaining' ' $PAGE ' ' NAME -- CheckTime ' ' INPUTS -- PARAMETER MEANING ' TargetTime TARGET TIME ' ChectimeOption 1 = TELL US TIME REMAINING BETWEEN CURRENT ' TIME AND TargetTime ' 2 = TELL US TIME ELAPSED BETWEEN TargetTime ' AND CURRENT TIME ' ' OUTPUTS -- PARAMETER MEANING ' TimeRemaining! POSITIVE OR NEGATIVE NUMBER INDICATING ' TIME REMAINING OR ELAPSED. VALUE MAY BE ' TESTED FOR "TIME EXPIRED". NEGATIVE ' OR ZERO, AND THE TIME HAS BEEN REACHED. ' ELAPSED TIME CAN BE 0 TO 86400 (24 HRS) ' TIME REMAINING CAN BE 0 TO 43200 OR ' -43200 TO 0 (+ OR - 12 HRS) ' ZSubParm (Option 1 ONLY!) ' 1 = Time REMAINING is > 0 ' 2 = Time REMAINING is <= 0 ' ' ' PURPOSE -- Subroutine to provide time measurement functions. Will ' determine whether a target time has been reached, how much ' time is remaining, or how much time has elapsed. ' SUB CheckTime (TargetTime!, TimeRemaining!, CkOption) STATIC IF TargetTime! > 86400 THEN _ TestTime! = 86400 : _ OverTime! = TargetTime! - 86400 _ ELSE _ TestTime! = TargetTime! : _ OverTime! = 0 TimeRemaining! = (TestTime! - TIMER) + OverTime! IF CkOption = 2 THEN GOTO 58072 IF TimeRemaining! < -43200 THEN _ TimeRemaining! = TimeRemaining! + 86400 IF TimeRemaining! > 43200 THEN _ TimeRemaining! = TimeRemaining! - 86400 IF TimeRemaining! >= 0 THEN _ ZSubParm = 1 _ ELSE _ ZSubParm = 2 EXIT SUB 58072 IF TimeRemaining! > 0 THEN _ TimeRemaining! = 86400 - TimeRemaining! _ ELSE _ TimeRemaining! = -(TimeRemaining!) END SUB 58080 ' $SUBTITLE: 'HashRBBS - sub to determine where to look for user' ' $PAGE ' ' NAME -- HashRBBS ' ' INPUTS -- PARAMETER MEANING ' StringToHash$ USER NAME TO LOCATE ' MaxPosition MAXIMUM # USERS ' ' OUTPUTS -- PrimeHash WHERE TO LOOK First ' SecondHash LOOK THIS FAR AHEAD ' ' PURPOSE -- Where to look for a user in users file ' Look first at prime position, then add ' SecondHash until find or find unused record ' SUB HashRBBS (StringToHash$,MaxPosition,PrimeHash,SecondHash) STATIC SecondHash = (ASC(MID$(StringToHash$,2,1)) * 10 + 7) MOD _ MaxPosition PrimeHash = _ ((ASC(StringToHash$) * 100 + _ ASC(MID$(StringToHash$,(LEN(StringToHash$) / 2) + .1,1)) * _ 10 + _ ASC(RIGHT$(StringToHash$,1))) _ MOD MaxPosition) + 1 END SUB 58100 ' $SUBTITLE: 'SetOpts - sub to set prompts based on user security' ' $PAGE ' ' NAME -- SetOpts ' ' INPUTS -- PARAMETER MEANING ' First POSITION WHERE START LOOKING ' Last POSITION WHERE QUIT LOOKING ' ZUserSecLevel SECURITY OF USER ' ' OUTPUTS -- Options$ LIST OF COMMANDS USER CAN DO ' ' PURPOSE -- String together what commands user can do in a section ' SUB SetOpts (Options$,InvalidOptions$,First,Last) STATIC Options$ = "" InvalidOptions$ = "" FOR WasI = First TO Last IF ZUserSecLevel < ZOptSec(WasI) THEN _ InvalidOptions$ = InvalidOptions$ + _ MID$(ZAllOpts$,WasI,1) _ ELSE IF MID$(ZAllOpts$,WasI,1) <> " " THEN _ Options$ = Options$ + _ MID$(ZAllOpts$,WasI,1) NEXT CALL SortString (Options$) CALL SortString (InvalidOptions$) END SUB 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) + _ " New bulletin(s) since last call" + _ ' DA071701 NewBullets$ CALL QuickTPut1 (ZOutTxt$) EXIT SUB 58112 IF WasBN$ = "N" THEN _ WasX$ = ZNewsFileName$ + CHR$(0) _ ELSE WasX$ = ZBulletinPrefix$ + WasBN$ + CHR$(0) CALL MarkTime (WasX) CALL RBBSFind (WasX$,WasIX,Year,WasMM,WasDD) IF WasIX = 0 THEN _ FDate# = WasDD + (100 * WasMM) + (10000# * (Year + 1980)) : _ IF BaseDate# <= FDate# THEN _ NumNewBullets = NumNewBullets + 1 : _ ZUserIn$(NumNewBullets + 1) = WasBN$ : _ NewBullets$ = NewBullets$ + _ " " + _ WasBN$ RETURN END SUB 58120 ' $SUBTITLE: 'SortString - sub to sort characters in a string' ' $PAGE ' ' NAME -- SortString ' ' INPUTS -- PARAMETER MEANING ' Strng$ STRING TO SORT ' ' OUTPUTS -- Strng$ SORTED STRING ' ' PURPOSE -- Sorts characters in passed string. ' SUB SortString (Strng$) STATIC Sort0 = LEN(Strng$) Sort1 = Sort0 WasX$ = "!" 58122 Sort1 = Sort1\2 IF Sort1 = 0 THEN _ EXIT SUB Sort2 = Sort0 - Sort1 FOR Sort3 = 1 TO Sort2 Sort4 = Sort3 58124 Sort5 = Sort4 + Sort1 IF MID$(Strng$,Sort4,1) > MID$(Strng$,Sort5,1) THEN _ LSET WasX$ = MID$(Strng$,Sort4,1) : _ MID$(Strng$,Sort4,1) = MID$(Strng$,Sort5,1) : _ MID$(Strng$,Sort5,1) = WasX$ : _ Sort4 = Sort4 - Sort1 : _ IF Sort4 > 0 THEN _ GOTO 58124 NEXT GOTO 58122 END SUB 58130 ' $SUBTITLE: 'AddCommas - sub to format commands in command prompt' ' $PAGE ' ' NAME -- AddCommas ' ' INPUTS -- PARAMETER MEANING ' Strng$ STRING TO REPLACE ' ' OUTPUTS -- Strng$ REPLACED STRING ' ' PURPOSE -- Inserts commands between each letter in Strng$ ' and encloses in pointed brackets ' SUB AddCommas (Strng$) STATIC WasL = LEN(Strng$) IF WasL < 1 THEN _ EXIT SUB LSET ZLineMes$ = " <" + _ LEFT$(Strng$,1) FOR WasK = 2 TO WasL MID$(ZLineMes$,2 * WasK,2) = "," + _ MID$(Strng$,WasK,1) NEXT Strng$ = LEFT$(ZLineMes$,2 * WasL + 1) + _ ">" END SUB 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$ = "" 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 58142 WasK = WasK - 1 WEND CLOSE 2 END SUB 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 _ RptPrefix$ = "At least" _ ' KG072701 ELSE RptPrefix$ = "" END SUB 58160 ' $SUBTITLE: 'CountLines - sub to determine file categories ' ' $PAGE ' ' NAME -- CountLines ' ' INPUTS -- PARAMETER MEANING ' ZDirCatFile$ NAME OF THE FILE THAT HAS THE ' NUMBER OF CATEGORIES IN IT. ' ' OUTPUTS -- MaxEntries NUMBER OF FILE CATEGORIES ' ' PURPOSE -- Subroutine to count the number of categories that a ' file can be classified into. ' SUB CountLines (MaxEntries) STATIC CALL LinesInFile (ZDirCatFile$,MaxEntries) MaxEntries = MaxEntries + 3 IF MaxEntries < 10 THEN _ MaxEntries = 10 END SUB 58161 ' $SUBTITLE: 'CountLines - sub to determine file categories ' ' $PAGE ' ' NAME -- LinesInFile ' ' INPUTS -- PARAMETER MEANING ' FilName$ Name of file to use ' ' OUTPUTS -- LineCount Count of # of lines in file ' ' PURPOSE -- Subroutine to count the number of categories that a ' file can be classified into. ' SUB LinesInFile (FilName$,LineCount) STATIC CALL FindIt (FilName$) LineCount = 0 IF ZOK THEN _ WHILE NOT EOF(2) : _ LineCount = LineCount + 1 : _ LINE INPUT #2,ZOutTxt$ : _ WEND CLOSE 2 END SUB 58162 ' $SUBTITLE: 'InitFMS - sub to initialize file management system' ' $PAGE ' ' NAME -- InitFMS ' ' INPUTS -- PARAMETER MEANING ' ZFMSDirectory$ ' ' OUTPUTS -- ZCategoryName$() ELEMENTS 1,2, POSSIBLY MORE ' ZCategoryCode$() ELEMENTS 1,2, POSSIBLY MORE ' ZCategoryDesc$() ELEMENTS 1,2, POSSIBLY MORE ' CategoryIndex COUNT OF # ELEMENTS IN THE FILE ' MANAGMENT SYSTEM ' ' PURPOSE -- Subroutine to initialize the RBBS-PC File Management System ' SUB InitFMS (ZCategoryName$(1),ZCategoryCode$(1), _ ZCategoryDesc$(1),CategoryIndex) STATIC Blank$ = " " CategoryIndex = 0 IF ZFMSDirectory$ <> "" THEN _ CategoryIndex = CategoryIndex + 1 : _ CatN$ = ZCategoryName$(CategoryIndex) : _ CALL BreakFileName (ZFMSDirectory$,DrvPath$,CatN$,Extension$,ZFalse) : _ ZCategoryName$(CategoryIndex) = CatN$ : _ ZCategoryCode$(CategoryIndex) = "" : _ ZCategoryDesc$(CategoryIndex) = "All uploads"_ ELSE ZLimitSearchToFMS = ZFalse : _ EXIT SUB IF ZLimitSearchToFMS OR ZMasterDirName$ = ZMainFMSDir$ THEN _ CategoryIndex = CategoryIndex + 1 : _ ZCategoryName$(CategoryIndex) = "ALL" : _ ZCategoryCode$(CategoryIndex) = "" : _ ZCategoryDesc$(CategoryIndex) = "All files" CALL FindIt (ZDirCatFile$) IF NOT ZOK THEN _ EXIT SUB WHILE NOT EOF(2) CALL ReadParms (ZWorkAra$(),3,1) IF ZErrCode > 0 THEN _ ZErrCode = 0 : _ CALL PScrn (ZDirCatFile$+" invalid. Line" + STR$(CategoryIndex) + " needs 3 parms") : _ CALL DelayTime (4) _ ELSE CategoryIndex = CategoryIndex + 1 : _ ZCategoryName$(CategoryIndex) = ZWorkAra$(1) : _ ZCategoryCode$(CategoryIndex) = ZWorkAra$(2) : _ ZCategoryDesc$(CategoryIndex) = ZWorkAra$(3) : _ CatR$ = ZCategoryCode$(CategoryIndex) : _ CALL Remove (CatR$,Blank$) : _ ZCategoryCode$(CategoryIndex) = CatR$ WEND CLOSE 2 END SUB 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)) 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) 58168 UpldIndex = UpldIndex + ZUpInc IF UpldIndex = CutoffRec THEN _ GOTO 58182 GET #2,UpldIndex FMSCheckPoint = FMSCheckPoint + 1 ON INSTR("\* =",LEFT$(PartToPrint$,1)) GOTO 58168,58171,58170,58169 GOTO 58172 58169 CALL CheckInt (MID$(PartToPrint$,34)) IF ZUserSecLevel < ZTestedIntValue THEN _ LastOK = ZFalse : _ 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 58170 IF ZExtendedOff THEN _ GOTO 58168 _ ELSE IF LastOK THEN _ GOTO 58175 _ ELSE IF ZJumpSearching THEN _ GOTO 58187 _ ELSE IF SearchString$ <> "" AND (NOT WildSearch) AND FailedSearch THEN _ GOTO 58187 _ ELSE GOTO 58168 58171 IF Category$ = "***" THEN _ GOTO 58176 _ ELSE HoldCat$ = "," + Category$ + "," : _ IF INSTR(Categories$,HoldCat$) > 0 THEN _ GOTO 58176 _ ELSE GOTO 58168 58172 LastOK = ZFalse FailedSearch = ZFalse LastFName = UpldIndex IF Category$ = "***" THEN _ IF NOT ZSysop THEN _ GOTO 58178 IF Category$ = ZDefaultCatCode$ THEN _ IF BelowMinSec THEN _ GOTO 58178 58173 IF LEN(Categories$) > 2 THEN _ HoldCat$ = "," + _ Category$ + _ "," : _ CALL Remove (HoldCat$,Blank$) : _ IF INSTR(Categories$,HoldCat$) = 0 THEN _ GOTO 58178 IF ZJumpSearching OR SearchString$ <> "" THEN _ ZOutTxt$ = PartToPrint$ : _ IF WildSearch THEN _ Temp$ = LEFT$(PartToPrint$,INSTR(PartToPrint$," ")-1) : _ Temp$ = MID$(Temp$,1-(LEFT$(Temp$,1)="=")) : _ CALL WildFile (SearchString$,Temp$,ZOK) : _ IF ZOK THEN _ FoundString$ = SearchString$ : _ GOTO 58175 _ ELSE GOTO 58178 _ ELSE CALL AllCaps (ZOutTxt$) : _ HiLitePos = INSTR(ZOutTxt$,SearchFor$) : _ IF HiLitePos = 0 THEN _ FailedSearch = ZTrue : _ GOTO 58178 _ ELSE HiLiteRec = UpldIndex : _ FoundString$ = SearchFor$ : _ IF ZJumpSearching THEN _ ZJumpSearching = ZFalse : _ SearchFor$ = PrevSearch$ 58174 IF SearchDate$ <> "" THEN _ HoldCat$ = MID$(PartToPrint$,30,2) + _ MID$(PartToPrint$,24,2) + _ MID$(PartToPrint$,27,2) : _ IF HoldCat$ < SearchDate$ THEN _ IF ZDateOrderedFMS THEN _ GOTO 58183 _ ELSE GOTO 58168 ' ' ' * Allow the FMS to be both fast and interruptable if a local ' * user or there is nothing in the input buffer by using QuickTPut. ' ' 58175 LastOK = ZTrue 58176 ZWasA = EndDesc IF LEFT$(PartToPrint$,5) = " " THEN _ GOTO 58178 ZOutTxt$ = PartToPrint$ CALL TrimTrail (ZOutTxt$," ") CALL ColorDir (ZOutTxt$,"Y") IF UpldIndex = HiLiteRec THEN _ HiLiteRec = -1 : _ HiLitePos = 0 : _ CALL CheckColor (ZOutTxt$,FoundString$,"") 58177 IF ZLocalUser THEN _ CALL QuickTPut1 (ZOutTxt$) : _ GOTO 58178 CALL EofComm (Char) IF Char = -1 THEN _ CALL QuickTPut1 (ZOutTxt$) _ ELSE ZSubParm = 5 : _ CALL TPut : _ IF ZRet THEN _ GOTO 58183 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 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)) 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 58182 IF ZChainedDir$ <> "" THEN _ ZActiveFMSDir$ = ZChainedDir$ : _ GOSUB 58185 : _ GOTO 58168 58183 CLOSE 2 ZNonStop = (ZPageLength < 1) ZStopInterrupts = ZFalse ZOutTxt$ = "" ZActiveFMSDir$ = "" ' KG031801 ZJumpSupported = ZFalse EXIT SUB 58185 CALL OpenFMS (UpldIndex) EndDesc = 33 + ZMaxDescLen FIELD 2, EndDesc AS PartToPrint$, _ 3 AS Category$, _ 2 AS Filler$ PrevFMS$ = ZActiveFMSDir$ IF ZUpInc = -1 THEN _ CutoffRec = 0 : _ UpldIndex = UpldIndex + 1 _ ELSE CutoffRec = UpldIndex + 1 : _ UpldIndex = 0 RETURN 58187 ZOutTxt$ = PartToPrint$ CALL AllCaps (ZOutTxt$) HiLitePos = INSTR(ZOutTxt$,SearchFor$) IF HiLitePos < 1 THEN _ GOTO 58168 HiLiteRec = UpldIndex UpldIndex = LastFName GET 2,UpldIndex FoundString$ = SearchFor$ IF ZJumpSearching THEN _ SearchFor$ = PrevSearch$ GOTO 58175 END SUB