Category : BBS Programs+Doors
Archive   : RBBS-BAS.ZIP
Filename : RBBSSUB3.BAS

' $linesize:132
' $title: 'RBBSSUB3.BAS CPC17.3, Copyright 1986 - 90 by D. Thomas Mack'
' Copyright 1990 by D. Thomas Mack, all rights reserved.
' Name ...............: RBBSSUB3.BAS
' First Released .....: February 11, 1990
' Subsequent Releases.:
' 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
' ZDwnIndex Index OF FILENAME TO Transfer
'
' 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$(ZDwnIndex),WasX$,ZOutTxt$,ZWasY$,ZTrue)
ZOutTxt$ = ZOutTxt$ + ZWasY$ + "X"
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 ("Verifying file integrity...") : _
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 shared attribute")
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 _
ZUserIn$ = ZDefaultCatCode$ : _
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 " + _
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 your session time by"+WasX$+" minutes")
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(ZLibDiskArc$,"ARC") THEN _
Extension$ = "ARC" _
ELSE IF INSTR(ZLibDiskArc$,"ZIP") THEN _
Extension$ = "ZIP" _
ELSE IF INSTR(ZLibDiskArc$,"LHA") THEN _
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 "
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$ + "." + ZDefaultExtension$ + _
" 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$)
IF INSTR("H",ZWasZ$) > 0 THEN _
GOTO 21602
ZFF = INSTR(ZDefaultXfer$,ZWasZ$)
IF ZFF < 1 THEN _
GOTO 21600
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$)
ZAnsIndex = 0
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 (ZSecsPerSession! - ZSecsUsedSession!) _
> HowMuchTimeLeft! THEN _
ZSecsPerSession! = HowMuchTimeLeft! + _
ZSecsUsedSession! : _
IF NOT ToldShort THEN _
ToldShort = ZTrue : _
ZOutTxt$ = "Time shortened for scheduled event" : _
CALL RingCaller
41020 MinsRemaining = (ZSecsPerSession! - ZSecsUsedSession!) / 60
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 (STR$(MinsRemaining) + " min left")
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$(ZNumDwldBytes!) + MID$(STR$(-ZBatchTransfer),2)
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$))
MID$(ZMsgRec$,101,2) = STR$(ZLocalUser)
MID$(ZMsgRec$,103,2) = STR$(ZLocalUserMode)
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))
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))
ZNumDwldBytes! = CVS(MID$(ZMsgRec$,48,4))
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))
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") : _
CALL BufFile (ZOutTxt$(7),WasX)
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 = VAL(MID$(ZMsgRec$,101,2))
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 + _
VAL(MinLoggedOn$) * 60 + _
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$)
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$)
IF MID$(ConvertField$,WasZ,1) > "@" THEN _
MID$(ConvertField$,WasZ,1) = CHR$(ASC(MID$(ConvertField$,WasZ,1)) AND 223)
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" + _
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$ = ""
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 Fill3$, _
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 _
GOTO 58142
IF (ZCanDnldFromUp OR Category$ <> ZDefaultCatCode$) THEN _
WasL = WasL + 1 : _
Ara(WasL,1) = 372 * (VAL(Year$) - 80) + 31 * VAL(WasMM$) + VAL(WasDD$)
IF NOT ZCanDnldFromUp THEN _
WasX = ZMinSecToView _
ELSE IF Category$ = "***" THEN _
WasX = ZSysopSecLevel _
ELSE IF Category$ = ZDefaultCatCode$ THEN _
WasX = ZMinSecToView _
ELSE WasX = ZOptSec(19)
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 " _
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))
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)
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 : _
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 < 1000 THEN _
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 _
CALL QuickTPut1 (ZEmphasizeOff$ + "Files checked thru " + MID$(PartToPrint$,24,8))
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 _
ZLastIndex = ZWasQ : _
ZAnsIndex = 1 : _
CALL GetArc : _
ZWasA = UpldIndex : _
GOSUB 58185 : _
UpldIndex = ZWasA : _
GOTO 58180
IF ZUserIn$(1) = "D" THEN _
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
FMSCheckPoint = 0
GOTO 58168
58182 IF ZChainedDir$ <> "" THEN _
ZActiveFMSDir$ = ZChainedDir$ : _
GOSUB 58185 : _
GOTO 58168
58183 CLOSE 2
ZNonStop = (ZPageLength < 1)
ZStopInterrupts = ZFalse
ZOutTxt$ = ""
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