home *** CD-ROM | disk | FTP | other *** search
- 3 ' $linesize: 132
- 4 ' $title: 'RBBS CPC17.3, Copyright 1990 by D. Thomas Mack'
- 5 ' WARNING !!! DO NOT CHANGE, BYPASS OR Remove LINES 3-29
- 9 'by D. Thomas Mack, 39 Cranbury Drive, Trumbull, CT 06611 (up to 16)
- ' Jon Martin, 4396 N Prairie Willow Ct, Concord, CA 94521 (up to 17.2B)
- ' Ken Goosens, 5020 Portsmouth Road, Fairfax, VA 22032 (up to 17.3)
- 13 '
- 14 ' *******************************NOTICE*************************************
- 15 ' * A limited license is granted to all users of this program and it's *
- 16 ' * companion program, CONFIG (version 17.3), to make copies of this *
- 17 ' * program and distribute the copies to other users, on the following *
- 18 ' * conditions: *
- 19 ' * 1. The notices contained in lines 3 through 29 of the program *
- 20 ' * are not altered, bypassed, or removed. *
- 21 ' * 2. The program is not to be distributed to others in modified *
- 22 ' * form (i.e. the line numbers must remain the same). *
- 23 ' * 3. No fee is to be charged (or any other consideration received) *
- 24 ' * for copying or distributing these programs without an express *
- 25 ' * written agreement with D. Thomas Mack, The Second Ring, 39 *
- 26 ' * Cranbury Drive, Trumbull, Conneticut 06611 *
- 27 ' * *
- 28 ' * Copyright (c) 1983-1990 D. Thomas Mack, The Second Ring *
- 29 ' **************************************************************************
- '
- ' $INCLUDE: 'RBBS-VAR.BAS'
- '
- ' $SUBTITLE: 'Main-line RBBS-PC Program'
- ZCrLf$ = CHR$(13) + CHR$(10)
- WasJ = 60
- DIM ZOptSec(WasJ)
- ZConfigFileName$ = "RBBS-PC.DEF"
- CALL GetCommand (ZDebug,NetTime$,ZNetBaud$,ZNetReliable$)
- ZSubParm = -62
- ZBulletinMenu$ = ""
- CALL ReadDef (ZConfigFileName$)
- IF ZErrCode > 0 THEN _
- GOTO 31
- CALL MLInit (1)
- ZSubParm = -9
- CALL Carrier
- 'IF ZSubParm THEN _
- ' CALL CopyRight
- GOTO 100
- 31 ZSnoop = ZTrue
- CALL PScrn ("Configuration "+ZConfigFileName$+" missing or improper format") : _
- GOTO 204
- 100 CLEAR,,ZSizeOfStack
- DEF SEG ' Point to BASIC
- WIDTH 80 ' Set Screen Width
- KEY OFF ' Line 25 turned off
- ' ********************* Variable Definitions *******************************
- 102 ZMsgDim = 99
- WasMM = 999
- WasBX = 75
- WasJ = 60
- REDIM ZOptSec(WasJ)
- DIM ZWorkAra$(WasJ)
- DIM ZGSRAra$(WasJ)
- DIM ZCategoryName$(WasBX),ZCategoryCode$(WasBX),ZCategoryDesc$(WasBX)
- DIM ZOutTxt$(ZMsgDim) ' Message line table
- DIM ZUserIn$(ZMsgDim) ' Message line table
- DIM ZMsgPtr(WasMM,2) ' Message pointers
- CALL VarInit
- 105 ZVersionID$ = "17.32 HBMpl 123190"
- 106 CALL GetCommand (ZDebug,NetTime$,ZNetBaud$,ZNetReliable$)
- ZSubParm = 1
- CALL ReadDef (ZConfigFileName$)
- IF ZErrCode > 0 THEN _
- GOTO 31
- REDIM ZWorkAra$(ZMaxWorkVar)
- REDIM ZGSRAra$(ZMaxWorkVar)
- ZUseTPut = (ZUpperCase OR ZXOnXOff)
- OrigUpgradeSec = ZAutoUpgradeSec
- ZOrigCallers$ = ZCallersFile$
- ZOrigMsgFile$ = ZMainMsgFile$
- ZOrigUserFile$ = ZMainUserFile$
- OrigMainSec = ZMinLogonSec
- ZOrigSysopFN$ = ZSysopFirstName$
- ZOrigSysopLN$ = ZSysopLastName$
- ZExpertUser = ZExpertUserDef
- ZPromptBell = ZPromptBellDef
- CALL BreakFileName (ZOrigMsgFile$,Drive$,OrigMsgName$,ZWasY$,ZFalse)
- IF OrigMsgName$ = "MESSAGES" THEN _
- OrigMsgName$ = "MAIN" _
- ELSE IF RIGHT$(OrigMsgName$,1) = "M" THEN _
- OrigMsgName$ = LEFT$(OrigMsgName$,LEN(OrigMsgName$)-1)
- ConfFileName$ = OrigMsgName$
- OrigNewsFileName$ = ZWelcomeFileDrvPath$ + _
- OrigMsgName$ + ".NWS"
- ZNewsFileName$ = OrigNewsFileName$
- IF ZNetMail$ <> "NONE" AND VAL(NetTime$) > 0 THEN _
- ZLimitMinsPerSession = VAL(NetTime$)
- IF ZNetMail$ <> "NONE" AND VAL(ZNetBaud$) > 0 THEN _
- ZExpectActiveModem = ZTrue : _
- IF NOT ZKeepInitBaud THEN _
- ZModemInitBaud$ = ZNetBaud$
- 108 CALL BreakFileName (ZCallersFile$,Drive$,WasX$,ZWasY$,ZTrue)
- ZCallersFilePrefix$ = WasX$
- ZNodeWorkDrvPath$ = Drive$
- ZArcWork$ = ZNodeWorkDrvPath$ + _
- "ARCWORK" + _
- ZNodeFileID$ + _
- ".DEF"
- IF ZUseBASICWrites THEN _
- ZLocalBksp$ = ZBackArrow$ _
- ELSE ZLocalBksp$ = ZBackSpace$
- SysopFullName$ = LEFT$(ZSysopFirstName$ + " " + ZSysopLastName$ + " ",22)
- ZFastFileSearch = ZFalse
- CALL FindIt (ZFastFileList$)
- IF ZOK THEN _
- CALL FindIt (ZFastFileLocator$) : _
- ZFastFileSearch = ZTrue : _
- CALL BreakFileName (ZFastFileList$, Drive$,WasX$,ZWasY$,ZTrue) : _
- ZFileName$ = Drive$ + WasX$ + "T" + ZWasY$ : _
- CALL FindIt (ZFileName$) : _
- IF ZOK THEN _
- CALL OpenRSeq (ZFileName$, WasX, WasY, 72) : _
- FIELD 2, 72 AS IndexRec$ : _
- GET 2, 1 : _
- ZFastTabs$ = IndexRec$ : _
- CLOSE 2
- '
- ' ***** INITIALIZE NetBIOS INTERFACE ****
- '
- IF ZNetworkType = 6 AND NOT SubBoard THEN _
- CALL InitIBM
- '
- ' ***** ESTABLISH NEXT CALLERS FILE RECORD AVAILABLE ***
- '
- CALL SetCall
- 112 IF NOT SubBoard THEN _
- ZLocalUser = ZTrue : _
- ZOutTxt$ = ZColorReset$ : _
- ZSubParm = 1 : _
- CALL TPut : _
- ZLocalUser = ZFalse
- ZUpldDriveFile$ = RIGHT$(ZDnldDrives$,1)+":FREESPAC.UPL"
- MinsPerSessionDef = ZMinsPerSession
- MaxPerDayDef = ZMaxPerDay
- '
- ' ***** TEST FOR MESSAGE FILE PRESENT (Abort IF NOT PRESENT) ****
- '
- 135 IF ZCurDef$ = ZOrigCnfg$ THEN _
- ZActiveMessageFile$ = ZMainMsgFile$ : _
- ZActiveUserFile$ = ZMainUserFile$
- GOSUB 4910
- IF ZConfMode THEN _
- GOTO 150
- ZLocalUserMode = (RIGHT$(ZComPort$,1) < "1")
- GET 1,ZNodeRecIndex
- ZWasY$ = MID$(ZMsgRec$,77,2)
- CALL UnPackDate (ZWasY$,WasX,WasL,WasI,ZOldDate$)
- ZOldDate$ = LEFT$(ZOldDate$,6) + MID$(STR$(WasX),2)
- ZHourMinToDropToDos = - (ZHourMinToDropToDos > 0) * ZHourMinToDropToDos
- Hour = INT(ZHourMinToDropToDos / 100)
- WasMN = ZHourMinToDropToDos - Hour * 100
- ZTimeToDropToDos! = Hour * 3600 + WasMN * 60! ' KK030901
- '
- ' ****** TEST FOR TIMED EXIT ACTIVE *****
- '
- 140 IF ZHourMinToDropToDos > 0 AND _
- ZOldDate$ <> DATE$ AND _
- TIMER >= ZTimeToDropToDos! AND _
- TIMER < 86340 THEN _
- GOTO 206
- '
- ' **** GET CURRENT STATUS OF SYSOP AVAIL, SYSOP ANNOY, SYSOP NEXT, & PRINTER
- '
- 150 IF SubBoard THEN _
- GOSUB 12987 : _
- GOSUB 5135 : _
- GOTO 170
- ZSysopAvail = VAL(MID$(ZMsgRec$,32,2))
- ZSysopAnnoy = VAL(MID$(ZMsgRec$,34,2))
- ZSysopNext = VAL(MID$(ZMsgRec$,36,2))
- MID$(ZMsgRec$,36,2) = STR$(ZFalse)
- ZPrinter = VAL(MID$(ZMsgRec$,38,2))
- IF ZTurnPrinterOff THEN _
- ZPrinter = ZFalse
- ZExitToDoors = (MID$(ZMsgRec$,40,2) = "-1" AND ZNetBaud$ = "")
- ZEightBit = VAL(MID$(ZMsgRec$,42,2))
- ZBPS = VAL(MID$(ZMsgRec$,44,2))
- ZSnoop = VAL(MID$(ZMsgRec$,58,2))
- MID$(ZMsgRec$,57,1) = "I"
- ZPrivateDoor = (MID$(ZMsgRec$,72,2) = "-1")
- IF ZPrivateDoor THEN _
- ZHasPrivDoor = ZTrue
- MID$(ZMsgRec$,72,2) = STR$(ZFalse)
- ZLocalUser = (MID$(ZMsgRec$,101,2) = ZCarriageReturn$+ZCarriageReturn$) ' KG030601
- IF ZExitToDoors OR ZPrivateDoor THEN _
- ZHasDoored = ZTrue : _
- TurboLogon = ZTrue
- PUT 1,ZNodeRecIndex
- GOSUB 12985
- '
- ' ***** INITIALIZE VOICE SYNTHESIZER ****
- '
- ' CALL Talk (Init,ZOutTxt$) 'Pe 01/03/90
- '
- ' ***** TEST FOR MULTI LINK PRESENT IF NOT COMPAQ COMPUTER ****
- '
- 160 CALL MLInit (4)
- 170 FOR FunctionKeyIndex = 1 TO 10
- KEY FunctionKeyIndex,""
- NEXT
- CALL LoadNew (ZMsgPtr())
- '
- ' ****** INITIALIZE FILE MANAGEMENT SYSTEM, CHECK FOR LOCAL BBS MODE
- '
- 175 GOSUB 5344
- CALL CountLines (MaxEntries)
- REDIM ZCategoryName$(MaxEntries),ZCategoryCode$(MaxEntries),_
- ZCategoryDesc$(MaxEntries) : _
- CALL InitFMS (ZCategoryName$(),ZCategoryCode$(), _
- ZCategoryDesc$(),ZNumCategories)
- ZMaxMsgLines = ZMaxMsgLinesDef
- ZLocalUser = (ZLocalUser OR ZLocalUserMode)
- IF (NOT ZLocalUser) AND (NOT SubBoard) THEN _
- CALL OpenCom (ZModemInitBaud$,",N,8,1")
- IF NOT SubBoard THEN _
- CALL SetEcho (ZDefaultEchoer$)
- ZNodeWorkFile$ = ZNodeWorkDrvPath$ + _
- "NODE" + _
- ZNodeFileID$ + _
- "WRK"
- ZSecsPerSession! = ZMinsPerSession * 60! ' KK030901
- IF NOT ZLocalUserMode THEN _
- IF NOT ZExitToDoors THEN _
- GOTO 180 _
- ELSE IF NOT ZLocalUser THEN _
- GOTO 180
- ZLocalUser = ZTrue
- ZBPS = -6
- ZBaudTest! = 9600
- ZEightBit = ZTrue
- ZSnoop = ZTrue
- IF ZExitToDoors THEN _
- CALL AMorPM : _
- CALL ReadProf : _
- GOTO 410
- GOSUB 178
- GOTO 345
- '178 IF SubBoard THEN _
- ' IF OrigFirstName$ = ZSysopFirstName$ AND _ 'DGS-ALSMod
- ' ZLastName$ = ZSysopLastName$ THEN _
- ' RETURN 832 _
- ' ELSE RETURN 790
- ' RETURN
- 178 IF SubBoard THEN _
- IF ZFirstName$ = ZSysopFirstName$ AND _
- ZLastName$ = ZSysopLastName$ THEN _
- RETURN 832 _
- ELSE RETURN 800 'was 790 but caused problems
- RETURN
- 180 ZSubParm = 2
- CALL Line25
- GOSUB 178
- '
- ' ****** WAIT FOR THE PHONE TO RING AND ANSWER IT ****
- '
- ZSubParm = 1
- 200 ZToggleOnly = ZTrue
- CALL AnswerIt
- GET 1,ZNodeRecIndex
- ZSnoop = VAL(MID$(ZMsgRec$,58,2))
- ZToggleOnly = ZFalse
- IF ZErrCode > 1 THEN _
- GOTO 13000
- IF ZSubParm < 0 THEN _
- GOTO 202
- ON ZSubParm GOTO 410, _ ' 1 = ANSWERED PHONE & CARRIER FOUND
- 330, _ ' 2 = CARRIER FOUND BEFORE ANSWERING
- 822, _ ' 3 = Sysop GETS SYSTEM NEXT
- 10595, _ ' 4 = ANSWERED PHONE BUT NO CARRIER
- 13540, _ ' 5 = NOT USED
- 202, _ ' 6 = LOCAL SYSOP KEY PRESSED
- 206, _ ' 7 = TIME TO DROP TO DOS
- 13538 ' 8 = No CALLS! TIME TO RECYCLE
- 202 ZFF = -ZSubParm
- ON ZFF GOTO 10595, _ ' -1 = CARRIER DROPPED
- 4770, _ ' -2 = SYSOP INITIATED CHAT
- 205, _ ' -3 = FORCE SYSTEM TO ANSWER THE PHONE
- 204, _ ' -4 = EXIT TO DOS IMMEDEATELY
- 203, _ ' -5 = EXIT TO DOS AFTER CLEAN-UP
- 10698, _ ' -6 = INDICATE ACCESS IS DENIED AND LOGOFF USER
- 10620 ' -7 = UPDATE CALLERS FILE AND LOGOFF USER
- 203 CALL MLInit(3)
- 204 SYSTEM
- 205 ZSubParm = 4
- GOTO 200
- 206 CALL TimedOut
- GOTO 203
- 330 CALL Carrier
- IF ZSubParm = -1 THEN _
- GOTO 10595
- CALL EofComm (Char)
- IF Char = -1 THEN _
- GOTO 335
- CALL FlushCom (ZWasDF$)
- IF ZSubParm = -1 THEN _
- GOTO 10595
- GOTO 330
- 335 ZExitToDoors = ZFalse
- ZPrivateDoor = ZFalse
- IF ZWasCL <> 1 THEN _
- LOCATE 22,34
- WasD$ ="CONNECT" + _
- STR$(ZBaudTest!) + _
- " "
- GOSUB 1315
- '
- ' ***** DISPLAY WELCOME LINE ****
- '
- 345 LOCATE 24,1
- CALL AMorPM
- ZUserLogonTime! = TIMER
- ZTimeLoggedOn$ = TIME$
- ZLinesPrinted = 0
- ZExpertUserDef = ZExpertUser
- ZExpertUser = ZFalse
- CALL SetExpert
- ZOutTxt$ = ""
- IF NodesInSystem > 1 THEN _
- ZOutTxt$ = " - Node " + ZNodeID$
- IF ZReliableMode THEN _
- ZOutTxt$ = ZOutTxt$ + " (Reliable Connect)"
- CALL QuickTPut1 ("Welcome to " + ZRBBSName$ + ZOutTxt$)
- ZTestParity = ZTrue
- ZStopInterrupts = ZTrue
- ZFileName$ = ZPreLog$
- CALL FlushCom (WasX$)
- ZCommPortStack$ = ""
- 346 GOSUB 466
- IF ZSubParm = -1 THEN _
- GOTO 13540
- ZFF = ZFalse
- '********** Delete all the files in ARKVIEW.PATH$ **********
- '***********************************************************
- 'First create a Dummy file so the directory is not empty. It
- 'avoids having to use an ON ERROR routine if the directory
- 'is empty. Then just kill everything in the ARKVIEW.PATH$
- '***********************************************************
- CALL OpenOutW (ZArkViewPath$ + "\DANDAN.DAN")
- CLOSE 2
- CALL KillWork (ZArkViewPath$ + "\*.*")
- '
- '
- ' ***** GET USER NAME
- ' ***** C - COMMAND FROM NEWUSER REGISTER OPTIONS (CHANGE NAME OR ADDRESS)
- '
- 400 CALL SkipLine(1)
- ZEscapeInsecure = ZFalse
- ZUpperCase = ZFalse
- ZExpertUser = ZExpertUserDef
- CALL SetExpert
- WasA1$ = "What is your "
- GOSUB 12500
- CALL CommInfo
- IF ZFF THEN _
- ZLogonErrorIndex = 1 : _
- GOTO 10620
- IF ZMinOldCallerBaud > ZBaudTest! THEN _
- CALL QuickTPut (MID$(STR$(ZBaudTest!),2) + " BAUD ACCESS NOT ALLOWED!",2) : _
- ZWasLG$(7) = "OLD CALLER BAUD RESTRICTION" : _
- ZLogonErrorIndex = 7 : _
- GOTO 10620
- TurboLogon = (LEFT$(ZUserIn$(4),1) = "!")
- SkipWelcomeScreen = (LEFT$(ZUserIn$(4),1) = "$")
- ZHomeConf$ = RIGHT$(ZUserIn$(4),LEN(ZUserIn$(4)) _
- + (TurboLogon OR SkipWelcomeScreen))
- CALL AllCaps(ZHomeConf$)
- NumOfTC = ZLastIndex-3 'DGS-TTC
- '
- ' ***** CHECK IF SAME USER ON ANOTHER NODE ***
- '
- 410 IF ZExitToDoors THEN _
- ZCurDate$ = MID$(ZMsgRec$,119,2) + _
- "-" + _
- MID$(ZMsgRec$,121,2) + _
- "-" + _
- MID$(ZMsgRec$,123,2) : _
- ZTime$ = MID$(ZMsgRec$,125,2) + _
- ":" + _
- RIGHT$(ZMsgRec$,2) : _
- IF LEFT$(ZTime$,2) < "12" THEN _
- ZTime$ = ZTime$ + _
- " AM" _
- ELSE ZTime$ = ZTime$ + _
- " PM"
- NodeIndex = 2
- WasXX = NodesInSystem + 1
- WasX$ = LEFT$(ZActiveUserName$+" ",30)
- 412 IF NodeIndex > WasXX THEN _
- GOTO 430
- GET 1,NodeIndex
- IF INSTR(ZMsgRec$,WasX$) THEN _
- GOTO 420
- NodeIndex = NodeIndex + 1
- GOTO 412
- 420 IF MID$(ZMsgRec$,57,1) = "A" THEN _
- ZLogonErrorIndex = 6 : _
- ZWasLG$(6) = ZWasLG$(6) + _
- LEFT$(ZMsgRec$,25) : _
- ZOutTxt$ = "Name <" + ZActiveUserName$ + "> in use on another node" : _
- CALL RingCaller : _
- GOTO 10620
- ZFirstName$ = LEFT$(ZMsgRec$,INSTR(ZMsgRec$, " ") - 1)
- ' IF NOT ZPrivateDoor THEN _ ' Bh 112290
- ' CALL SkipLine (1) : _
- ' CALL QuickTPut1 (ZFirstName$ + ", welcome back!")
- IF ZExitToDoors THEN _
- GOTO 457
- '
- ' ***** TEST FOR REMOTE SYSOP LOGGING ON ***
- '
- 430 GET 1,ZNodeRecIndex
- SameUser = (ZActiveUserName$ = LEFT$(ZMsgRec$,LEN(ZActiveUserName$)))
- DelSpace = INSTR(MID$(ZMsgRec$,1,31)," ")
- PrevUserName$ = MID$(ZMsgRec$,1,DelSpace + 1 ) +_
- MID$(ZMsgRec$,93,24)
- '
- ' ***** TEST FOR SYSOP NAME ATTEMPT ***
- '
- 445 IF INSTR(ZActiveUserName$,"SYSOP") OR _
- INSTR(ZActiveUserName$,ZSysopFirstName$ + " " + ZSysopLastName$) THEN _
- ZLogonErrorIndex = 2 : _
- GOTO 10620
- '
- ' ***** REMOVE INVALID CHARACTERS FROM USER NAME ***
- '
- 455 CALL BadChar (ZActiveUserName$)
- IF ZActiveUserName$ = "" THEN _
- GOTO 400
- '
- ' **** CHECK FOR ACTIVE USER ***
- '
- 457 CALL SkipLine (1)
- GOSUB 12840
- GOSUB 12850
- GOSUB 12598
- GOSUB 11482
- CALL CompDate (TodayRegYY,TodayRegMM,TodayRegDD,TodayComputeDate!)
- IF NOT Found THEN _
- GOTO 700
- GOSUB 12984
- '
- ' ***** ACTIVE USER FOUND ****
- '
- 459 GOSUB 9500
- ZLastDateTimeOnSave$ = ZLastDateTimeOn$
- IF ZExitToDoors THEN _
- TempHoldTime! = VAL(LEFT$(ZTime$,2))*3600! + _ 'KK030901
- VAL(MID$(ZTime$,4,2))*60! : _ 'KK030981
- CALL CheckTime(TempHoldTime!, TempTime!, 2) : _
- MinsInDoors = TempTime! / 60 : _
- CALL TimeRemain (MinsRemaining)
- ZUserFileIndex = LOC(5)
- GOSUB 5135
- '
- ' *** COMPUTE THE NUMBER OF DAYS REMAINING UNTIL REGISTRATION EXPIRES **
- '
- IF ZRestrictByDate AND ZDaysInRegPeriod > 0 THEN _
- CALL CompDate (UserRegYY,UserRegMM,UserRegDD,UserComputeDate!) : _
- ZRegDaysRemaining = UserComputeDate! + _
- ZDaysInRegPeriod - _
- TodayComputeDate! : _
- CALL ExpireDate (UserComputeDate!,ZDaysInRegPeriod,ZExpirationDate$) _
- ELSE ZDaysInRegPeriod = 0
- IF NOT ZPrivateDoor THEN _
- IF ZRegDaysRemaining < 0 AND ZDaysInRegPeriod > 0 THEN _
- IF ZUserSecLevel > ZExpiredSec THEN _
- CALL QuickTPut1 (ZWasLG$(9) + _
- " - security reset to " + _
- STR$(ZExpiredSec)) : _
- CALL BufFile(ZHelpPath$+"RGXPIRD"+ZHelpExtension$,WasX) : _
- ZLogonErrorIndex = 9 : _
- ZUserSecLevel = ZExpiredSec : _
- LSET ZSecLevel$ = MKI$(ZUserSecLevel) : _
- GOSUB 5135
- 460 UserSecLevel$ = STR$(ZUserSecLevel)
- IF ZUserSecLevel > -1 THEN _
- UserSecLevel$ = MID$(UserSecLevel$,2) : _ 'DGS-MSRMod
- DGSAcc$=UserSecLevel$ 'DGS-MSR
- IF ZUserSecLevel >= ZMinLogonSec THEN _
- GOTO 470
- IF NOT ZPrivateDoor THEN _
- DGSAcc$ = "MSR" : _ 'DGS-MSR
- GOSUB 465 : _
- CALL DelayTime (8 + ZBPS)
- IF ZLogonErrorIndex < 9 AND _
- ZErrCode = 0 THEN _
- ZLogonErrorIndex = 8
- GOTO 10620
- '
- ' *** DISPLAY LOG-ON MESSAGE FOR SPECIFIC SECURITY LEVEL **
- '
- 465 TurboLogon = TurboLogon AND (ZExitToDoors OR _
- (ZUserSecLevel >= ZAllowCallerTurbo))
- IF TurboLogon THEN _
- RETURN
- ZFileName$ = ZWelcomeFileDrvPath$ + _
- "LG" + _
- DGSAcc$ + _ 'DGS-MSRMod
- ".DEF"
- CALL Graphic (ZUserGraphicDefault$,ZFileName$)
- 466 ZStopInterrupts = ZTrue
- ZBypassTimeCheck = ZTrue
- CALL BufFile (ZFileName$,WasX)
- RETURN
- 470 GOSUB 12989
- ZWasCI$ = ZCityState$
- CALL Trim (ZWasCI$)
- ZAttemptsAllowed = 4
- ZPswdSave$ = ZPswd$
- TempSysop = (ZUserSecLevel >= ZSysopSecLevel)
- ZMsgPswd = ZFalse
- IF NOT SubBoard THEN _
- ZElapsedTime = CVI(ZElapsedTime$)
- IF (NOT ZExitToDoors) AND _
- (ZCurDate$ <> LEFT$(ZLastDateTimeOn$,8)) AND _
- (ZElapsedTime > 0 OR NOT ZKeepTimeCredits) THEN _
- ZElapsedTime = 0
- IF ZPrivateDoor AND _
- ZTransferFunction = 3 THEN _
- GOSUB 755 : _
- GOTO 800
- IF ZPswdSave$ = SPACE$(LEN(ZPswdSave$)) THEN _
- GOSUB 755 : _
- GOTO 800
- 480 GOSUB 5370
- ' IF ZPrivateDoor OR (ZWasA AND ZEscapeInsecure) OR ZDoorSkipsPswd
- IF ZPrivateDoor OR (ZWasA AND ZEscapeInsecure) OR ZExitToDoors THEN _ 'Pe 01/03/90
- ZWasZ$ = ZPswdSave$ : _
- ZPswdFailed = 0 : _
- GOTO 644
- ZSubParm = 4
- CALL PassWrd
- ZLastIndex = 0
- 630 IF ZPswdFailed THEN _
- GOSUB 825 : _
- ZLogonErrorIndex = 4 : _
- GOTO 10620
- 643 GOSUB 41070
- 644 ZNewUser = ZFalse
- WasWK$ = RIGHT$(STR$(ASC(MID$(ZListNewDate$,2))),2) + _ ' MM
- "/" + _
- RIGHT$(STR$(ASC(MID$(ZListNewDate$,3))),2) + _ ' DD
- "/" + _
- RIGHT$(STR$(ASC(ZListNewDate$)),2) ' YY
- ZWasLM$ = RIGHT$(WasWK$,2) + _ ' YY
- LEFT$(WasWK$,2) + _ ' MM
- MID$(WasWK$,4,2) ' DD
- IF MID$(ZWasLM$,3,1) = " " THEN _
- MID$(ZWasLM$,3,1) = "0"
- 655 IF MID$(ZWasLM$,5,1) = " " THEN _
- MID$(ZWasLM$,5,1) = "0"
- 660 'CALL Muzak (1) 'Pe 01/03/90
- GOTO 800
- 670 GOSUB 12570
- IF Found THEN _
- GOSUB 12984 : _
- RETURN 12595
- RETURN
- '
- ' **** ACTIVE USER NOT FOUND (NEWUSER ROUTINE) ***
- '
- 700 ZExpertUser = ZFalse
- CALL SetExpert
- IF ZMinNewCallerBaud > ZBaudTest! THEN _
- CALL QuickTPut ("(" + MID$(STR$(ZBaudTest!),2) + " BAUD ACCESS FOR REGISTERED USERS ONLY)",2) : _
- ZWasLG$(7) = "NEW CALLER BAUD RESTRICTION" : _
- ZLogonErrorIndex = 7 : _
- GOTO 10620
- CALL QuickTPut1 ("User not found")
- ZLastIndex = 0
- GOSUB 12558
- IF ZNo THEN _
- GOSUB 12990 : _
- GOTO 400
- CALL Line25
- ZWasZ$ = ZFirstName$
- GOSUB 670
- ZWasZ$ = ZLastName$
- GOSUB 670
- ZWasZ$ = ZActiveUserName$
- GOSUB 670
- TurboLogon = ZFalse
- 710 IF ZUserFileIndex = 0 AND NOT ZSurviveNoUserRoom THEN _
- GOTO 13540
- 720 GOSUB 5370
- IF ZWasA THEN _
- ZUserSecLevel = ZSysopSecLevel _
- ELSE ZUserSecLevel = ZDefaultSecLevel
- 725 IF ZUserSecLevel < ZMinLogonSec THEN _
- ZLogonErrorIndex = 1 : _
- GOTO 460
- IF ZFirstName$ = ZLastName$ THEN _
- CALL QuickTPut1 (ZFirstNamePrompt$+"/"+ZLastNamePrompt$+" cannot be same") : _
- ZLogonErrorIndex = 3 : _
- GOTO 10620
- IF NOT ZRememberNewUsers THEN _
- GOSUB 13700 : _
- ZUserFileIndex = 0 : _
- GOSUB 12960: _
- PrevLastOn$ = "00-00-00": _
- GOTO 735
- ZNewUser = ZTrue
- ZNewUserDGS = ZTrue 'DGS-NEW
- CALL OpenUser (HighestUserRecord)
- GOSUB 9450
- GOSUB 12630
- MID$(ZUserRecord$,ZStartHash,ZLenHash) = LEFT$("NEWUSER",ZLenHash)
- IF ZStartIndiv>0 THEN _
- MID$(ZUserRecord$,ZStartIndiv,ZLenIndiv) = IndivValue$
- GOSUB 9440
- 730 GOSUB 12960
- 735 ZBypassTimeCheck = ZTrue
- CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue)
- CALL Line25
- ZFileName$ = ZNewUserFile$
- ZStopInterrupts = ZTrue
- GOSUB 1790
- CALL SkipLine(1)
- 739 CALL QuickTPut1 (ZActiveUserName$ + " from " + ZWasCI$)
- 740 ZOutTxt$ = "C)hange "+ZFirstNamePrompt$+"/"+ZLastNamePrompt$+"/"+ZUserLocation$+", D)isconnect, [R]egister"
- GOSUB 12995
- IF ZWasQ = 0 THEN _
- ZWasZ$ = "R" _
- ELSE CALL AllCaps (ZUserIn$(1)) : _
- ZWasZ$ = ZUserIn$(1)
- ZWasS = INSTR("CDR",ZWasZ$)
- 745 IF NOT ZRememberNewUsers THEN _
- ON ZWasS GOTO 748,752,754
- ON ZWasS GOTO 747,750,760
- GOTO 740
- 747 CALL UpdtCalr (ZActiveUserName$ + " from " + ZWasCI$ + _
- " changed Name/Address",2)
- MID$(ZUserRecord$,ZStartHash,ZLenHash) = STRING$(ZLenHash,0)
- GOSUB 9440
- GOSUB 12991
- 748 ZFF = ZFalse
- GOTO 400
- '
- ' *** D - COMMAND FROM NEWUSER ROUTINE (DISCONNECT - REFUSE TO REGISTER) **
- '
- 750 CALL UpdtCalr (ZActiveUserName$ + " from " + ZWasCI$ + _
- " didn't register",2)
- MID$(ZUserRecord$,ZStartHash,ZLenHash) = STRING$(ZLenHash,0)
- GOSUB 9440
- GOSUB 12991
- 752 ZFF = ZFalse
- ZUserFileIndex = 0
- GOTO 13540
- '
- ' ***** GET AND VERIFY PASSWORD ****
- '
- 754 CALL QuickTPut1 ("Guest privileges granted. Re-register on future calls")
- ZUserSecSave = ZUserSecLevel
- GOTO 832
- 755 IF ZPrivateDoor THEN _
- ZUserIn$ = ZPswd$ : _
- ZWasZ$ = ZUserIn$ : _
- RETURN
- GOSUB 12800
- ZOutTxt$ = "Re-Enter PASSWORD for Verification"
- GOSUB 45010
- SWAP ZWasZ$,ZUserIn$
- CALL AllCaps (ZWasZ$)
- IF ZUserIn$ <> ZWasZ$ THEN _
- CALL QuickTPut1 ("Passwords Don't Match!") : _
- GOTO 755
- RETURN
- '
- ' *** R - COMMAND FROM NEWUSER ROUTINE - REGISTER **
- '
- 760 GOSUB 755
- CALL AllCaps (ZWasZ$)
- LSET ZPswd$ = ZWasZ$
- ' CALL QuickTPut1 ("Please REMEMBER your password") 'ANSIEd
- ZUserTextColor = 37
- ZTempSecLevel = ZUserSecLevel
- CALL Protocol
- ZUserXferDefault$ = "N"
- ZProtoPrompt$ = "None"
- IF ZNewUserSetsDefaults THEN _
- GOSUB 42950 : _
- ZBypassTimeCheck = ZTrue : _
- GOSUB 43000 : _
- ZBypassTimeCheck = ZFalse : _
- CALL Graphic (ZUserGraphicDefault$,ZFileName$) : _
- GOSUB 42805 : _
- GOSUB 42700 _
- ELSE ZUpperCase = ZFalse : _
- ZHiLiteOff = ZTrue : _
- CALL SetGraphic (0,ZUserGraphicDefault$) : _
- ZNulls = ZFalse
- ZPageLength = ZPageLengthDef
- GOSUB 12900
- GOSUB 5135
- CALL DefaultU
- 790 'IF NOT ZNewUser THEN _ 'Pe 03/13/90
- ' GOTO 800
- ZFileName$ = ZNewUserQuestionnaire$
- ' GOSUB 11520 ' Bh BETTER FIX THIS
- LSET ZSecLevel$ = MKI$(ZUserSecLevel)
- UserSecLevel$ = STR$(ZUserSecLevel)
- CALL Remove (UserSecLevel$," ")
- '
- ' **** LOGIN ALL USERS ***
- '
- 800 CALL DoorReturn
- IF ZAdjustedSecurity THEN _
- GOSUB 5135
- IF ZOrigCnfg$ = ZCurDef$ THEN _
- ZMainUserFileIndex = ZUserFileIndex : _
- ZOrigSec = ZUserSecLevel : _
- ZUserSecSave = ZUserSecLevel : _
- OrigFirstName$ = ZFirstName$ : _ 'DGS-ALS
- ZOrigUserNameDGS$ = ZActiveUserName$ : _ 'DGS-ALS
- ZOrigUserName$ = ZActiveUserName$
- ZTimesLoggedOn = CVI(MID$(ZUserOption$,1,2)) - _
- ((ZOrigCnfg$ <> ZCurDef$ OR NOT SubBoard) AND _
- (NOT ZPrivateDoor) AND (NOT ZExitToDoors))
- GOSUB 9500
- IF (NOT ZExitToDoors) AND (NOT SubBoard) THEN _
- CALL UpdtCalr (ZActiveUserName$ + " from " + ZWasCI$ + _
- " Lvl" + STR$(ZUserSecLevel) + " " + TIME$,2)
- PrevLastOn$ = ZLastDateTimeOn$
- IF ZLocalUser THEN _
- ZTalkToModemAt$ = "9600" : _
- ZBaudParity$ = "9600 BAUD,N,8,1" : _
- ZModemInitBaud$ = "9600" : _
- ZSnoop = ZTrue : _
- ZLineFeeds = ZTrue
- CALL SetCrLf
- CALL SetPrompt
- CALL XferType (2,ZTrue)
- IF NOT SubBoard THEN _
- BoardCheckDate$ = PrevLastOn$
- IF ZPrivateDoor OR SubBoard THEN _
- GOTO 815
- GOSUB 465
- ' IF (ZEightBit AND _
- ' ZAutoDownDesired) OR _
- ' ZAskID THEN _
- ' CALL TestUser
- CALL QuickTPut1 (ZFG1$+"Logging " + ZActiveUserName$)
- ' CALL Talk (1,ZOutTxt$)
- CALL QuickTPut1 (ZFG2$ + "RBBS-PC " + ZVersionID$ + ZCrLf$ + _
- ZFG3$ + "Node " + ZNodeID$ + ZCrLf$ +_
- ZFG4$ + "Operating at " + ZBaudParity$ + ZEmphasizeOff$)
- ' ***** PARITY MOD ***** 'Pe 01/03/90
- IF RIGHT$(ZBaudParity$,5) <> "N,8,1" THEN _
- CALL QuickTPut(CHR$(12),3) : _
- ZOutTxt$ = CHR$(7) +" The BBS does NOT support E,7,1 Parameters " + ZCrLf$ + _
- " Please Change your Parameters to 8,N,1 and Call Back" : _
- CALL QuickTPut (ZOutTxt$,1) :_
- CALL DelayTime (3) : _
- GOTO 13540
- '***** END OF PARITY MOD *******
- '
- CALL DelayTime (2) 'Pe 01/03/90
- ' ** LOGIN NEW USER FOR THE CB SIMULATOR ** 'CHT021301
- ' IF NodesInSystem > 1 THEN 'CHT021301
- ' CALL LogNewForChat (NodesInSystem) 'CHT021301
- ' END IF 'CHT021301
- Attempts = 0
- '
- ' ***** NOTIFY CALLER IF ABLE TO "AUTODOWN" ****
- '
- ' IF ZEightBit AND ZAutoDownYes THEN _
- ' ZOutTxt$ = CHR$(9) + _
- ' ZReturnLineFeed$ + _
- ' "You may use AUTODOWNLOADing!" : _
- ' CALL RingCaller : _
- ' CALL DelayTime(4)
- 815 ZDnlds = CVI(ZUserDnlds$)
- ZUplds = CVI(ZUserUplds$)
- ZDLToday! = CVS(ZTodayDl$) 'Pe 01/03/90
- ZBytesToday! = CVS(ZTodayBytes$) 'Pe 01/03/90
- ZDLBytes! = CVS(ZDLBytes$) 'Pe 01/03/90
- ZULBytes! = CVS(ZULBytes$) 'Pe 01/03/90
- ZBankTime = ASC(ZBankTime$) 'Pe 03/22/90
- IF ZCurDate$ <> LEFT$(ZLastDateTimeOnSave$,8) THEN _
- ZDLToday! = 0 : _
- ZBytesToday! = 0
- IF NOT GlobalsSet THEN _
- GlobalsSet = ZTrue : _
- ZGlobalDnlds = ZDnlds : _
- ZGlobalUplds = ZUplds : _
- ZGlobalDLToday! = ZDLToday! : _
- ZGlobalBytesToday! = ZBytesToday! : _
- ZGlobalDLBytes! = ZDLBytes! : _
- ZGlobalULBytes! = ZULBytes! : _
- ZGlobalBankTime = ZBankTime 'Pe Bank Mod
- GOSUB 827
- LSET ZUserOption$ = MKI$(ZTimesLoggedOn) + _
- MID$(ZUserOption$,3)
- LSET ZLastDateTimeOn$ = ZCurDate$ + _
- " " + _
- ZTimeLoggedOn$
- MID$(ZUserRecord$,ZStartHash,ZLenHash) = HashValue$
- IF ZStartIndiv > 0 THEN _
- MID$(ZUserRecord$,ZStartIndiv,ZLenIndiv) = IndivValue$
- LSET ZUserName$ = ZOrigUserName$
- IF (NOT ZExitToDoors) AND NOT (ZOrigMsgFile$ = ZActiveMessageFile$ AND SubBoard) THEN _
- CALL AutoPage
- IF NOT SubBoard THEN _
- ZOrigUserFileIndex = ZUserFileIndex
- GOSUB 9440
- GOSUB 12991
- CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue)
- IF TurboLogon THEN _
- GOTO 819
- IF SkipWelcomeScreen AND _
- (ZUserSecLevel >= ZAllowCallerTurbo) THEN _
- GOTO 816
- IF NOT SameUser THEN _
- ZStopInterrupts = NOT ZWelcomeInterruptable : _
- ZBypassTimeCheck = ZTrue : _
- ZFileName$ = ZWelcomeFile$ : _
- ZDisplayAsUnit = ZTrue : _
- GOSUB 1790 : _
- ZDisplayAsUnit = ZFalse
- ZBypassTimeCheck = ZFalse
- ZStopInterrupts = ZTrue
- 816 IF NOT ZNewUser THEN _
- CALL QuickTPut1 (ZFG1$ +"Times on :" + STR$(ZTimesLoggedOn) + ZCrLf$ +_
- + ZFG2$ +"Last on was: " + PrevLastOn$ + ZEmphasizeOff$)
- 817 IF NOT ZRemindFileXfers OR ZNewUser THEN _
- GOTO 818
- CALL CheckRatio (ZFalse) 'Pe 01/03/90
- 818 IF INSTR(PrevUserName$,"SYSOP") THEN _
- GOTO 819
- IF ZActiveUserFile$ = ZOrigUserFile$ THEN _ 'Pe 02/11/89
- CALL QuickTPut ("Previous caller was: " + PrevUserName$ ,1)
- 819 CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue)
- IF ZRemindProfile THEN _
- GOSUB 5400 : _
- CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue)
- CALL Trim (ZWasCI$)
- GOSUB 5370
- IF ZWasA THEN _
- ZActiveUserName$ = "SYSOP"
- IF (ZNodeRecIndex < 2) THEN _
- GOTO 821
- GOSUB 4910
- GOSUB 24000
- GET 1,ZNodeRecIndex
- MID$(ZMsgRec$,1,31) = ZActiveUserName$ + _
- SPACE$(31 - LEN(ZActiveUserName$))
- MID$(ZMsgRec$,40,2) = " 0"
- MID$(ZMsgRec$,44,2) = STR$(ZBPS)
- MID$(ZMsgRec$,55,2) = " 0"
- MID$(ZMsgRec$,57,1) = "A"
- MID$(ZMsgRec$,60,5) = ZTalkToModemAt$ + _
- SPACE$(5 - LEN(ZTalkToModemAt$))
- MID$(ZMsgRec$,72,2) = " 0"
- MID$(ZMsgRec$,93,24) = ZWasCI$ + _
- SPACE$(24)
- PUT 1,ZNodeRecIndex
- GOSUB 12985
- 821 IF ZExitToDoors THEN _
- IF ZTransferFunction = 3 THEN _
- ZNewUser = ZTrue : _
- TurboLogon = ZFalse : _
- SameUser = ZFalse : _
- ZTransferFunction = 0 : _
- GOTO 832 _
- ELSE GOTO 832
- GOSUB 1241
- IF (SubBoard AND (ZOrigMsgFile$ = ZActiveMessageFile$)) _
- OR ((ZUserSecLevel > ZMaxRegSec) AND (NOT ZNewUser)) THEN _
- GOTO 832
- ZWasZ$ = ZRegProgram$
- ZTransferFunction = 3
- CALL DoorExit
- ZTransferFunction = 0
- GOTO 832
- '
- ' **** ESC PRESSED ON LOCAL CONSOLE ENTERS HERE ***
- '
- 822 LOCATE 24,1
- CALL TakeOffHook
- ZLocalUser = ZTrue
- ZSnoop = ZTrue
- ZSysop = ZTrue
- ZWaitBeforeDisconnect = 32400
- ZBPS = -6
- CALL CommInfo
- ' CALL Muzak (2)
- IF NOT ZEscapeInsecure THEN _
- GOTO 345
- ZActiveUserName$ = ZSysopPswd1$ + " " + ZSysopPswd2$
- ZFirstName$ = ZSysopPswd1$
- ZLastName$ = ZSysopPswd2$
- ZUserLogonTime! = TIMER
- ZTimeLoggedOn$ = TIME$
- ZLinesPrinted = 0
- GOTO 457
- 825 WasX = (ZMaxPerDay - ZMinsPerSession)
- WasX = -WasX * (WasX > 0) ' extra from daily max
- ZWasQ! = WasX + ZMinsPerSession + (ZMaxPerDay > 0) * ZElapsedTime
- IF ZWasQ! > ZMinsPerSession THEN _
- ZWasQ! = ZMinsPerSession
- ZSecsPerSession! = ZWasQ! * 60 + ZTimeCredits!
- RETURN
- 827 IF ZLastMsgRead > HighMsgNumber THEN _
- ZLastMsgRead = 0 : _
- MID$(ZUserOption$,3,2) = MKI$(0)
- RETURN
- 832 IF ZRestrictByDate AND ZDaysInRegPeriod > 0 THEN _
- IF ZRegDaysRemaining <= ZDaysToWarn AND _
- ZRegDaysRemaining > 0 THEN _
- CALL QuickTPut1 ("Registration EXPIRES in" + _
- STR$(ZRegDaysRemaining) + " days!") : _
- CALL BufFile(ZHelpPath$+"RGXPIRE"+ZHelpExtension$,WasX) : _
- IF NOT ZOK THEN CALL DelayTime (5)
- IF (NOT ZReqQuesAnswered) AND _
- ZReqQues$ <> "" THEN _
- ZFileName$ = ZReqQues$ : _
- ' GOSUB 11520 : _ ' Bh BETTER FIX THIS
- IF ZOK THEN _
- ZReqQuesAnswered = ZTrue
- 837 ZWasZ$ = ZActiveUserName$ + _
- " on at " + _
- ZCurDate$ + _
- ", " + _
- ZTime$ + _
- " from " + _
- ZWasCI$ + _
- ", " + _
- ZBaudParity$
- ZWasNG$ = ZWasZ$ + SPACE$(128 - LEN(ZWasZ$))
- MsgUserName$ = LEFT$(ZActiveUserName$+" ",22)
- '
- ' * ALWAYS RECORD THE HASH/INDIVIDUATING FIELD TO EACH RECORD LOGGED OUT
- '
- WasX$ = "{" + _
- HashValue$ + _
- "/" + _
- IndivValue$ + _
- "}"
- IF LEN(ZWasZ$) < 65 THEN _
- WasX = 65 _
- ELSE WasX = LEN(ZWasZ$) + 2
- MID$(ZWasNG$,WasX) = WasX$
- CALL Printit (" " + ZWasZ$)
- IF ZNewUser THEN _
- CALL UpdtCalr ("NEWUSER",1) 'Pe 02/04/90
- ' CALL Muzak (2)
- 842 GOSUB 825
- ZSysop = (ZUserSecLevel >= ZSysopSecLevel)
- GOSUB 12987
- IF SubBoard THEN _
- GOTO 850
- GOSUB 12986
- GOSUB 23000
- CallsToDate! = CallsToDate! + 1 + (ZSysop OR ZHasDoored)
- GOSUB 24000
- GOSUB 12985
- 850 ZSubParm = 2
- CALL Line25
- CALL SkipLine (1)
- IF TurboLogon THEN _
- ZBulletinSave$ = ZBulletinMenu$ : _
- GOSUB 9750 : _
- GOTO 900
- CALL CountNewFiles (BoardCheckDate$,ZMsgPtr(),LastNew,ZOutTxt$)
- IF ZNewUser OR LastNew < 1 OR NOT ZNewFilesCheck THEN _ 'Pe 01/02/90
- GOTO 852 'Pe 01/02/90
- IF ZFMSDirectory$ <> "" THEN _
- CALL QuickTPut1 (ZOutTxt$ + STR$(LastNew) + " NEW file(s) added to our " + ZConfName$ + " area") _ ' Bh
- ELSE GOTO 852
- WasL = LEN(ZDnldDrives$)
- SecNum = 19
- IF (NOT ZSkipFilesLogon) AND _
- ZUserSecLevel >= ZOptSec(SecNum) THEN _
- ZOutTxt$ = "Review new files to download ([Y],N)" : _
- GOSUB 12999 : _
- IF NOT ZNo THEN _
- ZLastIndex = 3 : _
- ZAnsIndex = 1 : _
- ZWasQ = 3 : _
- ZUserIn$(2) = MID$(BoardCheckDate$,1,2) + _
- MID$(BoardCheckDate$,4,2) + _
- MID$(BoardCheckDate$,7,2) : _
- ZWasY$ = ZUserIn$(3) : _
- CALL BreakFileName (ZFMSDirectory$,DR$,ZWasY$,WasX$,ZFalse) : _
- ZUserIn$(3) = ZWasY$ : _
- TimeLockExempt = ZTrue : _
- GOSUB 20185 : _
- ZLastIndex = 0 : _
- TimeLockExempt = ZFalse
- 852 ZStopInterrupts = ZFalse
- ZSysop = (ZUserSecLevel >= ZSysopSecLevel)
- IF ZUserSecLevel < ZOptSec (2) OR _
- ZActiveBulletins < 1 OR _
- ZSysop OR _
- SameUser THEN _
- GOTO 900
- IF ZBulletinMenu$ = ZBulletinSave$ THEN _
- GOTO 900
- ZBulletinSave$ = ZBulletinMenu$
- 855 CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue)
- IF ZBulletinsOptional AND NOT ZNewUser THEN _
- GOTO 856
- ZStopInterrupts = ZTrue
- ZNewUser = ZFalse
- GOSUB 9700
- IF ZNewUserDGS OR LEFT$(PrevLastOn$,8) <> ZCurDate$ THEN _ 'DGS-003
- ZUserLogonTime! = TIMER : _ 'DGS-003
- LSET ZLastDateTimeOn$ = ZCurDate$ +" "+ ZTimeLoggedOn$ : _ 'DGS-003
- ZSecsPerSession! = (ZMinsPerSession + ZElapsedTime) * 60 : _ 'DGS-003
- MinsRemaining = ZSecsPerSession! / 60 'DGS-003
- ZStopInterrupts = ZFalse
- GOTO 900
- 856 IF NOT ZCheckBulletLogon THEN _
- ZAnsIndex = 0 : _
- GOSUB 9760 : _
- GOTO 900
- CALL SkipLine (1)
- ZOutTxt$ = "Skip the NEWS ROOM Menu (Y,[N])" 'DGS-TXT ' Bh 091190
- ' STR$(ZActiveBulletins) + _ 'DGS-TXTMOD
- ' " bulletins (Y,[N])" 'DGS-TXTMOD
- GOSUB 12999
- IF ZYes THEN _
- GOTO 900
- 860 ZNewUser = ZFalse
- GOSUB 9700
- IF ZNewUserDGS OR LEFT$(PrevLastOn$,8) <> ZCurDate$ THEN _ 'DGS-003
- ZUserLogonTime! = TIMER : _ 'DGS-003
- LSET ZLastDateTimeOn$ = ZCurDate$ +" "+ ZTimeLoggedOn$ : _ 'DGS-003
- ZSecsPerSession! = (ZMinsPerSession + ZElapsedTime) * 60 : _ 'DGS-003
- MinsRemaining = ZSecsPerSession! / 60 'DGS-003
- 900 ZNewUser = ZFalse
- ActionFlag = (ZLogonMailLevel$ = "S")
- LogonMailNew = (ZLogonMailLevel$ = "N")
- GOSUB 1895
- IF ZActiveUserName$ = "SYSOP" AND NOT ZSysop THEN _
- ZActiveUserName$ = ZOrigUserName$
- LogonMailNew = ZFalse
- ZSubParm = 2
- CALL Line25
- ZSection$ = " "
- ZOutTxt$ = ""
- IF (NOT ZConfMode) AND (NOT SubBoard) AND NOT TurboLogon THEN _
- MailCheckConfirm = ZTrue : _
- ZNonStop = ZTrue : _
- GOSUB 5800
- MailCheckConfirm = ZFalse
- ZWasQ! = MinsInDoors * 60
- ZExitToDoors = ZFalse
- GOSUB 2350
- IF NOT ZPrivateDoor THEN _
- GOTO 955
- GOSUB 20165
- CALL SetSection
- ZPrivateDoor = ZFalse
- GOTO 1205
- 955 IF NOT TurboLogon THEN _
- GOSUB 4850 : _ 'pe 02/03/90
- IF STR$(ZLastMsgRead) < STR$(HighMsgNumber) AND ZUserSecLevel => MsgSec THEN _ 'Pe 01/29/89
- GOSUB 4275 'PEASKMAIL
- TurboLogon = ZFalse
- '
- ' * COMMAND PROCESSING
- '
- 1200 CLOSE 1
- GOSUB 1280
- 1205 IF ZSubParm < 0 THEN _
- GOTO 202
- ZSubParm = 1
- ZStopInterrupts = ZFalse
- ZNonStop = (ZPageLength < 1)
- ZWasQ = 0
- IF ZHomeConf$ <> "" AND ZHomeConf$ <> "MAIN" THEN 'DGS-TTMMOD
- TurboLogon = (NOT ConfMailJoin) 'DGS-TTMMOD
- ConfMailJoin = ZFalse 'DGS-TTMMOD
- IF LEFT$(ZHomeConf$,1) = "*" THEN 'DGS-TTM
- ZHomeConf$ = MID$(ZHomeConf$,2) 'DGS-TTM
- ZUserIn$(4) = ZHomeConf$ 'DGS-TTC
- TempCommStack$ = ZCommPortStack$ 'DGS-TTC
- FOR Count = 1 TO NumOfTC 'DGS-TTC
- CALL CheckMacro (ZUserIn$(Count+3),Found) 'DGS-TTC
- TempCommStack$ = (TempCommStack$ + _ 'DGS-TTC
- ZUserIn$(Count+3) + ZCarriageReturn$) 'DGS-TTC
- IF Found THEN 'DGS-TTC
- TempCommStack$ = (TempCommStack$ + ZWasY$) 'DGS-TTC
- END IF 'DGS-TTC
- NEXT Count 'DGS-TTC
- ZCommPortStack$ = TempCommStack$ 'DGS-TTC
- ZUserIn$(ZAnsIndex) = "" 'DGS-TTC
- ZHomeConf$ = "" 'DGS-TTM
- GOTO 1235 'DGS-TTM
- ELSE 'DGS-TTD
- IF LEFT$(ZHomeConf$,1) = "#" THEN 'DGS-TTD
- ZFF = 4 'DGS-TTD
- ZUserIn$(2) = MID$(ZHomeConf$,2) 'DGS-TTD'4
- ZHomeConf$ = "" 'DGS-TTD
- ZWasQ = 1 'DGS-TTD
- ZAnsIndex = 1 'dgs-ttdnew
- ZLastIndex = 2 'dgs-ttdnew
- GOTO 1240 'DGS-TTD
- ELSE ZFF = 8 'DGS-TTDMOD
- ZUserIn$(2) = ZHomeConf$ 'DGS-TTDMOD
- ZHomeConf$ = "" 'DGS-TTDMOD
- ZWasQ = 1 'DGS-TTDMOD'2
- ZAnsIndex = 1 'DGS-TTDMOD
- ZLastIndex = 2 'DGS-TTDMOD
- ZStoreParseAt = 1 'DGS-TTDMOD
- ZLastCommand$ = "MJ" 'DGS-TTDMod
- GOTO 1240 'DGS-TTDMOD
- END IF 'DGS-TTC
- END IF 'DGS-TTC
- END IF 'DGS-TTC
- CALL SkipLine (1)
- 1210 GOSUB 41000
- IF ZAnsIndex < ZLastIndex THEN _
- GOTO 1232
- ' CALL Talk (10,ZOutTxt$) 'Pe 02/03/90
- IF ZExpertUser THEN _
- GOTO 1230
- 1212 ZLinesPrinted = -ZMenusCanPause * ZLinesPrinted
- IF ZCustomPUI THEN _
- GOTO 1230
- IF ZSubSection < ZBegFile THEN _
- IF ZUserSecLevel >= ZSysopMenuSecLevel THEN _
- ZFileName$ = ZMenu$(1) : _
- GOSUB 43025
- ZFileName$ = ZMenu$(ZMenuIndex)
- ZDeleteInvalid = ZTrue
- GOSUB 43025
- ZDeleteInvalid = ZFalse
- 1230 CALL Line25
- CALL SkipLine (1)
- IF ZConfMode THEN _
- ZOutTxt$ = "The " + ZConfName$ : _ ' Bh 083190
- GOSUB 12979
- ' CALL Talk (65,ZConfName$) 'Pe 02/03/90
- IF ZMenuIndex = 6 THEN _
- ZSubParm = 1 : _
- ' CALL Library
- ' ** CHECK TO SEE IF THIS USER HAS BEEN PAGED ** 'CHT021301
- ' CALL CBCheck 'CHT021301
- ' CALL Talk (ZMenuIndex, ZOutTxt$) 'Pe 02/03/90
- 1232 IF ZCustomPUI THEN _
- CALL UserFace (ZUserGraphicDefault$) : _
- GOSUB 12997 : _
- GOTO 1235
- ZPossibleMacro = ZTrue
- MID$(ZLastCommand$,2,1) = " "
- CALL DispTimeRemain (MinsRemaining) 'Pe 02/03/90
- ZOutTxt$ = ZCmdPrompt$
- GOSUB 12930
- IF ZWasQ = 0 THEN _
- GOTO 1230
- 1235 ZWasZ$ = ZUserIn$(ZAnsIndex)
- IF ZWasZ$ = SPACE$(LEN(ZWasZ$)) THEN _
- GOTO 1230
- CALL SearchCmd (ZSubSection,ZFF)
- IF ZFF < 1 THEN _
- CALL QuickTPut1 ("Unknown command <"+ZWasZ$+">") : _
- CALL FlushKeys : _
- GOTO 1230
- ' CALL Talk (65,"OPTION "+ZWasZ$+" SELECTED") 'Pe 02/03/90
- 1240 IF ZUserSecLevel < ZOptSec(ZFF) THEN _
- ZViolation$ = ZSection$ + _
- " " + _
- ZWasZ$ : _
- GOSUB 1380 : _
- GOTO 1205
- IF ZFF > 39 THEN _
- ZDirExtension$ = ZLibDirExtension$ _
- ELSE ZDirExtension$ = ZMainDirExtension$
- CALL QuickTput (CHR$(12),1) 'Pe 02/01/90
- ON ZFF GOSUB _
- 1400, _ ' 1 A)nswer questionnaire 1
- 9700, _ ' 2 B)ulletins
- 1800, _ ' 3 C)omment to Sysop use 9801 for CH@ command 'Pe 02/28/90
- 10970, _ ' 4 D)oor (exit to)
- 2000, _ ' 5 E)nter a message
- 1275, _ ' 6 F)ile system (exit to)
- 1525, _ ' 7 I)nitial welcome redisplayed 'Pe 02/03/90
- 5300, _ ' 8 J)oin a conference
- 3900, _ ' 9 K)ill a message
- 4700, _ '10 O)perator page
- 1892, _ '11 P)ersonal mail (look for) 'Pe 02/03/90
- 4330, _ '12 R)ead messages
- 4340, _ '13 S)can message headers
- 4320, _ '14 T)ype ASCII FILE 'Pe 02/03/90
- 1285, _ '15 U)tilities (exit to)
- 5800, _ '16 V)iew a conference
- 9800, _ '17 W)ho's on other nodes displayed
- 1283, _ '18 @)Library (exit to) 18
- 20160, _ '19 D)ownload
- 10570, _ '20 G)oodbye
- 20155, _ '21 L)ist
- 20185, _ '22 N)ew
- 20180, _ '23 P)ersonal files
- 20175, _ '24 S)can
- 20170, _ '25 U)pload
- 20140, _ '26 V)iew ARC Contents
- 5500, _ '27 B)aud rate change 300==>450 1 'Pe 02/03/90
- 9099, _ '28 C)lock (time & time on) 'Pe 02/03/90 Change to BANKTIME
- 42850, _ '29 E)cho selection
- 42800, _ '30 F)ile transfer protocol
- 43000, _ '31 G)raphics
- 5200, _ '32 L)ines per page
- 10925, _ '33 M)essage margin
- 5110, _ '34 P)assword change
- 5450, _ '35 R)eview preferences 'Pe 02/03/90
- 4850, _ '36 S)tatistics displayed 'Pe 02/03/90
- 1500, _ '37 T)oggle
- 10090, _ '38 U)serlog displayed 12
- 30000, _ '39 A)rchive a Library disk 1
- 30100, _ '40 C)hange a Library disk
- 30200, _ '41 D)ownload Library files
- 10570, _ '42 G)oodbye
- 20155, _ '43 L)ist a Library directory
- 20175, _ '44 S)can a Library disk directory
- 20140, _ '45 V)iew arc contents 7
- 1325, _ '45 H)elp 1
- 1330, _ '46 ?)help
- 1250, _ '49 Q)uit
- 4240, _ '50 X)expert toggle on/off 4
- 10070, _ '51 1) List comments file 1
- 10090, _ '52 2) List callers file
- 10390, _ '53 3) Recover a message
- 10530, _ '54 4) Erase comments
- 11000, _ '55 5) User file maintenance
- 4130, _ '56 6) Toggle page bell on/off
- 10930 '57 7) Exit to DOS 2.x or above 7
- GOTO 1205
- '
- ' *** NEWS file scan ***
- '
- 1241 NewsDate# = VAL(MID$(BoardCheckDate$,4,2)) + _
- (100 * VAL(MID$(BoardCheckDate$,1,2))) + _
- (10000# * (1900 + VAL(MID$(BoardCheckDate$,7,2))))
- GOTO 1243
- 1242 NewsDate# = 0
- 1243 ZFileName$ = ZNewsFileName$
- CALL RBBSFind (ZFileName$,WasZ,WasY,ZMsgPtr,WasD)
- IF WasZ <> 0 THEN _
- RETURN
- FDate# = WasD + (100 * ZMsgPtr) + (10000# * (WasY + 1980))
- IF NewsDate# > FDate# THEN _
- RETURN
- IF TurboLogon THEN _
- CALL QuickTPut1("As it is written, There is none righteous, no, not one") : _
- RETURN
- ZStopInterrupts = ZFalse
- ZNonStop = (ZPageLength < 1)
- GOSUB 1790
- WasZ = 0
- RETURN
- '
- ' **** QUIT COMMAND (GLOBAL) ***
- '
- 1250 IF ZExpertUser THEN _
- ZOutTxt$ = ZQuitPromptExpert$ _
- ELSE ZOutTxt$ = ZQuitPromptNovice$
- ZStackC = ZTrue
- GOSUB 12930
- IF ZWasQ = 0 THEN _
- ZUserIn$(ZAnsIndex) = "M"
- ZWasZ$ = ZUserIn$(ZAnsIndex)
- CALL AllCaps (ZWasZ$)
- IF ZWasZ$ = "C" THEN _
- ZWasZ$ = "M" : _
- GOTO 5323
- IF ZWasZ$ <> SPACE$(LEN(ZWasZ$)) THEN _
- ON INSTR(ZQuitList$,ZWasZ$) GOTO 1275,1280,1285,10570,1283
- GOTO 1250
- 1275 ZMenuIndex = 3
- GOTO 1295
- 1280 ZMenuIndex = 2
- GOTO 1295
- 1283 ZMenuIndex = 6
- ZActiveFMSDir$ = ""
- GOTO 1295
- 1285 ZMenuIndex = 4
- 1295 CALL SetSection
- RETURN
- 1300 CALL QuickTPut1 (ZConfName$ + " Messages") ' Bh 091090
- RETURN
- '
- ' **** COMMON LOCAL DISPLAY PRINT ***
- '
- 1315 NumReturns = 1
- 1320 CALL LPrnt(WasD$,NumReturns)
- RETURN
- '
- ' ****** HELP (GLOBAL) ****
- '
- 1325 CALL ViewHelp (ZSubSection,ZUserGraphicDefault$, _
- MID$("MAINFILEUTILMAINLIBR",4 * ZMenuIndex - 7,4))
- IF ZSubParm = -1 THEN _
- RETURN 10595
- RETURN
- 1330 IF ZExpertUser THEN _
- RETURN 1212
- GOTO 1325
- '
- ' ***** RECORD SECURITY VIOLATIONS ****
- '
- 1380 CALL SecViolation
- IF NOT ZDenyAccess THEN _
- RETURN
- 1386 CALL DenyAccess
- GOTO 10620
- 1397 ZOutTxt$ = "Sorry, " + _
- ZFirstName$ + _
- ", " + _
- ZOutTxt$
- GOTO 12975
- '
- ' *** A - answer questionnaire
- '
- 1400 WasA1$ = ZAnsMenu$
- ' CALL Talk (13,ZOutTxt$) 'Pe 02/03/90
- ReturnToPrompt = (ZWasQ > 1)
- 1401 ZStackC = ZTrue
- CALL SubMenu ("Choose one, or L to display this menu again" + ZPressEnterExpert$, _
- WasA1$,ZQuesPath$,".DEF","",ZUserGraphicDefault$,ZTrue,ZFalse,ZTrue,"")
- IF ZWasQ = 0 THEN _
- RETURN
- IF ZSubParm = -1 THEN _
- RETURN 10595
- QuestHold$ = ZWasZ$
- GOSUB 11520 ' Bh BETTER FIX THIS
- CLOSE 2
- CALL UpdtCalr (QuestHold$ + " questionnaire " + _
- MID$("answeredaborted",1 - 8 * ZQuestAborted,8),2)
- IF ReturnToPrompt THEN _
- RETURN
- GOTO 1401
- '
- ' ***** Toggle COMMAND (UTILITIES) ****
- '
- 1500 IF ZAnsIndex < ZLastIndex THEN _
- GOTO 1510
- ZOutTxt$ = "A)utodwnld B)ullet C)ase F)ile H)ilite"
- CALL ColorPrompt (ZOutTxt$)
- CALL QuickTPut1 (ZOutTxt$)
- ZOutTxt$ = "L)ine feeds N)ulls T)urboKey X)pert !)bell"
- CALL ColorPrompt (ZOutTxt$)
- CALL QuickTPut1 (ZOutTxt$)
- ZOutTxt$ = "Toggle which options On/Off?" + ZPressEnter$
- 1510 GOSUB 12930
- IF ZWasQ = 0 THEN _
- RETURN
- ZWasZ$ = ZUserIn$(ZAnsIndex)
- CALL AllCaps (ZWasZ$)
- ZFF = INSTR("ABCFHLNTX!",ZWasZ$)
- IF ZFF < 1 THEN _
- GOTO 1500
- CALL Toggle (ZFF)
- GOSUB 12997
- GOTO 1500
- '
- ' **** I - COMMAND FROM MAIN MENU (DISPLAY INITIAL WELCOME) ***
- '
- '
- ' **** I - COMMAND FROM MAIN MENU (DISPLAY InitIAL WELCOME) ***
- '
- 1525 CALL SkipLine (2)
- CALL QuickTPut(ZFG1$+"Review System Screens Available:",1) ' Bh
- CALL QuickTPut(ZFG4$+"~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~",2)
- CALL QuickTPut(ZFG2$+"P)relog Screen",1)
- CALL QuickTPut(ZFG3$+"W)elcome Screen",1)
- CALL QuickTPut(ZFG4$+"L)atest News About " + ZRBBSName$,1) ' Bh 090890
- CALL QuickTPut(ZFG1$+"Y)our Access Level",1)
- CALL QuickTPut(ZFG2$+"N)ew User Sign-On",1)
- ZOutTxt$ = "Please make a Selection (or [RETURN] to quit) "
- ZSubParm = 1
- ZTurboKey = -ZTurboKeyUser
- CALL TGet
- CALL AllCaps (ZUserIn$)
- WasMplX = INSTR("PWLYNQ",ZUserIn$)
- IF ZUserIn$ = "" THEN _
- GOTO 1596
- ON WasMplX GOTO 1530,1533,1536,1539,1541,1596
- 1530 ZFileName$ = ZPreLog$
- GOTO 1550
- 1533 ZFileName$ = ZWelcomeFile$
- GOTO 1550
- 1536 ZFileName$ = ZWelcomeFileDrvPath$ + "LATEST.NWS" ' Bh 090890
- GOTO 1550
- 1539 GOSUB 465
- GOTO 1525
- 1541 ZFileName$ = ZNewUserFile$
- 1550 GOSUB 1790
- CALL AskMore ("",ZTrue,ZFalse,WasX,ZTrue)
- GOTO 1525
- 1596 RETURN
- '
- 1790 CALL Graphic (ZUserGraphicDefault$,ZFileName$)
- CALL BufFile (ZFileName$,WasX)
- CALL Carrier
- IF ZSubParm = -1 THEN _
- RETURN 10595
- RETURN
- '
- ' *** C - COMMAND FROM MAIN MENU (LEAVE COMMENT FOR SYSOP) **
- '
- 1800 MsgTo$ = "SYSOP"
- OrigSubject$ = "COMMENT"
- GOSUB 1893
- IF (ActiveMessages >= MaxMsgs OR _
- ((NOT ZMsgsCanGrow) AND _
- (ZNextMsgRec + 5 > HighestMsgRecord)) OR _
- NOT ZCmntsAsMsgs ) THEN _
- ZOutTxt$ = "Would you like to leave a comment for the Sysop? (Y/[N])" : _ ' Bh
- GOSUB 12999 : _
- IF NOT ZYes THEN _
- CALL SkipLine (1) : _
- RETURN _
- ELSE ZSysopComment = ZTrue : _
- GOTO 2007
- ZSysopComment = ZFalse
- SysopMsg = ZTrue
- ZMsgHeader$ = "comment"
- MsgFrom$ = ZActiveUserName$
- GOTO 2010
- 1850 WasBX = &H3
- ZWasEN$ = ZCmntsFile$
- GOSUB 12992
- CALL OpenWorkA (ZCmntsFile$)
- ZOutTxt$ = ZFirstName$ + _
- ", Thanks for comments!"
- GOSUB 12976
- CALL AMorPM
- CALL PrintWorkA (ZActiveUserName$+" "+ZCurDate$+" "+ZTime$+" Node "+ZNodeID$)
- FOR WasX = 1 TO ZLinesInMsg
- CALL PrintWorkA (ZOutTxt$(WasX))
- NEXT
- CALL PrintWorkA (ZCarriageReturn$)
- CLOSE 2
- IF ZErrCode <> 0 THEN _
- ZWasEL = 1850 : _
- GOTO 13000
- WasBX = &H3
- ZWasEN$ = ZCmntsFile$
- GOSUB 12993
- CALL UpdtCalr ("Left comment",1)
- REDIM ZOutTxt$(ZMsgDim)
- IF LogOff$ = "G" THEN 10562 ' Pe 02/03/90
- RETURN
- '
- ' **** P - COMMAND FROM MAIN MENU (DISPLAY PERSONAL MAIL) ****
- '
- 1892 GOSUB 1900 'Pe 02/11/89
- CALL AskMore ("",ZTrue,ZFalse,WasX,ZTrue) 'Pe 02/11/89
- RETURN 'Pe 02/11/89
- 1893 ActionFlag = ZTrue
- GOTO 1897
- 1895 IF TurboLogon THEN _
- RETURN
- ZUserIn$(0) = LEFT$("NEW ",-4*LogonMailNew)
- 1897 IF ZActiveMessageFile$ = ZPrevBase$ THEN _
- ActionFlag = ZFalse : _
- RETURN
- 1900 GOSUB 5344
- IF ZPrivateDoor THEN _
- ActionFlag = ZTrue
- ZPrevBase$ = ZActiveMessageFile$
- ShowActive = ZFalse
- IF NOT ActionFlag THEN _
- CALL QuickTPut ("Checking messages in " + ConfFileName$,0) : _
- ShowActive = ZTrue _
- ELSE CALL QuickTPut ("Loading messages",0)
- WasA1$ = "" 'KG030801
- MsgCt = 0
- MsgsFromUser = ZFalse
- ActiveMessages = 0
- MailReported = ActionFlag
- FirstOld = ZTrue
- GOSUB 23000
- MsgRec = FirstMsgRecord
- MaxMsgs = VAL(MID$(ZMsgRec$,89,7))
- IF MaxMsgs > WasMM THEN _
- MaxMsgs = WasMM
- REDIM ZMsgPtr(MaxMsgs,2)
- NumDots = 0
- 1905 GET 1,MsgRec
- CALL CheckInt (MID$(ZMsgRec$,117,4))
- IF ZErrCode <> 0 THEN _
- ZWasEL = 1905 : _
- GOTO 13000
- NumRecsInMsg = VAL(MID$(ZMsgRec$,117,4))
- IF NumRecsInMsg < 1 THEN _
- NumRecsInMsg = 1
- 1906 IF ActionFlag OR (FirstOld AND NOT MailReported) THEN _
- CALL MarkTime (NumDots)
- CALL Carrier
- IF ZSubParm = -1 THEN _
- RETURN 10595
- 1910 IF MsgRec >= ZNextMsgRec THEN _
- LowMsgNumber = ZMsgPtr(1,2) : _
- GOTO 1950
- 1915 IF MID$(ZMsgRec$,116,1) <> ZActiveMessage$ THEN _
- GOTO 1946
- WasX$ = MID$(ZMsgRec$,121,2)
- IF WasX$ <> " " THEN _
- IF CVI(WasX$) > ZUserSecLevel THEN _
- GOTO 1945
- IF ActionFlag THEN _
- GOTO 1935
- '
- ' ** ALLOW USERS WITH NAMES LONGER THAN 22 CHARS TO RECEIVE PRIVATE MAIL *
- '
- 1920 GOSUB 4660
- IF NOT UserInHeader THEN _
- GOTO 1945
- IF MsgToCaller THEN _
- GOTO 1925
- GOTO 1940
- 1925 ZWasA = VAL(MID$(ZMsgRec$,2,4))
- IF LogonMailNew THEN _
- IF ZWasA <= ZLastMsgRead THEN _
- GOTO 1935
- IF NOT ShowActive THEN _
- GOTO 1930
- MailReported = ZTrue
- FirstNew = (ZWasA > ZLastMsgRead)
- IF FirstNew THEN _
- MsgCt = 0 : _ ' KG030203
- CALL SkipLine (1) : _
- CALL QuickTPut1 (CHR$(7)+"NEW Mail for YOU (* = Private)") _ ' Bh
- ELSE IF FirstOld THEN _
- CALL SkipLine (1) : _
- CALL QuickTPut1 ("OLD Mail for YOU (* = Private)") : _
- FirstOld = ZFalse
- ShowActive = NOT FirstNew
- 1930 CALL QuickTPut (LEFT$(ZMsgRec$,5),0)
- MsgCt = MsgCt + 1 ' KG030203
- IF MsgCt MOD 15 = 0 THEN _ ' KG030203
- CALL SkipLine (1) : _ ' KG030203
- CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue) ' KG030203
- 1935 IF NOT MsgFromCaller THEN _
- GOTO 1945
- 1940 IF MsgsFromUser < ZMsgDim THEN _
- MsgsFromUser = MsgsFromUser + 1 : _
- WasA1$ = WasA1$ + LEFT$(ZMsgRec$,5) ' KG030801
- 1945 ActiveMessages = ActiveMessages + 1
- ZMsgPtr(ActiveMessages,1) = MsgRec
- ZMsgPtr(ActiveMessages,2) = VAL(MID$(ZMsgRec$,2,4))
- 1946 MsgRec = MsgRec + NumRecsInMsg
- GOTO 1905
- 1950 IF NOT MailReported THEN _
- ZOutTxt$ = "Sorry, " + _
- ZFirstName$ + _
- ", No " + ZUserIn$(0) + "Mail for you" : _
- GOSUB 12975
- IF MsgsFromUser = 0 OR NOT ZMsgReminder THEN _
- GOTO 1961
- IF ActionFlag THEN _
- GOTO 1961
- ZOutTxt$ = "Mail you left"
- GOSUB 12976
- 1960 WasK = 1
- FOR MsgCt = 1 TO MsgsFromUser ' KG030203
- ZOutTxt$ = MID$(WasA1$,WasK,5) ' KG030801
- WasK = WasK + 5
- GOSUB 12978
- IF MsgCt MOD 15 = 0 THEN _ ' KG030203
- CALL SkipLine (1) : _ ' KG030203
- CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue) ' KG030203
- NEXT
- WasA1$ = "" ' KG030203
- CALL SkipLine (1)
- CALL QuickTPut1 ("Please K)ill old/unneeded msgs")
- 1961 ActionFlag = ZFalse
- CALL SkipLine (1)
- RETURN
- '
- ' **** E - COMMAND FROM MAIN MENU (ENTER MESSAGE) ***
- '
- 2000 QuotedReply = ZFalse
- MsgFrom$ = ZActiveUserName$
- 2001 IF (LowMsgNumber > 0 AND ActiveMessages = MaxMsgs) _
- OR HighMsgNumber >= 9999 THEN _
- IF ZActiveMessageFile$ = ZMainMsgFile$ AND _
- ActiveMessages = 1 THEN _
- GOTO 5300 _
- ELSE ZOutTxt$ = "No more messages allowed! Try tomorrow" : _
- GOSUB 12975 : _
- GOTO 3650
- 2006 IF NOT (ZReply OR MsgFwd) THEN _
- MsgPswd$ = ""
- ZSysopComment = ZFalse
- IF ZReply OR MsgFwd THEN SaveAnsIndex = ZAnsIndex
- IF MsgFwd OR NOT ZReply THEN MsgTo$ = ""
- 2007 IF ZSysopComment THEN _
- ZWasZ$ = ZCmntsFile$ : _
- ZMsgHeader$ = "comment" _
- ELSE ZWasZ$ = ZActiveMessageFile$ : _
- ZMsgHeader$ = "message"
- 2008 IF ZSysopComment OR ZMsgsCanGrow THEN _
- ZWasY$ = "on disk" : _
- CALL FindFree : _
- GOTO 2009
- IF ZNextMsgRec + 3 < HighestMsgRecord THEN _
- GOTO 2010
- ZWasY$ = "in file"
- ZFreeSpace$ = "1"
- 2009 IF VAL(ZFreeSpace$) >= 2000 THEN _
- GOTO 2010
- ZOutTxt$ = "No room " + ZWasY$ + " for " + ZMsgHeader$
- GOSUB 12979
- GOTO 3650
- 2010 IF NOT QuotedReply THEN _
- ZLinesInMsg = 0 : _
- ZCommPortStack$ = "" : _
- WasL = 0 : _
- WasX = 0 : _
- REDIM ZOutTxt$(ZMsgDim)
- IF ZGetExtDesc THEN _
- GOTO 2100
- GOSUB 1893
- RcvrRecNum = 0
- 2020 CALL MessageTo (HighestUserRecord,MsgTo$,MsgFrom$,RcvrRecNum,Found)
- IF MsgTo$ = "" THEN _
- RETURN
- IF ZSysopComment THEN _
- GOTO 2100
- IF SysopMsg THEN _
- SysopMsg = ZFalse : _
- MsgPswd$ = "^READ^" : _
- GOTO 2100
- IF ZReply OR MsgFwd THEN _
- Found = ZTrue : _
- CALL Trim (MsgTo$): _
- GOTO 2035 _
- ELSE Subject$ = ""
- GOSUB 2065
- 2035 CALL MsgProt (MsgTo$,Found,MsgPswd$)
- IF MsgPswd$ = "" THEN _
- GOTO 2020
- IF QuotedReply THEN _
- RETURN
- GOTO 2100
- '
- ' ***** SET/CHANGE SUBJECT FOR A MESSAGE ***
- '
- 2065 IF Subject$ <> "" THEN _
- ZOutTxt$ = "Change Subject from " + _
- Subject$ + _
- " to" : _
- GOSUB 12932 _
- ELSE ZOutTxt$ = "Subject" : _
- ZParseOff = ZTrue : _
- GOSUB 12932
- IF LEN(ZUserIn$) > 25 THEN _
- ZOutTxt$ = "25 Char. Max" : _
- GOSUB 12979 : _
- GOTO 2065
- IF ZWasQ = 0 THEN _
- IF Subject$ <> "" THEN _
- RETURN _
- ELSE GOSUB 2435 : _
- IF ZYes THEN _
- RETURN 5160 _
- ELSE GOTO 2065
- Subject$ = ZUserIn$
- CALL AllCaps (Subject$)
- OrigSubject$ = Subject$
- RETURN
- '
- ' ***** ENTER MAIN BODY OF MESSAGE ****
- '
- '
- '* ------[ first line different ]------
- '2100 GOSUB 2101 'ANSIEd
- ' IF NOT ZYes THEN _
- ' GOTO 2120
- ' GOTO 2110
- ''* INSERTING new line(s)
- '2101 IF NOT ZGetExtDesc THEN 'Pe 03/14/90
- ' ZOutTxt$ = "Use the Full Screen Editor (Y,[N])"
- ' GOSUB 12930
- ' END IF
- ' RETURN
- '2110 CALL Ansied
- ' I = ZSubParm
- ' CALL SkipLine(1)
- ' IF I = -2 THEN ' Sleep Disconnect
- ' GOTO 10590
- ' ELSEIF I = -1 THEN ' Lost Carrier
- ' GOTO 10595
- ' ELSEIF I = 1 THEN ' Save Message
- ' GOTO 3400
- ' ELSEIF I = 2 THEN ' Abort Message
- ' GOTO 2430
- ' END IF 'End of AnsiEd additions
- 2100 ZOutTxt$ = "Type " + _ 'Was 2100 in 17.3 ' Still is Bh 110790
- ZMsgHeader$ + _
- STR$(ZMaxMsgLines) + _
- " lines max" + _
- ZPressEnter$
- GOSUB 12975
- GOSUB 3200
- 2125 ZLinesInMsg = ZLinesInMsg + 1
- 2127 IF ZRemoteEcho OR ZLocalUser THEN _
- ZOutTxt$ = RIGHT$(STR$(ZLinesInMsg),2) + _
- ": " + _
- ZOutTxt$(ZLinesInMsg) _
- ELSE ZOutTxt$ = ZOutTxt$(ZLinesInMsg)
- GOSUB 12978
- CALL LineEdit(ZLinesInMsg,ZRightMargin + 1)
- IF ZWaitExpired THEN _
- GOTO 10590 _
- ELSE IF ZSubParm = -1 THEN _
- GOTO 10595
- CALL FindFKey
- IF ZSubParm < 0 THEN _
- GOTO 202
- IF ZOutTxt$(ZLinesInMsg) = "" THEN _
- ZLinesInMsg = ZLinesInMsg - 1 : _
- GOTO 2300
- 2140 WasJ = ZLinesInMsg
- GOSUB 2200
- IF WasX THEN _
- GOTO 2300
- GOTO 2125
- 2200 WasX = 0
- IF WasJ < (ZMaxMsgLines - 2) THEN _
- RETURN
- ZOutTxt$ = MID$("2 lines leftLast line Full",12 * (WasJ-(ZMaxMsgLines - 2)) + 1,12)
- WasX = (WasJ > (ZMaxMsgLines - 1))
- 2210 GOSUB 12979
- RETURN
- '
- ' ***** FINAL MESSAGE DISPOSITION ****
- '
- 2300 IF NOT ZExpertUser THEN _
- CALL QuickTPut1 (ZCrLf$ +"A)bort," + LEFT$("B)tch Import,",-13 * (ZSysop OR ZLocalUser)) + "C)ont,D)el,E)dit,I)nsert,L)ist,M)argin,R)ev subj,S)ave")
- 2315 ZOutTxt$ = ZCrLf$ +"Edit Sub-function <A," + _
- LEFT$("B,",-2 * (ZSysop OR ZLocalUser)) + _
- "C,D,E,I,L,M,R,S,?>"
- CALL SkipLine (1)
- GOSUB 12930
- IF ZWasQ = 0 THEN _
- GOTO 2315
- CALL AllCaps (ZUserIn$(ZAnsIndex))
- ZWasZ$ = ZUserIn$(ZAnsIndex)
- 2330 ON INSTR("ABCDEILMRS?",ZWasZ$) GOTO 2400,2335,2332,2500,2600,2800,3000,3100,2440,3400,2345
- GOTO 2300
- 2332 IF ZLinesInMsg < 1 THEN _
- ZLinesInMsg = 1
- GOTO 2127
- 2335 WasX = ZLinesInMsg
- CALL MsgImport (ZMaxMsgLines,ZRightMargin,ZLinesInMsg,ZOutTxt$())
- IF ZLinesInMsg > WasX THEN _
- GOTO 3000 _
- ELSE GOTO 2300
- '
- ' ***** DISPLAY MESSAGE SUBCOMMANDS HELP FILE ****
- '
- 2345 ZFileName$ = ZHelp$(4)
- GOSUB 1790
- GOTO 2315
- 2350 CALL FindIt (ZMainPUI$)
- ZCustomPUI = ZOK
- IF ZOK THEN _
- ZCurPUI$ = ZMainPUI$ _
- ELSE ZCurPUI$ = ""
- ' ZPrevPUI$ = "" 'ANSIEd ' Bh 110790
- RETURN
- '
- ' **** ABORT MESSAGE ***
- '
- 2400 GOSUB 2435
- IF NOT ZYes THEN _
- GOTO 2300
- 2430 ZOutTxt$ = "Aborted"
- GOSUB 12975
- ZABort = 1 'Pe 02/03/90
- GOTO 3650
- 2435 ZOutTxt$ = "Abort " + _
- ZMsgHeader$ + _
- " (Y/[N])"
- GOSUB 12995
- RETURN
- '
- ' ***** CHANGE SUBJECT OF A MESSAGE ****
- '
- 2440 GOSUB 2065
- GOTO 2300
- '
- ' ***** (BLOCK) DELETE MESSAGE LINE(S) *****
- '
- 2500 ZOutTxt$ = "Delete from"
- GOSUB 3300
- Mark1 = ZTestedIntValue
- 2520 ZOutTxt$ = "Up to and including Line # (ENTER =" + STR$(Mark1) + " )"
- GOSUB 3302
- IF ZWasQ = 0 THEN _
- Mark2 = Mark1 _
- ELSE Mark2 = ZTestedIntValue
- CALL SkipLine(1)
- IF Mark1 > Mark2 THEN _
- ZOutTxt$ = "Begining exceeds End. Block NOT deleted!" : _
- GOSUB 12979 : _
- GOTO 2555
- IF Mark1 <= MsgLockLines THEN _
- ZOutTxt$ = "You can NOT delete lines 1 -" + STR$(MsgLockLines) + "!" : _ ' DA120801
- GOSUB 12979 : _
- GOTO 2555
- 2522 FOR WasX = Mark1 TO Mark2
- CALL AskMore ("",ZTrue,ZTrue,WasXX,ZFalse)
- IF ZNo OR ZRet THEN _
- WasX = Mark2 + 1 _
- ELSE ZOutTxt$ = ZOutTxt$(WasX) : _
- GOSUB 12977
- NEXT
- CALL SkipLine(1)
- 2530 ZOutTxt$ = "Delete lines " + STR$(Mark1) + "-" + MID$(STR$(Mark2),2) + " (Y/[N])"
- GOSUB 12930
- IF NOT ZYes THEN _
- ZOutTxt$ = "NOT Deleted" : _
- GOSUB 12979 : _
- GOTO 2555
- 2550 ZBlockSize = (Mark2 - Mark1) + 1
- EndOfBuffer = ZLinesInMsg + 1
- ZLinesInMsg = ZLinesInMsg - ZBlockSize
- FOR WasX = Mark1 TO ZLinesInMsg
- ZOutTxt$(WasX) = ZOutTxt$(WasX + ZBlockSize)
- NEXT
- FOR WasX = (ZLinesInMsg + 1) TO (EndOfBuffer)
- ZOutTxt$(WasX) = ""
- NEXT
- ZOutTxt$ = "Deleted" + STR$(ZBlockSize) + " line(s)"
- GOSUB 12979
- 2555 Mark1 = 0
- Mark2 = 0
- GOTO 2300
- '
- ' **** EDIT MESSAGE LINE ***
- '
- 2600 ZOutTxt$ = "Edit"
- GOSUB 3300
- IF ZTestedIntValue <= MsgLockLines THEN _
- ZOutTxt$ = "Not permitted to change first" + _
- STR$(MsgLockLines) + " line(s)" : _
- GOSUB 12979 : _
- GOTO 2300
- CALL EditALine (ZTestedIntValue)
- IF ZSubParm < 0 THEN _
- GOTO 202
- GOTO 2300
- 2800 IF ZLinesInMsg >= ZMaxMsgLines AND NOT ZSysop THEN _
- ZOutTxt$ = "Message full" : _
- GOSUB 12979 : _
- GOTO 2300
- 2820 ZOutTxt$ = "Insert Before" : _
- GOSUB 3300
- 2830 WasLL = ZLinesInMsg
- WasK = ZLinesInMsg - ZTestedIntValue
- FOR WasX = ZTestedIntValue TO ZLinesInMsg
- ZUserIn$(WasX + 1 - ZTestedIntValue) = ZOutTxt$(WasX)
- ZOutTxt$(WasX) = ""
- NEXT
- ZLinesInMsg = ZTestedIntValue
- 2840 ZOutTxt$ = RIGHT$(STR$(ZLinesInMsg),2) + _
- ": " + ZOutTxt$(ZLinesInMsg)
- GOSUB 12978
- CALL LineEdit(ZLinesInMsg,ZRightMargin + 1)
- IF ZOutTxt$(ZLinesInMsg) = "" THEN _
- GOTO 2920
- 2870 ZLinesInMsg = ZLinesInMsg + 1
- WasJ = ZLinesInMsg + WasK - 1
- GOSUB 2200
- IF NOT WasX THEN _
- GOTO 2840
- 2920 FOR WasX = 1 TO WasK + 1
- ZOutTxt$(ZLinesInMsg + WasX - 1) = ZUserIn$(WasX)
- NEXT
- REDIM ZUserIn$(ZMsgDim)
- ZLinesInMsg = WasLL + ZLinesInMsg - ZTestedIntValue
- GOTO 2300
- '
- ' ***** LIST MESSAGE CONTENTS ****
- '
- 3000 GOSUB 3010
- GOTO 2300
- 3010 ZStopInterrupts = ZFalse
- CALL SkipLine (1)
- IF ZWasQ = 1 OR MsgFwd THEN _
- WasL = 1 : _
- ZOutTxt$ = ZFG3$ + "To: " + _
- MsgTo$ + _
- ZFG4$ + " Re: " + _
- Subject$ + ZEmphasizeOff$ : _
- GOSUB 12979 : _
- CALL QuickTPut (MID$(" ",1,-4 * (NOT ZRemoteEcho)),0) : _
- GOSUB 3200
- 3020 FOR WasX = WasL TO ZLinesInMsg
- CALL AskMore ("",ZTrue,ZTrue,WasXX,ZFalse)
- IF ZNo OR ZRet THEN _
- WasX = ZLinesInMsg + 1 _
- ELSE ZOutTxt$ = RIGHT$(STR$(WasX),2) + _
- ": " + _
- ZOutTxt$(WasX) : _
- GOSUB 12979
- NEXT
- RETURN
- '
- ' ***** CHANGE MARGIN WIDTH ****
- '
- 3100 CALL SkipLine (1)
- ZOutTxt$ = "SET Right-Margin from" + _
- STR$(ZRightMargin) + _
- " TO (8...72)"
- GOSUB 12932
- IF LEN(ZUserIn$(ZAnsIndex)) > 2 THEN _
- GOTO 3140
- 3130 WasX = VAL(ZUserIn$(ZAnsIndex))
- IF WasX > 7 AND WasX < 73 THEN _
- ZRightMargin = WasX : _
- ZOutTxt$ = "Margin now" + _
- STR$(ZRightMargin) : _
- GOTO 3150
- 3140 ZOutTxt$ = "Invalid - Margin UNCHANGED"
- 3150 GOSUB 12979
- IF UtilMarginChange THEN _
- RETURN
- GOTO 2300
- 3200 ZOutTxt$ = "[" + _
- STRING$(ZRightMargin - 2,45) + _
- "]"
- IF ZRemoteEcho OR ZLocalUser THEN _
- ZOutTxt$ = " " + _
- ZOutTxt$
- GOSUB 12975
- RETURN
- 3300 ZOutTxt$ = ZOutTxt$ + " Line #" + ZPressEnter$
- 3302 CALL SkipLine (-(ZAnsIndex >= ZLastIndex))
- GOSUB 12932
- IF ZWasQ = 0 THEN _
- IF Mark1 = 0 THEN _
- RETURN 2300 _
- ELSE RETURN
- CALL CheckInt (ZUserIn$(ZAnsIndex))
- IF ZErrCode = 0 THEN _
- IF ZTestedIntValue >= 1 THEN _
- IF ZTestedIntValue <= ZLinesInMsg THEN _
- RETURN
- ZOutTxt$ = "No such line #" + STR$(ZTestedIntValue)
- GOSUB 12979
- RETURN 2300
- '
- ' **** SAVE MESSAGE ***
- '
- 3400 IF ZGetExtDesc THEN _
- ZSysopComment = ZFalse : _
- RETURN
- IF ZSysopComment THEN _
- ZSysopComment = ZFalse : _
- GOTO 1850
- 3405 GOSUB 4910
- MsgRecSave$ = ZMsgRec$
- MsgCorrected = ZFalse
- GOSUB 23100
- ZOutTxt$ = "Adding new msg #" + _
- STR$(HighMsgNumber + 1)
- IF NOT ZLocalUser THEN _
- CALL UpdtCalr (ZOutTxt$,1)
- GOSUB 12978
- ZWasSL = 0
- ZWasN$ = ""
- ZLastIndex = 0
- IF LowMsgNumber = 0 THEN _
- LowMsgNumber = 1 : _
- HighMsgNumber = 1 _
- ELSE HighMsgNumber = HighMsgNumber + 1
- 3410 ActiveMessages = ActiveMessages + 1
- MsgNum$ = STR$(HighMsgNumber) + _
- SPACE$(5 - LEN(STR$(HighMsgNumber)))
- IF MsgPswd$ = "^READ^" THEN _
- MID$(MsgNum$,1,1) = "*" : _
- SecForMsg = ZPrivateReadSec _
- ELSE SecForMsg = ZPublicReadSec
- 3460 IF NOT MsgFwd THEN _
- MsgFrom$ = LEFT$(ZActiveUserName$ + SPACE$(31),31) _
- ELSE _
- MsgFrom$ = LEFT$(MsgFrom$ + SPACE$(31),31)
- MsgTo$ = LEFT$(MsgTo$ + SPACE$(31),31)
- MID$(MsgTo$,23,8) = TIME$
- Subject$ = LEFT$(OrigSubject$ + SPACE$(25),25)
- MsgPswd$ = LEFT$(MsgPswd$ + SPACE$(15),15)
- IF QuotedReply AND _
- ZLinesInMsg > ZMaxMsgLines THEN _
- ZLinesInMsg = ZMaxMsgLines
- FOR WasJ = 1 TO ZLinesInMsg
- ZOutTxt$(WasJ) = ZOutTxt$(WasJ) + _
- CHR$(227)
- ZWasSL = ZWasSL + LEN(ZOutTxt$(WasJ))
- NEXT
- IF ZWasSL MOD 128 = 0 THEN _
- ZWasN$ = STR$(ZWasSL \ 128 + 1) _
- ELSE ZWasN$ = STR$(ZWasSL \ 128 + 2)
- 3530 Temp = ZNextMsgRec
- ZNextMsgRec = Temp + VAL(ZWasN$)
- LSET ZMsgRec$ = MsgRecSave$
- GOSUB 24000
- GET 1,Temp
- ZMsgPtr(ActiveMessages,1) = Temp
- ZMsgPtr(ActiveMessages,2) = HighMsgNumber
- LSET ZMsgRec$ = MsgNum$ + _
- MsgFrom$ + _
- MsgTo$ + _
- ZCurDate$ + _
- Subject$ + _
- MsgPswd$ + _
- ZActiveMessage$ + _
- ZWasN$ + _
- SPACE$(4 - LEN(ZWasN$)) + _
- MKI$(SecForMsg)
- PUT 1,Temp
- ZWasN$ = ""
- NumDots = 0
- FOR WasJ = 1 TO ZLinesInMsg
- CALL MarkTime (NumDots)
- ZWasN$ = ZWasN$ + _
- ZOutTxt$(WasJ)
- IF LEN(ZWasN$) > 127 THEN _
- LSET ZMsgRec$ = ZWasN$ : _
- PUT 1 : _
- ZWasN$ = MID$(ZWasN$,129)
- 3630 NEXT
- IF LEN(ZWasN$) > 0 THEN _
- LSET ZMsgRec$ = ZWasN$ : _
- PUT 1
- REDIM ZOutTxt$(ZMsgDim)
- IF MsgCorrected THEN _
- MsgCorrected = ZFalse : _
- ActionFlag = ZTrue : _
- CALL SkipLine (1) : _
- GOSUB 1900
- 3640 CALL SkipLine (1)
- GET 1,1
- GOSUB 12985
- ' ---[ notify receiver that has new mail waiting ]---
- IF RcvrRecNum > 0 THEN _
- UserFileIndexSave = ZUserFileIndex : _
- UserRecordHold$ = ZUserRecord$ : _
- ZUserFileIndex = RcvrRecNum : _
- GOSUB 12989 : _
- GET 5, RcvrRecNum : _
- WasX = CVI(MID$(ZUserRecord$,57,2)) : _
- MID$(ZUserRecord$,57,2) = MKI$(WasX OR 512) : _
- PUT 5, RcvrRecNum : _
- GOSUB 12991 : _
- ZUserFileIndex = UserFileIndexSave : _
- LSET ZUserRecord$ = UserRecordHold$ : _
- CALL QuickTPut1 ("Receiver will be notified of new mail") : _
- RcvrRecNum = 0
- 3650 QuotedReply = ZFalse
- '************************ MESSAGE THREAD *****************
- IF ZReply AND ZAbort = 0 THEN _ 'Pe 02/03/90
- CALL THREAD1(HighMsgNumber,CurMsg,ZConfName$)
- ZAbort = 0
- '*********************************************************
- MsgLockLines = 0
- IF ZReply OR MsgFwd THEN _
- ZReply = ZFalse : _
- ZAnsIndex = SaveAnsIndex : _
- GOTO 5344
- IF ZGetExtDesc THEN _
- ZLinesInMsg = 0 : _
- RETURN
- If LogOff$ = "G" Then 10562 'Pe 02/03/90
- RETURN 1200
- '
- ' **** K - COMMAND FROM MAIN MENU (KILL MESSAGE) ***
- '
- 3900 ZKillMessage = ZFalse
- CALL SkipLine (1)
- 3930 ZOutTxt$ = "Msg #(s) to Kill" + ZPressEnterExpert$
- GOSUB 12932
- IF ZWasQ = 0 THEN _
- RETURN
- GOSUB 1893
- 3935 CALL CheckInt (ZUserIn$(ZAnsIndex))
- IF ZErrCode <> 0 THEN _
- GOTO 3930
- MsgToKill = ZTestedIntValue
- 3950 GOSUB 5344
- CALL KillMsg (MsgToKill,ActiveMessages,ZconfName$) 'Pe 02/03/90
- 4040 IF ZKillMessage THEN _
- RETURN
- GOTO 3930
- '
- ' **** Sysop Available toggle
- '
- 4130 ZSubParm = -8
- CALL FindFKey
- ZSubParm = 0
- RETURN
- '
- ' **** X)pert Toggle
- '
- 4240 CALL Toggle(9)
- RETURN
- ' ****************************************************************************
- ' * Ask users who have NOT Read all new messages do they want to NOW! *
- ' * Carrage Return Defaults to [Y]es *
- ' ****************************************************************************
- 4275 ZOutTxt$ = "There are New Message since last call, Read them now ? ([Y]/N) "
- GOSUB 12999 'JABASKMAIL
- 4279 IF NOT ZNO THEN _ 'JABASKMAIL
- ZLastIndex = 2 : _ 'Pe 11/05/89
- ZAnsIndex = 1 : _ 'Pe 11/05/89
- ZWasQ = 2 : _ 'Pe 11/05/89
- ZUserIn$(2) = "*" :_ 'Pe 11/05/89
- GOTO 4330 'Pe 11/05/89
- RETURN 'JABASKMAIL
- '
- '
- '**** T)ype ASCII file ***** Pe/10/22/89
- '
- 4320 ZLastIndex = Q
- ZAnsIndex = 1
- CALL TypeFile
- RETURN
-
- '
- ' **** R - COMMAND FROM MAIN MENU (READ MESSAGES) ****
- '
- 4330 QuickScanMsgs = ZFalse
- ReadMsgs = ZTrue
- HiLiteRec = -1
- ScanMsgs = ZFalse
- MsgStart = 6
- MsgEnd = 100
- IF ZLocalUserMode OR NOT ZLocalUser THEN _
- IF ReadMsgIn$ <> ZActiveMessageFile$ THEN _
- ReadMsgIn$ = ZActiveMessageFile$ : _
- CALL UpdtCalr ("Read Messages in " + ReadMsgIn$,1)
- GOSUB 1300
- GOTO 4350
-
- ' **** S - COMMAND FROM MAIN MENU (SCAN MESSAGE HEADERS) ***
- '
- 4340 IF ZWasQ < 2 THEN _
- GOSUB 1300
- 4345 QuickScanMsgs = ZFalse
- ReadMsgs = ZFalse
- ScanMsgs = ZTrue
- MsgStart = 6
- MsgEnd = 100
- SecIndex = 0
- '
- ' ** MESSAGE READ MAINLINE (QUICK SCAN, READ & SCAN) ALL USE THIS ROUTINE *
- '
- 4350 SearchHeader$ = ""
- SubInHeader$ = ""
- SelectByNumber = ZFalse 'Pe 02/25/90
- 4352 SearchString$ = ""
- DontPrint = ZFalse
- JustReplied = ZFalse
- QuotedReply = ZFalse
- AddressedToUser = ZFalse
- CanKill = (ZSysop OR ZUserSecLevel >= ZSecKillAny)
- GOSUB 1893
- GOSUB 5344
- ZWasZ$ = ""
- FOR WasI = 2 TO ZWasQ
- IF INSTR("Ss*",ZUserIn$(WasI)) > 0 THEN _
- ZUserIn$(WasI) = MID$(STR$(ZLastMsgRead+1),2) + "+"
- IF INSTR("Ll",ZUserIn$(WasI)) > 0 THEN _
- ZUserIn$(WasI) = MID$(STR$(HighMsgNumber),2) + "-"
- NEXT
- 4360 ZWasLG$(11) = ZWasZ$
- NumMsgsSelected = ZLastIndex
- MsgIndex = ZAnsIndex
- ZLastIndex = 0
- ToRequested = ZFalse
- FromRequested = ZFalse
- IF ZPageLength < 1 THEN _
- ZNonStop = ZTrue
- 4370 MsgIndex = MsgIndex + 1
- 4371 IF MsgIndex <= NumMsgsSelected THEN _
- IF LEN(ZUserIn$(ZAnsIndex)) = 1 AND _
- INSTR("Cc",ZUserIn$(MsgIndex)) > 0 THEN _
- GOTO 4370 _
- ELSE _
- CALL CheckInt (ZUserIn$(MsgIndex)) : _
- IF ZErrCode <> 0 THEN _
- ZWasEL = 4371 : _
- GOTO 13000 _
- ELSE CurMsg = ZTestedIntValue : _
- ZAnsIndex = MsgIndex : _
- GOTO 4415
- 4380 ZNonStop = (ZPageLength < 1)
- ZOutTxt$ = ""
- 'WasA1$ = WasA1$+ ZCrLf$ + " N - Go to a specific msg number"
- WasA1$ = "" 'Tkey *
- WasA1$ = "Just type in MSG NUMBER to read--
- WasA1$ = WasA1$+ ZCrLf$ + "(E.g.: 387 reads 387 only;"
- WasA1$ = WasA1$+ ZCrLf$ + " 387+ reads forward beginning at 387;"
- WasA1$ = WasA1$+ ZCrLf$ + " 387- reads backward beginning at 387)"
- WasA1$ = WasA1$+ ZCrLf$ + " "
- WasA1$ = WasA1$+ ZCrLf$ + "Or choose from these options:"
- WasA1$ = WasA1$+ ZCrLf$ + " A - ALL msgs" ' Bh
- WasA1$ = WasA1$+ ZCrLf$ + " S - All msgs SINCE the last one you read"
- WasA1$ = WasA1$+ ZCrLf$ + " T - Search for a TEXT STRING within msgs"
- WasA1$ = WasA1$+ ZCrLf$ + " M - YOUR msgs only"
- WasA1$ = WasA1$+ ZCrLf$ + " L - MOST RECENT msg first, then backwards from there"
- WasA1$ = WasA1$+ ZCrLf$ + " H - Help" ' Bh
- WasA1$ = WasA1$+ ZCrLf$ + " " ' Bh
- WasA1$ = WasA1$+ ZCrLf$ + "Your choice " ' Bh 091090
- ZTurboKey = -ZTurboKeyUser
- IF AddressedToUser OR ToRequested OR FromRequested THEN _
- CALL QuickTPut(ZFG1$ + "I will look for" + ZFG4$ + _ 'Tkey * ' Bh
- " YOUR" + ZFG1$ + " messages....",1) : _ 'Tkey *
- SelectByNumber = ZTrue 'Tkey *
- IF SearchString$ <> "" THEN _
- CALL QuickTPut(ZFG1$ + "I will look for messages with this text: '" + _ 'Tkey * ' Bh
- ZFG2$ + SearchString$ + ZEmphasizeOff$ + _ 'Tkey *
- "'....",1) : _ 'Tkey *
- SelectByNumber = ZTrue
- IF SelectByNumber THEN _ 'Tkey *
- WasA1$ = "Enter message number(s)" + _ 'Tkey *
- STR$(LowMsgNumber) + _ 'Tkey *
- " to " + MID$(STR$(ZMsgPtr(ActiveMessages,2)),2) + _ 'Tkey *
- " A)ll " : _
- ZTurboKey = ZFalse
- 4390 ZOutTxt$ = WasA1$ + ZPressEnterExpert$
- ZMacroMin = 99
- ZTurboKey = 0
- 4400 GOSUB 12932
- IF ZWasQ = 0 THEN _
- GOSUB 4650 : _ 'Pe 02/25/90
- RETURN
- IF SelectByNumber THEN _ 'Tkey *
- IF INSTR("Aa",LEFT$(ZUserIn$(ZAnsIndex),1)) THEN _ 'Tkey *
- ZUserIn$(ZAnsIndex) = "1+" 'Tkey *
- IF LEN(ZUserIn$(ZAnsIndex)) = 1 THEN 'Tkey *
- IF INSTR("Aa",LEFT$(ZUserIn$(ZAnsIndex),1)) THEN _ 'Tkey *
- ZUserIn$(ZAnsIndex) = "1+" 'Tkey *
- IF LEN(ZUserIn$(ZAnsIndex)) = 1 THEN _ 'Pe 12/10/88
- IF INSTR("Ll",LEFT$(ZUserIn$(ZAnsIndex),1)) THEN _ 'Pe 12/10/88
- ZUserIn$(ZAnsIndex) = "9999-" 'Pe 12/10/88
- IF LEN(ZUserIn$(ZAnsIndex)) = 1 THEN _
- IF INSTR("Qq",LEFT$(ZUserIn$(ZAnsIndex),1)) THEN _
- GOSUB 4650 : _
- RETURN
- IF INSTR("Hh",LEFT$(ZUserIn$(ZAnsIndex),1)) THEN _
- ZFileName$ = ZHelpPath$ + "MR" + HelpExtension$ : _
- GOSUB 1790 : _
- ZTurboKey = -ZTurboKeyUser : _
- GOTO 4390
- IF INSTR("Nn",LEFT$(ZUserIn$(ZAnsIndex),1)) THEN _ 'Tkey *
- SelectByNumber = ZTrue : _ 'Tkey *
- GOTO 4380 'Tkey *
- IF INSTR("Tt",LEFT$(ZUserIn$(ZAnsIndex),1)) THEN _ 'Tkey *
- WasA1$ = "Enter text to search for " : _ 'Tkey *
- GOTO 4390 'Tkey *
- END IF 'Tkey *
- MsgIndex = 0
- NumMsgsSelected = ZwasQ
- GOTO 4370
- 4415 Forward = ZFalse
- Reverse = ZFalse
- IF LEN(ZUserIn$(ZAnsIndex)) = 1 THEN _
- IF INSTR("Ss*",ZUserIn$(ZAnsIndex)) > 0 THEN _
- CurMsg = ZLastMsgRead + 1 : _
- Forward = ZTrue : _
- GOTO 4430 _
- ELSE IF INSTR("Ll",ZUserIn$(ZAnsIndex)) > 0 THEN _
- CurMsg = HighMsgNumber : _
- Reverse = ZTrue : _
- GOTO 4490
- 4416 IF INSTR("Mm",ZUserIn$(ZAnsIndex)) THEN _
- AddressedToUser = ZTrue : _
- GOTO 4370
- ZWasA = INSTR("FfTt",ZUserIn$(ZAnsIndex))
- IF ZWasA > 0 THEN _
- ToRequested = (ZWasA > 2) : _
- FromRequested = (ZWasA < 3) : _
- GOTO 4370
- IF CurMsg = 0 THEN _
- IF SearchHeader$ <> "" THEN _
- GOTO 4370 _
- ELSE SearchString$ = ZUserIn$(ZAnsIndex) : _
- CALL AllCaps (SearchString$) : _
- CALL Remove (SearchString$,CHR$(34) + CHR$(39)) : _
- SearchHeader$ = SearchString$ : _
- SubInHeader$ = SearchHeader$ : _
- GOTO 4370
- CALL SkipLine (1)
- 4430 IF RIGHT$(ZUserIn$(ZAnsIndex),1) = "+" THEN _
- Forward = ZTrue
- IF RIGHT$(ZUserIn$(ZAnsIndex),1) = "-" THEN _
- Reverse = ZTrue : _
- GOTO 4490
- 4450 ZMsgDimIndex = 1
- 4452 IF ZMsgDimIndex > ActiveMessages THEN _
- GOTO 4515
- IF ReadMsgs AND _
- ZMsgPtr(ZMsgDimIndex,2) = CurMsg THEN _
- GOTO 4520
- 4470 IF ((ReadMsgs AND Forward) OR _
- QuickScanMsgs OR ScanMsgs) AND _
- ZMsgPtr(ZMsgDimIndex,2) >= CurMsg THEN _
- GOTO 4520
- 4480 ZMsgDimIndex = ZMsgDimIndex + 1
- GOTO 4452
- 4490 ZMsgDimIndex = ActiveMessages
- 4492 IF ZMsgDimIndex < 1 THEN _
- GOTO 4515
- IF ZMsgPtr(ZMsgDimIndex,2) <= CurMsg THEN _
- GOTO 4540
- 4510 ZMsgDimIndex = ZMsgDimIndex - 1
- GOTO 4492
- 4515 IF Forward THEN _
- ZOutTxt$ = "No new messages" : _
- ZLastMsgRead = HighMsgNUmber : _
- ZMailWaiting = ZFalse _
- ELSE ZOutTxt$ = "No such message #" + _
- STR$(CurMsg)
- GOSUB 12979
- GOTO 4370
- 4520 EndingMsgIndex = ZMsgDimIndex
- IF ReadMsgs AND NOT Forward THEN _
- GOTO 4560
- 4530 StartMsgIndex = ZMsgDimIndex
- EndingMsgIndex = ActiveMessages
- WasSO = 1
- GOTO 4550
- 4540 StartMsgIndex = ZMsgDimIndex
- EndingMsgIndex = 1
- WasSO = -1
- 4550 WasXXX = EndingMsgIndex + WasSO
- ZMsgDimIndex = StartMsgIndex
- 4552 IF ZMsgDimIndex = WasXXX THEN _
- CALL Carrier : _
- GOTO 4637
- 4560 CurHeader = ZMsgPtr(ZMsgDimIndex,1)
- IF CurHeader < 1 THEN _
- GOTO 4515
- GET 1,CurHeader
- ZPswdFailed = ZFalse
- UserInHeader = ZFalse
- ZWasZ$ = MID$(ZMsgRec$,101,15)
- MsgPswd$ = ZWasZ$
- CALL Trim(MsgPswd$)
- 4561 GOSUB 4660
- GOSUB 4655
- 4562 IF NOT CanKill THEN _
- IF INSTR(ZMsgRec$,"^READ^") > 0 AND NOT UserInHeader THEN _
- ZPswdFailed = ZTrue : _
- IF Forward OR Reverse THEN _
- GOTO 4635
- 4563 CurMsg = VAL(MID$(ZMsgRec$,2,4))
- IF ToRequested THEN _
- IF NOT MsgToCaller THEN _
- GOTO 4629
- IF FromRequested THEN _
- IF NOT MsgFromCaller THEN _
- GOTO 4629
- IF AddressedToUser AND NOT UserInHeader THEN _
- GOTO 4629
- WasX$ = MID$(ZMsgRec$,121,2)
- IF WasX$ = " " THEN _
- MsgSec = ZMinLogonSec _
- ELSE MsgSec = CVI(WasX$)
- IF ZUserSecLevel < MsgSec THEN _
- GOTO 4629
- 4580 IF INSTR(ZMsgRec$,ZWasLG$(11)) = 0 THEN _
- GOTO 4635
- 4581 IF MID$(ZMsgRec$,116,1) = ZDeletedMsg$ THEN _
- GOTO 4630
- ZJustSearching = ZFalse 'Pe 02/05/90
- IF SearchHeader$ <> "" THEN _
- ZFF = INSTR(ZMsgRec$,SearchHeader$) : _
- IF ZFF >= MsgStart AND ZFF <= MsgEnd THEN _
- HiLitePos = ZFF : _
- GOTO 4582 _
- ELSE IF ReadMsgs AND SearchString$ <> "" THEN _
- ZJustSearching = ZTrue : _ 'Pe 02/05/90
- GOTO 4582 _
- ELSE GOTO 4629
- 4582 WasPG = ZFalse
- IF MID$(ZWasZ$,1,1) = "!" THEN _
- IF NOT CanKill THEN _
- WasPG = ZTrue : _
- ZPswdSave$ = MID$(ZWasZ$,2) + _
- " " : _
- ZAttemptsAllowed = 0 : _
- ZSubParm = 1 : _
- CALL PassWrd
- 4584 IF ZPswdFailed AND _
- (QuickScanMsgs OR (ScanMsgs AND NOT WasPG)) THEN _
- GOTO 4635
- 4585 IF ZPswdFailed THEN _
- IF WasPG THEN _
- WasSJ$ = "<PASSWORD>" _
- ELSE WasSJ$ = "<PROTECTED>" _
- ELSE WasSJ$ = MID$(ZMsgRec$,76,25)
- 4590 IF QuickScanMsgs THEN _
- ZOutTxt$ = LEFT$(ZMsgRec$,5) + _
- " " + _
- LEFT$(WasSJ$,19) + _
- " " : _
- CALL CheckColor (ZOutTxt$,SubInHeader$,ZEmphasizeOff$) : _
- GOSUB 12978 : _
- SecIndex = SecIndex + 1 : _
- IF SecIndex = 3 THEN _
- SecIndex = 0 : _
- CALL SkipLine (1) : _
- GOTO 4630 _
- ELSE GOTO 4630
- 4600 IF ScanMsgs THEN _
- GOSUB 8020 : _
- GOTO 4630
- IF NOT ZJustSearching THEN _
- GOSUB 8000 : _
- IF QuotedReply THEN _
- QuotedReply = ZFalse : _
- GOTO 4610
- IF ZRet THEN _
- GOTO 4630
- CanChangeSec = (ZUserSecLevel => ZSecChangeMsg)
- IF ZExpertUser THEN _
- WasA1$ = ",R,T,=,+,-" + _
- MID$(",F",1,- (UserInHeader OR CanChangeSec) * 2) + _
- MID$(",K",1,- (UserInHeader OR CanKill) * 2) + _
- MID$(",U",1,- (ZUserSecLevel >= ZOptSec(54)) * 2) + _
- MID$(",S",1, - CanChangeSec * 2) _
- ELSE WasA1$ = ",R)eply,T)hread,=)again,+,-" + _
- MID$(",F)wd",1, - (UserInHeader OR CanChangeSec) * 5) + _
- MID$(",K)ill",1, - (UserInHeader OR CanKill) * 6) + _
- MID$(",U)ser",1,- (ZUserSecLevel >= ZOptSec(54)) * 6) + _
- MID$(",S)ec",1, - CanChangeSec * 5)
- ZTurboKey = -ZTurboKeyUser
- IF ZJustSearching OR NOT JustReplied THEN _ 'Pe 02/05/90
- GOTO 4610
- JustReplied = ZFalse
- CALL AskMore (WasA1$,ZTrue,ZFalse,ZAnsIndex,ZFalse)
- CALL SkipLine (1)
- IF ZNo THEN _
- RETURN
- CALL AllCaps (ZUserIn$)
- ZReply = (ZReply OR ZUserIn$ = "R")
- IF ZUserIn$ <> "=" THEN _
- GOTO 4618
- CALL SkipLine (1)
- 4610 IF NOT ZPswdFailed THEN _
- GOTO 4613
- IF WasPG AND (NOT ZNonStop) THEN _
- ZAttemptsAllowed = 2 : _
- ZSubParm = 2 : _
- CALL PassWrd
- 4611 IF ZPswdFailed THEN _
- GOTO 4629
- 4613 IF NOT ZJustSearching THEN _ 'Pe 02/05/90
- CALL THREAD3(CurMsg,ZConfName$) 'Pe 02/03/90
- GOSUB 9000
- JustReplied = ZFalse
- DontPrint = ZFalse
- IF ZJustSearching THEN _ 'Pe 02/05/90
- GOTO 4629
- IF ZAnsIndex > NumMsgsSelected THEN _
- GOTO 4650
- CALL SkipLine (1)
- 4614 GOSUB 41000
- ZKillMessage = ZFalse
- ZReply = ZFalse
- IF ZNonStop THEN _
- GOTO 4629
- 4616 ZTurboKey = -ZTurboKeyUser
- CALL AskMore (WasA1$,ZTrue,ZFalse,WasXX,ZFalse)
- IF ZNo THEN _
- ZAnsIndex = ZLastIndex + 1 : _
- RETURN
- CALL AllCaps(ZUserIn$(1))
- ZReply = (ZReply OR ZUserIn$(1) ="R")
- IF ZUserIn$(1) = "=" THEN _
- CALL SkipLine (1) : _
- GOTO 4560
- '
- ' *** MESSAGE Forward - THE "F" COMMAND
- '
- IF ZUserIn$(1) <> "F" OR _
- NOT (UserInHeader OR CanChangeSec) THEN _
- GOTO 4617
- MsgFwd = ZTrue
- GOTO 4623
-
- '
- ' *** LOOK FOR "U" CHARACTER AND SET UP FOR USER EDIT
- '
- 4617 IF ZUserIn$(1) <> "U" OR (ZUserSecLevel < ZOptSec(54)) THEN _
- GOTO 4618
- EditFromRead = 1
- ZReply=ZTrue
- CALL PutMsgAttr
- TempHashValue$ = MsgFrom$
- CALL Trim (TempHashValue$)
- IF TempHashValue$ = "SYSOP" THEN _
- TempHashValue$ = ZSysopPswd1$ + " " + ZSysopPswd2$
- GOTO 11000
- '
- ' **** CHECK FOR CHANGE SECURITY ***
- '
- 4618 IF ZUserIn$(1) = "S" AND CanChangeSec THEN _
- CALL PutMsgAttr : _
- GOSUB 4665 : _
- ZReply = ZFalse : _
- QuotedReply = ZTrue : _
- CALL GetMsgAttr : _
- DontPrint = ZTrue : _
- ZUserIn$ = "=" : _
- JustReplied = ZTrue : _
- GOTO 4560
- IF ZUserIn$(1) = "T" THEN _
- CALL SetThread (CurMsg, OrigSubject$) : _
- IF ZWasQ > 0 THEN _
- SearchHeader$ = ZUserIn$(2) : _
- SubInHeader$ = SearchHeader$ : _
- CALL Trim (SubInHeader$) : _
- GOTO 4352
- ZWasA = INSTR(" +-",ZUserIn$(1))
- IF ZWasA > 1 THEN _
- CurMsg = CurMsg + 5 - 2 * ZWasA : _
- Forward = (ZWasA = 2) : _
- Reverse = (NOT Forward) : _
- SearchString$ = "" : _
- IF Reverse THEN _
- GOTO 4490 _
- ELSE GOTO 4450
- IF ZUserIn$(1) = "Z" AND ZSysop THEN _ 'DGS-MNR
- ZMsgDimIndex = DGSMsgDimIndex : _ 'DGS-MNR
- MID$(DGSRecord$,123,6) = SPACE$(6) : _ 'DGS-MNR
- LSET ZMsgRec$ = DGSRecord$ : _ 'DGS-MNR
- GOSUB 12986 : _ 'DGS-MNR
- PUT 1,ZMsgPtr(ZMsgDimIndex,1) : _ 'DGS-MNR
- GOSUB 12987 'DGS-MNR
- '
- ' **** KILL CURRENT MESSAGE ***
- '
- IF ZKillMessage AND (UserInHeader OR CanKill) THEN _
- IF ZUserSecLevel >= ZOptSec(9) THEN _
- CALL PutMsgAttr : _
- MsgToKill = CurMsg : _
- Temp = ZWasQ : _
- GOSUB 3950 : _
- CALL GetMsgAttr : _
- GOTO 4629 _
- ELSE ZViolation$ = "MORE KILL" : _
- GOSUB 1380 : _
- GOTO 4629
- '
- ' **** REPLY TO CURRENT MESSAGE ***
- '
- 4620 IF NOT ZReply THEN _
- GOTO 4629
- 4621 IF ZUserSecLevel < ZOptSec(5) THEN _
- ZViolation$ = "MORE RE" : _
- GOSUB 1380 : _
- ZReply = ZFalse : _
- GOTO 4629
- IF LEFT$(Subject$,3) <> "(R)" THEN _
- OrigSubject$ = "(R)" + _
- LEFT$(OrigSubject$,22)
- 4622 MsgTo$ = MsgFrom$
- CALL Trim (MsgTo$)
- MsgFrom$ = ZActiveUserName$
- 4623 DontPrint = ZFalse
- CALL PutMsgAttr
- IF MsgFwd THEN GOTO 4624
- ZOutTxt$ = "Quote " + MsgTo$ + "'s message (Y/[N])"
- GOSUB 12999
- IF ZRet OR NOT ZYes THEN _
- GOTO 4627
- 4624 QuotedReply = ZTrue
- ZLinesInMsg = ZLinesInMsg - 1
- IF HiLitedLine > 0 THEN _
- ZOutTxt$(HiLitedLine) = ZOutTxt$(0) : _
- HiLitedLine = 0
- IF MsgFwd THEN _
- TempRightMargin = ZRightMargin _
- ELSE _
- TempRightMargin = ZRightMargin - 2
- CALL WordWrap (TempRightMargin,ZLinesInMsg,ZOutTxt$())
- IF ZLinesInMsg > ZMsgDim THEN _
- ZLinesInMsg = ZMsgDim : _
- CALL QuickTPut1 ("Original message truncated to " + _
- STR$(ZMsgDim) + " lines for editing!")
- IF MsgFwd THEN GOTO 4625
- FOR WasX = 1 TO ZLinesInMsg
- IF LEFT$(ZOutTxt$(WasX),1) = ">" THEN _
- ZOutTxt$(WasX) = ">" + ZOutTxt$(WasX) _
- ELSE ZOutTxt$(WasX) = "> " + ZOutTxt$(WasX)
- NEXT
- 4625 WasX$ = MsgTo$
- GOSUB 2001
- ' IF (ActiveMessages >= MaxMsgs) OR MsgTo$ = "" THEN _
- ' GOTO 4628
- IF (ActiveMessages >= MaxMsgs) OR WasX$ = "" THEN _ 'Pe 02/25/90
- GOTO 4628
- IF MsgFwd THEN _
- MsgFwd$ = ZActiveUserName$ : _
- CALL Trim (MsgFwd$) : _
- CALL Trim (WasX$) : _
- MsgFwd$ = "Original Msg was to " + WasX$ + _
- ", forwarded by " + MsgFwd$
- IF (MsgFwd AND CanChangeSec AND NOT MsgFromCaller) THEN _
- CALL Trim (MsgFrom$) : _
- ZOutTxt$ = "Message was from " + _
- MsgFrom$ + _
- ", change to " + _
- ZActiveUserName$ + _
- " (Y/[N])" : _
- GOSUB 12999 : _
- IF ZYes THEN _
- MsgFrom$ = ZActiveUserName$ : _
- CALL Trim (MsgFrom$) : _
- GOTO 4626
- IF MsgFwd THEN _
- FOR MsgFwdCount = ZLinesInMsg TO 1 STEP -1 : _
- ZOutTxt$(MsgFwdCount + 2) = ZOutTxt$(MsgFwdCount) : _
- NEXT MsgFwdCount : _
- ZOutTxt$(1) = MsgFwd$ : _
- ZOutTxt$(2) = "" : _
- ZLinesInMsg = ZLinesInMsg + 2 : _
- IF NOT CanChangeSec THEN _
- MsgLockLines = 1
- 4626 ZWasZ$ = "L"
- WasL = 1
- ' GOSUB 2101 'ANSIEd ' Bh 110790
- ' IF ZYes THEN 'ANSIEd
- ' GOSUB 2110 'ENSIEd
- ' ELSE
- IF ZLinesInMsg >= ZMaxMsgLines THEN _
- CALL QuickTPut ("Msg cannot exceed" + _
- STR$(ZMaxMsgLines) + " lines! ",0)
- IF NOT MsgFwd THEN _
- CALL QuickTPut1 (ZCrlf$ +"C continues reply. Please 1st delete unneeded lines (eg. d 1 5)")
- GOSUB 3200
- GOSUB 3020
- GOSUB 2300
- ' END IF 'ANSIEd ' Bh 110790
- GOTO 4628
- 4627 GOSUB 2000
- 4628 ZReply = ZFalse
- JustReplied = ZTrue
- QuotedReply = ZTrue
- CALL GetMsgAttr
- DontPrint = ZTrue
- ZUserIn$ = "="
- QuotedReply = ZTrue
- MsgFwd = ZFalse
- GOTO 4560
- 4629 QuotedReply = ZFalse
- JustReplied = ZFalse
- IF NOT Forward AND NOT Reverse THEN _
- GOTO 4370
- 4630 CALL AskMore (",#(s) to read",ZTrue,ZTrue,WasXX,ZFalse)
- IF ZWasQ = 0 OR ZYes THEN _
- GOTO 4631
- IF ZNo THEN _
- RETURN
- IF ZSubParm = -1 THEN _
- RETURN 10595
- IF ZRet THEN _
- RETURN
- ZWasZ$ = ZUserIn$(1)
- CALL AllCaps (ZWasZ$)
- IF VAL(ZWasZ$) > 0 THEN _
- FOR WasI = ZWasQ TO 1 STEP -1 : _
- ZUserIn$(WasI + 1) = ZUserIn$(WasI) : _
- NEXT : _
- ZUserIn$(1) = MID$(ZAllOpts$,INSTR(ZOrigCommands$,"R"),1)
- ZLastIndex = ZWasQ + 1 : _
- ZAnsIndex = 1 : _
- RETURN 1235
- 4631 CALL CheckCarrier
- IF ZSubParm THEN _
- RETURN 10595
- IF ZRet THEN _
- RETURN
- 4635 IF WasSO = 0 THEN _
- WasSO = 1
- ZMsgDimIndex = ZMsgDimIndex + WasSO
- GOTO 4552
- 4637 IF ReadMsgs THEN _
- SearchString$ = "" : _
- SearchHeader$ = "" : _
- SubInHeader$ = "" : _
- ToRequested = ZFalse : _
- FromRequested = ZFalse : _
- AddressedToUser = ZFalse : _
- GOTO 4370
- 4650 CALL SkipLine (1)
- CALL QuickTPut1 ("<------------- End of Selected Messages-------->")
- CALL DelayTime (1) 'Pe 02/03/90
- RETURN
- 4655 '**** update last message read ****
- IF SearchHeader$ <> "" OR SearchString$ <> "" OR NOT ReadMsgs THEN _
- RETURN
- 4656 IF ZMsgPtr(ZMsgDimIndex,2) > ZLastMsgRead THEN _
- ZMailWaiting = ZFalse : _
- ZLastMsgRead = ZMsgPtr(ZMsgDimIndex,2)
- RETURN
- 4660 IF RemoteSysop THEN _
- CALL MsgNameMatch ("SYSOP",SysopFullName$,6,MsgFromCaller) : _
- CALL MsgNameMatch ("SYSOP",SysopFullName$,37,MsgToCaller) _
- ELSE CALL MsgNameMatch (MsgUserName$,"",6,MsgFromCaller) : _ 'DGS-AlsMod
- CALL MsgNameMatch (MsgUserName$,"",37,MsgToCaller) 'DGS-AlsMod
- ' ELSE CALL MsgNameMatch (MsgUserName$,ZActiveUserName$,6,MsgFromCaller) : _ 'DGSALSMod
- ' CALL MsgNameMatch (MsgUserName$,ZActiveUserName$,37,MsgToCaller) 'DGSALSMod
- IF ZNewUserDGS THEN _ 'DGS-NEW
- CALL MsgNameMatch ("NEWUSER","",6,MsgFromCaller) : _ 'DGS-NEW
- CALL MsgNameMatch ("NEWUSER","",37,MsgToCaller) : _ 'DGS-NEW
- CanKill = ZFalse 'DGS-NEW
- UserInHeader = (MsgFromCaller OR MsgToCaller)
- RETURN
- '
- ' **** S - CHANGE MESSAGE SECURITY ***
- '
- 4665 CALL Trim (MsgFrom$)
- ZOutTxt$ = "Change sender's name from " + _
- MsgFrom$ + _
- " to"
- GOSUB 12995
- IF ZWasQ = 0 THEN _
- GOTO 4666
- IF LEN(ZUserIn$) > 30 THEN _
- CALL QuickTPut1 ("30 Char. Max") : _
- GOTO 4665
- CALL AllCaps (ZUserIn$)
- MsgFrom$ = ZUserIn$
- 4666 CALL Trim (MsgTo$)
- ZOutTxt$ = "Change receiver's name from " + _
- MsgTo$ + _
- " to"
- GOSUB 12995
- IF ZWasQ = 0 THEN _
- GOTO 4667
- IF LEN(ZUserIn$) > 30 THEN _
- CALL QuickTPut1 ("30 Char. Max") : _
- GOTO 4666
- CALL AllCaps (ZUserIn$)
- MsgTo$ = ZUserIn$
- TempMsgTo$ = ZUserIn$
- CALL MessageTo (HighestUserRecord,MsgTo$,MsgFrom$,RcvrRecNum,Found)
- IF MsgTo$ = "" THEN MsgTo$ = TempMsgTo$
- 4667 CALL Trim (Subject$)
- ZOutTxt$ = "Change subject from " + _
- Subject$ + _
- " to"
- GOSUB 12995
- IF ZWasQ = 0 THEN _
- GOTO 4668
- IF LEN(ZUserIn$) > 25 THEN _
- CALL QuickTPut1 ("25 Char. Max") : _
- GOTO 4667
- CALL AllCaps (ZUserIn$)
- Subject$ = ZUserIn$
- 4668 ZOutTxt$ = "Change min sec to read from" + _
- STR$(MsgSec) + _
- " to"
- GOSUB 12995
- IF ZWasQ=0 THEN _
- GOTO 4669
- CALL CheckInt (ZUserIn$)
- IF ZErrCode <> 0 THEN _
- RETURN
- MsgSec = ZTestedIntValue
- 4669 ZReply = ZTrue
- CALL MsgProt (MsgTo$,Found,MsgPswd$)
- ZReply = ZFalse
- 4670 MsgTo$ = LEFT$(MsgTo$ + SPACE$(22),22)
- MsgFrom$ = LEFT$(MsgFrom$ + SPACE$(31),31)
- Subject$ = LEFT$(Subject$ + SPACE$(25),25)
- MsgPswd$ = LEFT$(MsgPswd$ + SPACE$(15),15)
- ZSubParm = 3
- CALL FileLock
- GET 1,CurHeader
- MID$(ZMsgRec$,37,22) = MsgTo$
- MID$(ZMsgRec$,6,31) = MsgFrom$
- MID$(ZMsgRec$,76,25) = Subject$
- MID$(ZMsgRec$,121,2) = MKI$(MsgSec)
- MID$(ZMsgRec$,101,15) = MsgPswd$
- IF LEFT$(MsgPswd$,6) = "^READ^" THEN _
- MID$(ZMsgRec$,1,1) = "*" _
- ELSE _
- MID$(ZMsgRec$,1,1) = " "
- PUT 1,CurHeader
- ZSubParm = 4
- CALL FileLock
- CALL QuickTPut1 ("Message header changed")
- CALL SkipLine (1)
- CALL FlushKeys
- RETURN
- '
- ' **** O - COMMAND FROM MAIN MENU (OPERATOR PAGE) ***
- '
- 4700 IF NOT ZSysopAvail THEN _
- ZOutTxt$ = "Sorry, " + _
- ZSysopFirstName$ + _
- " not available to answer page" : _
- GOSUB 12979 : _
- GOTO 4755
- 4705 CALL QuickTPut1 ("Chat. Remote Conversation")
- WasJJ = VAL(MID$(TIME$,1,2))*100 + VAL(MID$(TIME$,4,2))
- IF (WasJJ > ZStartOfficeHours AND WasJJ < ZEndOfficeHours) OR ZSysopAnnoy THEN _
- GOTO 4710
- 4707 GOTO 4750 'Pe 02/03/90
- 4708 ZOutTxt$ = "SYSOP in from" + _
- STR$(ZStartOfficeHours) + _
- " to" + _
- STR$(ZEndOfficeHours) + ","
- GOSUB 12979
- GOTO 4755
- 4710 ZOutTxt$ = "Page " + _
- ZSysopFirstName$ + _
- " (Y/[N])"
- CALL SkipLine (1)
- GOSUB 12999
- IF NOT ZYes THEN _
- RETURN
- PageCount = 0
- ZOutTxt$ = "Paging " + _
- ZSysopFirstName$ + _
- " now"
- GOSUB 12978
- PageTimeStart! = TIMER
- 4730 CALL DelayTime (1)
- 4735 PageCount = PageCount + 1
- IF INKEY$ = ZEscape$ THEN _
- GOTO 4765
- 4740 IF PageCount MOD 2 THEN _
- ZOutTxt$ = ZPagingPtrSupport$ + _
- ZBellRinger$ : _
- IF LEN(ZPagingPtrSupport$) = 3 THEN _
- CALL Printit (CHR$(7)) : _
- IF ZErrCode <> 0 THEN _
- ZWasEL = 4740 : _
- GOTO 13000
- 4745 GOSUB 12978
- CALL CheckTime (PageTimeStart!, PageTimeNow!, 2)
- IF PageTimeNow! < 30 THEN GOTO 4730
- 4747 GOSUB 12979
- 4750 CALL QuickTPut1 (ZSysopFirstName$ + " not responding")
- 4755 'CALL QuickTPut1 ("Try a msg or comment")
- PagedFileName$ = "PAGED.DEF" 'Pe 02/03/90
- Call BufFile (PagedFileName$,WasX) 'Pe 02/03/90
- ZPageStatus$ = "Paged!"
- CALL UpdtCalr ("Operator paged " + LEFT$(TIME$,5),2)
- RETURN
- 4765 CALL UpdtCalr ("Paged & chatted with Sysop",1)
- CALL QuickTPut1 ("SYSOP in! " + _
- ZFirstName$ + _
- ", this is " + _
- ZSysopFirstName$ + _
- " go ahead!")
- ZPageStatus$ = ""
- 4770 CALL SysopChat
- IF ZSubParm < 0 THEN _
- GOTO 202
- RETURN
- '
- ' **** S - COMMAND FROM UTILITY MENU (STATISTICS) ***
- '
- 4849 GOSUB 4850 'PE 02/10/89
- CALL AskMore ("",ZTrue,ZFalse,WasX,ZTrue) 'PE 02/10/89
- RETURN 'PE 02/10/89
- 4850 GOSUB 1893
- CALL QuickTPut1 ("RBBS-PC " + ZVersionID$ + " Node " + ZNodeID$)
- ZOutTxt$ = ""
- IF NOT ZConfMode THEN _
- ZOutTxt$ = "Caller Number................"+STR$(CallsToDate!) + " "+ZCrLf$
- 4855 ZOutTxt$ = ZOutTxt$ + "Active Messages.............."+STR$(ActiveMessages)+ZCrLf$
- ZOutTxt$ = ZOutTxt$ + "Next Msg Number.............."+STR$(HighMsgNumber + 1)+_
- ZCrLf$
- IF ZLastMsgRead > 0 THEN _
- ZOutTxt$ = ZOutTxt$ + "Last msg you read............" + STR$(ZLastMsgRead)+ZCrLf$ _
- ELSE ZOutTxt$ = ZOutTxt$ + "Believe on the Lord Jesus Christ, and thou shalt be saved" +ZCrLf$ ' Bh
- 4857 GOSUB 12976
- ZWasZ$ = ZUpldDriveFile$
- CALL FindFree
- CALL QuickTPut1 ("Upload disk has" + ZFreeSpace$)
- IF (NOT ZSysop) AND (ZUserSecLevel < ZSecKillAny) THEN _
- CALL Delaytime (2) : _
- RETURN
- UserWork = (HighestUserRecord * .95) + 1
- IF ZMsgsCanGrow THEN _
- ZWasY$ = " open" _
- ELSE ZWasY$ = STR$(HighestMsgRecord + 1 - NodesInSystem - ZNextMsgRec)
- ZOutTxt$ = "USERS: used" + _
- STR$(CurUserCount - 1) + _
- " avl" + _
- STR$(UserWork - CurUserCount) + _
- " MSGS: used" + _
- STR$(ActiveMessages) + _
- " avl" + _
- STR$(MaxMsgs - ActiveMessages) + _
- " MSG REC: used" + _
- STR$(ZNextMsgRec - 1) + _
- " avl" + ZWasY$
- GOSUB 12976
- CALL DelayTime (2)
- RETURN
- 4900 IF (NOT ZLocalUser) OR (NOT ZSysop) THEN _
- CALL UpdtCalr ("Entered " + ZConfName$,1)
- CALL QuickTPut1 ("Welcome to the " + ZConfName$) ' Bh 083190
- 4905 GOSUB 1790
- 4910 GOSUB 12986
- GOSUB 5344
- IF LOF(1) = 0 THEN _
- ZWasDF$ = ZActiveMessageFile$ : _
- CLOSE 1 : _
- KILL ZActiveMessageFile$ : _
- GOSUB 12987 : _
- RETURN 13600
- GOSUB 23000
- RETURN
- '
- ' **** P - COMMAND FROM UTILITY MENU (PASSWORD CHANGE) ***
- '
- 5110 CALL NewPassword ("Enter new password" + ZPressEnter$,ZTrue)
- IF ZSubParm < 0 THEN _
- GOTO 202
- IF ZWasQ = 0 THEN _
- RETURN
- 5120 ZOutTxt$ = "Reenter new password"
- GOSUB 45010
- IF ZWasQ = 0 THEN _
- RETURN
- CALL AllCaps (ZUserIn$)
- IF ZWasZ$ <> ZUserIn$ THEN _
- ZOutTxt$ = "Passwords don't match!" : _
- GOSUB 12979 : _
- RETURN
- 5125 IF ZMaxPswdChanges AND _
- ChangeThisSession > _
- ZMaxPswdChanges AND _
- NOT ZSysop THEN _
- ZOutTxt$ = "No changes permitted" : _
- GOSUB 12975 : _
- RETURN _
- ELSE PswdChangeAllowed = ZTrue : _
- GOSUB 5140 : _
- IF NOT Found THEN _
- GOTO 5129 _
- ELSE ZOutTxt$ = "Temporary change" : _
- GOSUB 12975 : _
- ZPswd$ = ZTempPassword$ : _
- ZSecsPerSession! = ZTempTimeAllowed * 60 : _
- ZUserSecLevel = ZTempSecLevel : _
- GOSUB 41070 : _
- ZSysop = (ZUserSecLevel >= ZSysopSecLevel) : _
- CALL SetPrompt : _
- CALL XferType (2,ZTrue)
- IF ZActiveUserName$ = "SYSOP" THEN _
- ZUserIn$(1) = "********"
- 5126 CALL UpdtCalr ("Used temp password " + ZUserIn$,2)
- RETURN
- 5129 IF ZOrigUserFile$ <> ZActiveUserFile$ THEN _
- CALL QuickTPut1 ("Password Change only in Logon User File") : _
- RETURN
- GOSUB 12989
- CALL OpenUser (HighestUserRecord)
- GOSUB 9450
- 5130 IF ZUserFileIndex < 1 OR _
- ZUserFileIndex > 32767 THEN _
- GOTO 5160
- GET 5,ZUserFileIndex
- CALL AllCaps (ZUserIn$)
- LSET ZPswd$ = ZUserIn$
- GOSUB 9440
- GOSUB 12991
- ZOutTxt$ = "Password changed"
- ZStopInterrupts = ZTrue
- GOSUB 12975
- IF ZMaxPswdChanges THEN _
- ChangeThisSession = ChangeThisSession + 1
- 5131 CALL UpdtCalr ("New Password " + ZUserIn$(1),2)
- RETURN
- '
- ' **** SEARCH "PASSWORDS" FILE FOR TEMPORARY PASSWORDS ***
- '
- 5135 ZWasZ$ = ""
- WasZ = 0
- GOSUB 5140
- IF NOT Found THEN _
- ZTempTimeAllowed = MinsPerSessionDef : _
- ZTempMaxPerDay = MaxPerDayDef _
- ELSE ZTimeLockSet = ZTempTimeLock : _
- ZDaysInRegPeriod = ZTempRegPeriod
- ZMinsPerSession = ZTempTimeAllowed
- ZMaxPerDay = -(ZMaxPerDay * (ZTempMaxPerDay <= 0)) - _
- (ZTempMaxPerDay * (ZTempMaxPerDay > 0))
- IF ZLimitMinsPerSession THEN _
- IF ZMinsPerSession > ZLimitMinsPerSession THEN _
- ZMinsPerSession = ZLimitMinsPerSession : _
- ZOutTxt$ = "Time shortened for external event" : _
- CALL RingCaller : _ 'DGS-BRMMod
- ZCurrHourDGS = 1 'DGS-BRM
- GOSUB 825
- RETURN
- 5140 Found = ZFalse
- CALL OpenWork (2,ZPswdFile$)
- IF ZErrCode = 53 THEN _
- CALL UpdtCalr ("Missing file " + ZPswdFile$,2) : _
- IF WasZ = 1 THEN _
- CALL AllCaps (ZUserIn$(1)) : _
- ZWasZ$ = ZUserIn$(1) : _
- GOTO 5160 _
- ELSE GOTO 5160
- ZWasZ$ = ZWasZ$ + _
- SPACE$(15 - LEN(ZWasZ$))
- 5150 IF EOF(2) THEN _
- GOTO 5160
- 5151 CALL GetPassword
- IF ZErrCode <> 0 THEN _
- ZWasEL = 5151 : _
- GOTO 13000
- IF LEN(ZTempPassword$) > 15 THEN _
- GOTO 5150
- ZTempPassword$ = ZTempPassword$ + _
- SPACE$(15 - LEN(ZTempPassword$))
- IF ZWasZ$ <> ZTempPassword$ THEN _
- GOTO 5150
- IF PswdChangeAllowed AND _
- ZUserSecLevel >= ZMinSecForTempPswd THEN _
- GOTO 5155
- IF ZUserSecLevel <> ZTempSecLevel THEN _
- GOTO 5150
- IF ZStartTime = 0 THEN _
- GOTO 5155
- WorkTime$ = TIME$
- TestTime = VAL(LEFT$(WorkTime$,2) + MID$(WorkTime$,4,2))
- IF TestTime => ZStartTime AND TestTime <= ZEndTime THEN _
- GOTO 5155
- IF ZEndTime < ZStartTime THEN _
- IF TestTime => ZStartTime OR TestTime <= ZEndTime THEN _
- GOTO 5155
- GOTO 5150
- 5155 Found = ZTrue
- 5160 ZErrCode = 0
- RETURN
- 5200 CALL PageLen
- RETURN
- '
- ' **** J - COMMAND FROM MAIN MENU (JOIN CONFERENCE) ***
- '
- 5300 WasA1$ = ZConfMenu$
- CALL BreakFileName (ZActiveMessageFile$,MsgDrvPath$,WasX$,ZWasY$,ZTrue)
- ' CALL Talk (12,ZOutTxt$) 'Pe 02/04/90
- 5301 ZStackC = ZTrue
- CALL SubMenu ("Choose one--or L to display this menu again ([RETURN] to quit)",_ ' Bh
- WasA1$,MsgDrvPath$,_
- "M.DEF","M",ZUserGraphicDefault$,ZTrue,ZFalse,ZFalse,"C.DEF")
- IF ZWasQ = 0 THEN _
- RETURN
- ' ZActiveUserName$ = ZOrigUserNameDGS$ 'DGS-ALS
- ' ZFirstName$ = OrigFirstName$ 'DGS-ALS
- IF ZSubParm = -1 THEN _
- RETURN 10595
- 5323 IF ZWasZ$ = "M" OR ZWasZ$ = "MAIN" THEN _
- IF ZConfName$ = "MAIN" THEN _
- RETURN _
- ELSE GOTO 5350
- IF NOT ZOK THEN _
- GOTO 5300
- CLOSE 2
- '
- ' **** UPDATE PREVIOUS MESSAGE BASE CHECKPOINT RECORD ***
- '
- 5324 PrevConfName$ = ZConfName$
- ZConfName$ = ZWasZ$
- ConfFileName$ = ZConfName$
- ConfNameSave$ = ZConfName$
- PrevMsg$ = ZActiveMessageFile$
- ZActiveMessageFile$ = ZFileName$
- GOSUB 5343
- '
- ' **** UPDATE PREVIOUS USER RECORD ***
- '
- 5325 GOSUB 5380
- '
- ' ***** CHECK WHETHER HAVE SUBBOARD (I.E. CONFIG.DEF EXISTS) ****
- '
- 5327 UserRecordHold$ = ZUserRecord$
- ConfModeSave = ZConfMode
- ZConfMode = ZTrue
- PrevUser$ = ZActiveUserFile$
- PrevIndex = ZUserFileIndex
- PrevMainUser$ = ZMainUserFile$
- PrevUSL = ZUserSecLevel
- PrevDef$ = ZCurDef$
- 5328 WasX$ = ZConfName$ + _
- "C.DEF"
- CALL FindIt (WasX$)
- SubBoard = ZOK
- IF NOT SubBoard THEN _
- CALL BreakFileName (ZMainMsgFile$,MsgDrvPath$,ZWasDF$,ZWasY$,ZTrue) : _
- WasX$ = MsgDrvPath$ + WasX$ : _
- CALL FindIt (WasX$) : _
- SubBoard = ZOK
- IF SubBoard THEN _
- IF LEN(ZConfName$) = 6 THEN _
- IF LEFT$(ZConfName$,4) = "RBBS" AND RIGHT$(ZConfName$,1) = "P" THEN _ ' JM122203
- SubBoard = ZFalse
- IF NOT SubBoard THEN _
- ZConfigFileName$ = ZOrigCnfg$ : _ 'Pe 02/03/90
- CALL ReadDef (ZConfigFileName$) : _ 'Pe 02/03/90
- CALL BreakFileName (ZActiveUserFile$,UserDrvPath$,ZWasDF$,ZWasY$,ZTrue) : _
- WasX$ = UserDrvPath$ + _
- ZConfName$ + _
- "U.DEF" : _
- ZFileName$ = ZWelcomeFileDrvPath$ + _
- ZConfName$ + _
- "W.DEF" _
- ELSE CALL ReadDef (WasX$) : _
- IF ZErrCode > 0 THEN _
- CALL UpdtCalr ("Error"+STR$(ZErrCode)+" reading config file "+WasX$,2) : _
- ZErrCode = 0 : _
- ZInConfMenu = ZFalse : _
- ZOutTxt$ = "I had trouble reading some data; try again please" : _
- GOTO 5341 _
- ELSE WasX$ = ZMainUserFile$ : _
- ZFileName$ = "" : _
- CALL FindIt (ZMainMsgFile$) : _
- IF NOT ZOK THEN _
- ZOutTxt$ = "msg file missing for" : _
- ZInConfMenu = ZFalse : _
- GOTO 5341 _
- ELSE ZActiveMessageFile$ = ZMainMsgFile$ : _
- GOSUB 5343
- UpdateDate = ZTrue
- CALL FindIt (WasX$)
- IF ZOK THEN _
- GOTO 5330
- '
- ' ***** NO USER FILE - A PUBLIC CONFERENCE ****
- '
- ZMainUserFile$ = PrevMainUser$
- IF (ZUserSecLevel < AutoAddSec) THEN _
- GOTO 5340
- GOTO 5345
- '
- ' **** CHECK CONFERENCE USER'S FILE ***
- '
- 5330 ZActiveUserFile$ = WasX$
- IF ZMainUserFileIndex < 1 THEN _
- Found = ZFalse : _
- ZUserFileIndex = 0 : _
- GOTO 5335
- CALL WordInFile (ZConfMenu$,ZConfName$,ZInConfMenu)
- IF ZActiveUserName$ = "SYSOP" THEN _
- TempHashValue$ = ZOrigUserName$
- GOSUB 12598
- GOSUB 12984
- 5335 IF Found THEN _
- GOSUB 9500 : _
- ZMainUserFileIndex = -(SubBoard * ZUserFileIndex)_
- -((NOT SubBoard) * ZMainUserFileIndex) : _
- Temp = -(SubBoard * ZMinLogonSec) _
- -((NOT SubBoard) * AutoAddSec) : _
- WasI = (ZUserSecLevel < OrigMainSec) : _
- WasJ = (ZUserSecLevel < Temp) : _
- WasK = (WasI AND WasJ) : _
- IF WasK THEN _
- ZOutTxt$ = "you have been locked out of" : _
- GOTO 5341 _
- ELSE GOSUB 5375 : _
- GOTO 5345
- '
- ' **** USER NOT FOUND. AUTO-ADD TO SUBBOARD IF SUFFICIENT SECURITY ***
- '
- ZNewUser = SubBoard
- IF SubBoard THEN _
- AutoAddSec = ZMinLogonSec
- IF (ZUserSecLevel >= AutoAddSec) AND _
- (ZUserFileIndex > 0) AND (ZMainUserFileIndex > 0) THEN _
- LSET ZUserRecord$ = UserRecordHold$ : _
- ' CALL QuickTPut1 ("Adding privileges granted in " + ZConfName$) : _
- CALL QuickTPut1 ("You have been approved to enter the " + ZConfName$ + " Conference") : _ ' Bh 083190
- MID$(ZUserOption$,3,2) = MKI$(0) : _
- MID$(ZUserOption$,1,2) = MKI$(0) : _
- ZActiveUserName$ = LEFT$(UserRecordHold$,30) : _
- CALL Trim (ZActiveUserName$) : _
- Temp = -(SubBoard * ZDefaultSecLevel) _
- -((NOT SubBoard) * ZUserSecSave) : _
- GOSUB 5370 : _
- Temp = -(ZWasA * ZSysopSecLevel) - ((NOT ZWasA) * Temp) : _
- LSET ZSecLevel$ = MKI$(Temp) : _
- ZUserSecLevel = Temp : _
- GOSUB 5375 : _
- ZPageLength = ZPageLengthDef : _
- GOSUB 12986 : _
- GOSUB 12630 : _
- UpdateDate = ZTrue : _
- Found = ZTrue : _
- GOTO 5335
- IF ZUserSecLevel >= AutoAddSec THEN _
- CALL QuickTPut1 ("Temporary Privileges granted in " + ZConfName$) : _
- ZActiveUserFile$ = PrevUser$ : _
- UpdateDate = ZFalse : _
- ZUserFileIndex = PrevIndex : _
- GOSUB 5382 : _
- ZUserFileIndex = 0 : _
- GOTO 5345
- ZNewUser = ZFalse
- 5340 IF ZInConfMenu THEN _
- ZOutTxt$ = "you are not in conference" _
- ELSE ZOutTxt$ = "no such option"
- 5341 ZOutTxt$ = ZOutTxt$ + " " + ZConfName$
- '
- ' **** CANNOT JOIN THE REQUESTED CONFERENCE. THEREFORE, GO BACK ***
- '
- GOSUB 1397
- ZConfName$ = PrevConfName$
- ConfFileName$ = ZConfName$
- IF SubBoard THEN _
- CALL ReadDef (PrevDef$)
- ZActiveMessageFile$ = PrevMsg$
- GOSUB 5343
- ZUserFileIndex = PrevIndex
- ZActiveUserFile$ = PrevUser$
- GOSUB 5382
- ZConfMode = ConfModeSave
- GOSUB 12987
- ZAnsIndex = 0
- ZLastIndex = 0
- GOTO 5301
- '
- ' **** RESTORE A MESSAGE BASE ***
- '
- 5343 GOSUB 5344
- GOSUB 23000
- RETURN
- '
- ' ***** OPEN AND SETUP MESSAGE BASE *****
- '
- 5344 CALL OpenMsg
- IF ZErrCode = 64 THEN _
- ZErrCode = 0 : _
- GOTO 5350
- FIELD 1, 128 AS ZMsgRec$
- RETURN
- '
- ' ***** SUCCESSFUL CONFERENCE JOIN ****
- '
- 5345 'DGSStl$ = "" 'DGS-ALS
- 'WHILE DGSAlias$ = "" 'DGS-ALS
- ' CALL DGSAlias (ZConfName$,ZOrigUserNameDGS$,DGSAlias$, _ 'DGS-ALS
- ' DGSStl$,DGSFileName$) 'DGS-ALS
- 'WEND 'DGS-ALS
- 'DGSAlias$ = "" 'DGS-ALS
- ZNewsFileName$ = ZWelcomeFileDrvPath$ + ZConfName$ + ".NWS"
- BobToggle=0 ' Bh 090190
- OPEN ZWelcomeFileDrvPath$ + ZConfName$ + ".TST" for append as #8
- if lof(8) <> 0 then BobToggle=0 else BobToggle=-1
- close #8
- ' SELECT CASE code went here
- OPEN "CONFS.LST" FOR INPUT AS #10
- DO UNTIL (ZBobName$ = ZConfName$) OR EOF(10)
- INPUT #10,ZBobName$,ZBobDesc$
- LOOP
- CLOSE #10
- ZConfName$ = ZBobDesc$ + " " + MID$("File CollectionConference",1-15*BobToggle,15) ' Bh 090190
- IF ZGlobalSysop THEN _
- ZActiveUserName$ = "SYSOP"
- 5347 GOSUB 4900
- 5348 GOSUB 12987
- GOSUB 12990
- IF SubBoard THEN _
- ZHasDoored = ZFalse : _
- ZActiveFMSDir$ = "" : _
- RETURN 108
- GOSUB 827
- IF UpdateDate THEN _
- BoardCheckDate$ = ZLastDateTimeOn$ : _
- LSET ZLastDateTimeOn$ = ZCurDate$ + _
- " " + _
- ZTimeLoggedOn$ : _
- GOSUB 9440 : _
- GOSUB 12991
- IF PrevUSL <> ZUserSecLevel THEN _
- CALL SetPrompt
- GOSUB 1241
- RETURN 852
- '
- ' **** JOIN M)AIN ***
- '
- 5350 IF ZConfName$ <> "MAIN" THEN _
- CALL QuickTPut1 ("Returning to Main Menu") 'Bh 083190
- ' CALL QuickTPut1 ("Rejoining " + OrigMsgName$)
- ' ZActiveUserName$ = ZOrigUserNameDGS$ 'DGS-ALS
- ' ZFirstName$ = OrigFirstName$ 'DGS-ALS
- ZConfName$ = "MAIN"
- ConfFileName$ = OrigMsgName$
- ZNewsFileName$ = OrigNewsFileName$
- TurboLogon = ZTrue
- ZWasQ = 0
- ZInConfMenu = ZTrue
- IF ZActiveUserName$ = "SYSOP" THEN _
- ZActiveUserName$ = ZSysopPswd1$ + " " + ZSysopPswd2$ : _
- CALL Trim (ZActiveUserName$)
- ZConfigFileName$ = ZOrigCnfg$
- CALL ReadDef (ZConfigFileName$)
- IF ZOrigMsgFile$ <> ZActiveMessageFile$ THEN _
- ZActiveMessageFile$ = ZOrigMsgFile$ : _
- GOSUB 5343
- IF ZOrigUserFile$ <> ZActiveUserFile$ THEN _
- GOSUB 5380 : _
- ZActiveUserName$ = ZOrigUserName$ : _
- GOSUB 12598 : _
- GOSUB 12990 : _
- IF Found THEN _
- GOSUB 9500 : _
- ZMainUserFileIndex = ZUserFileIndex : _
- CALL SetPrompt : _
- CALL XferType (2,ZTrue) _
- ELSE ZUserFileIndex = 0 : _
- ZMainUserFileIndex = 0
- IF ZLocalUserMode OR NOT ZLocalUser THEN _
- CALL UpdtCalr ("Exited Conference",1)
- GOSUB 2350
- ZUplds = ZGlobalUplds
- ZDnlds = ZGlobalDnlds
- ZDLToday! = ZGlobalDLToday!
- ZBytesToday! = ZGlobalBytesToday!
- ZDLBytes! = ZGlobalDLBytes!
- ZULBytes! = ZGlobalULBytes!
- ZBankTime = ZGlobalBankTime 'Pe 03/21/90
- 5360 ZConfMode = ZFalse
- SubBoard = ZTrue
- GOSUB 12987
- RETURN 108
- 5370 RemoteSysop = (ZActiveUserName$ = ZSysopPswd1$ + " " + ZSysopPswd2$)
- ZWasA = RemoteSysop
- ZGlobalSysop = (ZGlobalSysop OR (ZWasA AND ZOrigCnfg$ = ZConfigFileName$))
- IF ZGlobalSysop THEN _
- ZWasA = ZTrue
- RETURN
- 5375 IF ((ZUserSecLevel < ZAutoUpgradeSec) AND SubBoard) OR _
- ((ZUserSecLevel < OrigUpgradeSec) AND NOT SubBoard) THEN _
- IF ZUserSecLevel <> ZOrigSec THEN _
- ZUserSecLevel = ZOrigSec : _
- LSET ZSecLevel$ = MKI$(ZUserSecLevel)
- RETURN
- '
- ' ***** UPDATE CURRENT USERS RECORD ****
- '
- 5380 IF ZUserFileIndex < 1 THEN _
- RETURN
- IF ZAdjustedSecurity AND NOT ZSysop THEN _
- LSET ZSecLevel$ = MKI$(ZUserSecLevel) : _
- ZUserSecSave = ZUserSecLevel
- ' IF SubBoard THEN _ 'DGS-ALS
- ' ZActiveUserName$ = ZOrigUserNameDGS$ : _ 'DGS-ALS
- ' ZFirstName$ = OrigFirstName$ 'DGS-ALS
- CALL UpdateU (ZFalse)
- RETURN
- '
- ' ***** RESTORE A USER RECORD ****
- '
- 5382 IF ZUserFileIndex < 1 THEN _
- ZUserSecLevel = ZDefaultSecLevel : _
- RETURN
- CALL OpenUser (HighestUserRecord)
- GET 5,ZUserFileIndex
- GOSUB 9500
- RETURN
- '
- ' ***** R - COMMAND FROM UTILITY MENU (REVIEW PROFILE) ****
- '
- 5400 CALL QuickTPut (Chr$(12),0) 'Pe 02/03/90
- CALL QuickTPut1 ("Your PROFILE ................")
- 5410 CALL Toggle(-9)
- GOSUB 43020
- ZFF = INSTR(ZDefaultXfer$,ZUserXferDefault$)
- CALL Toggle(-5)
- GOSUB 42810
- CALL Toggle(-3)
- CALL Toggle(-6)
- CALL Toggle(-7)
- CALL Toggle(-10)
- CALL Toggle(-2)
- CALL Toggle(-4)
- CALL Toggle(-8)
- CALL Toggle(-1)
- IF ZRestrictByDate AND ZDaysInRegPeriod > 0 THEN _
- IF ZUserSecLevel > ZExpiredSec THEN _
- CALL QuickTPut1 ("Registration expires " + ZExpirationDate$)
- RETURN
- '****************** Pe 02/03/90 **********************
- 5450 CALL QuickTPut (Chr$(12),0)
- CALL QuickTPut ("Your Current setup...",1)
- CALL QuickTPut ("USER NAME : " + ZActiveUserName$,1)
- CALL QuickTPut ("SECURITY :" + STR$(ZUserSecSave),1)
- CALL QuickTPut ("PASSWORD : " + ZPswdSave$,1)
- CALL QuickTPut ("READ MSG. :" + STR$(ZLastMsgRead),1)
- CALL QuickTPut ("TIMES ON :" + STR$(ZTimesLoggedOn),1)
- CALL QuickTPut ("Last ON : " + ZLastDateTimeOnSave$,1)
- CALL QuickTPut ("DownLoads :" + STR$(ZDnlds),1)
- CALL QuickTPut ("Uploads :" + STR$(ZUplds),1)
- CALL QuickTPut ("DL-BYTES :" + STR$(ZDLBytes!),1)
- CALL QuickTPut ("UL-BYTES :" + STR$(ZULBytes!),1)
- IF ZRestrictByDate THEN _
- CALL QuickTPut ("EXPIRATION: " + ZExpirationDate$,1)
- CALL QuickTPut ("USER MODE : "+MID$("NoviceExpert",1 -6 * ZExpertUser,6),1)
- CALL QuickTPut ("Graphics : " + MID$("None AsciiColor",GR * 5 + 1,5),1)
- CALL QuickTPut ("Protocol : " + ZUserXferDefault$,1)
- CALL QuickTPut ("UPPER CASE: " + MID$("and lowerONLY", 1 - 9 * ZUpperCase,9),1)
- CALL QuickTPut ("Line Feeds: " + FNOFFON$(ZLineFeeds),1)
- CALL QuickTPut ("Nulls : " + FNOFFON$(ZNulls),1)
- CALL Toggle (-8)
- CALL Toggle (-5)
- CALL Toggle (-10)
- CALL Toggle (-2)
- CALL Toggle (-4)
- CALL AskMore ("",ZTrue,ZFalse,WasX,ZTrue)
- RETURN
- '******************* Pe 02/03/90 **********************
- '
- '
- '
- ' ***** B - COMMAND FROM UTILITY MENU (300 TO 450 BAUD CHANGE) ****
- '
- 5500 CALL BufFile ("UPLOADLG.SRT",WasX) 'Pe 02/03/90 ' Bh 122390
- CALL AskMore ("",ZTrue,ZFalse,WasX,ZTrue) 'Pe 02/03/90
- RETURN
- 5502 RETURN 10595 'Entry point when have double nested gosub
- '
- ' ***** V - COMMAND FROM MAIN MENU (VIEW CONFERENCES) ****
- '
- 5800 CALL ConfMail (MailCheckConfirm)
- ConfMailJoin = (ZHomeConf$ <> "")
- RETURN
- '
- ' * FORMAT MESSAGE HEADER INFORMATION FOR DISPLAY
- '
- 8000 IF ZRet THEN _
- RETURN
- 8020 IF MID$(ZMsgRec$,37,5) = "ALL " THEN _
- MsgTo$ = "ALL" : _
- GOTO 8040
- DGSMsgDimIndex = ZMsgDimIndex 'DGS-MNR
- DGSRecord$ = ZMsgRec$ 'DGS-MNR
- 8030 MsgTo$ = MID$(ZMsgRec$,37,22)
- IF (ZNewUserDGS AND INSTR(MsgTo$,"NEWUSER")) THEN _ 'DGS-NEW
- MsgTo$ = ZActiveUserName$ 'DGS-NEW
- CALL Trim (MsgTo$)
- 8040 IF LEN(MsgTo$) < 23 THEN _
- MsgTo$ = MsgTo$ + _
- SPACE$(23 - LEN(MsgTo$))
- Subject$ = MID$(ZMsgRec$,76,25)
- CALL Trim (Subject$)
- OrigSubject$ = Subject$
- IF ZPswdFailed THEN _
- Subject$ = WasSJ$
- 8050 MsgFrom$ = MID$(ZMsgRec$,6,31)
- CALL Trim (MsgFrom$)
- IF LEN(MsgFrom$) < 23 THEN _
- MsgFrom$ = MsgFrom$ + _
- SPACE$(23 - LEN(MsgFrom$))
- IF ZUserSecLevel >= ZSecChangeMsg THEN _
- Year$ = " Security:" + _
- STR$(MsgSec) _
- ELSE Year$ = ""
- IF MID$(ZMsgRec$,101,1) = "!" THEN _
- MID$(ZMsgRec$,1,1) = "!"
- ZOutTxt$ = ZFG1$ + "Msg #: " + _
- LEFT$(ZMsgRec$,5) + _
- Year$ + SPACE$ (22-LEN(Year$)) + ZConfName$
- Year$ = ZFG4$ + " Sent: " + _
- MID$(ZMsgRec$,68,8) + _
- " " + _
- MID$(ZMsgRec$,59,5)
- IF NOT ZRet THEN _
- IF ReadMsgs THEN _
- CALL QuickTPut1 (ZOutTxt$): _
- WasX$ = MsgFrom$ : _
- CALL CheckColor (WasX$,SubInHeader$,ZFG2$) : _
- CALL QuickTPut1 (ZFG2$ + " From: " + WasX$ + Year$) : _
- GOSUB 8076 : _
- WasX$ = MsgTo$ : _
- CALL CheckColor (WasX$,SubInHeader$,ZFG3$) : _
- CALL QuickTPut1 (ZFG3$ + " To: " + WasX$ + " " + ZFG2$ + Year$) : _
- CALL CheckColor (Subject$,SubInHeader$,ZFG4$) : _
- ZOutTxt$ = ZFG4$ + " Re: " + _
- Subject$ + ZEmphasizeOff$ _
- ELSE ZOutTxt$ = ZFG1$ + LEFT$(ZMsgRec$,5) + _
- " " + _
- MID$(ZMsgRec$,68,5) + _
- " " + _
- + ZFG2$ + LEFT$(MsgFrom$,18) + _
- " -> " + _
- + ZFG3$ + LEFT$(MsgTo$,19) + _
- " " + _
- + ZFG4$ + LEFT$(Subject$,24) + ZEmphasizeOff$ : _
- CALL CheckColor (ZOutTxt$,SubInHeader$,"") : _
- GOTO 8080
- IF QuickScanMsgs OR _
- ScanMsgs THEN _
- GOTO 8080 _
- ELSE GOTO 8077
- 8076 IF MID$(ZMsgRec$,123,6) = STRING$(6,0) OR _
- MID$(ZMsgRec$,123,6) = SPACE$(6) THEN _
- Year$ = " Rcvd: -NO-" : _
- RETURN
- Year$ = " Rcvd: " + _
- RIGHT$(STR$(ASC(MID$(ZMsgRec$,123,1))),2) + _
- "-" + _
- RIGHT$(STR$(ASC(MID$(ZMsgRec$,124,1))),2) + _
- "-" + _
- RIGHT$(STR$(ASC(MID$(ZMsgRec$,125,1))),2) + _
- " " + _
- RIGHT$(STR$(ASC(MID$(ZMsgRec$,126,1))),2) + _
- ":" + _
- RIGHT$(STR$(ASC(MID$(ZMsgRec$,127,1))),2)
- FOR WasI = 8 TO 15
- IF MID$(Year$,WasI,1) = " " THEN _
- MID$(Year$,WasI,1) = "0"
- NEXT
- FOR WasI = 17 TO 21
- IF MID$(Year$,WasI,1) = " " THEN _
- MID$(Year$,WasI,1) = "0"
- NEXT
- RETURN
- 8077 IF (NOT MsgToCaller) THEN _
- ZWasA = (MID$(ZMsgRec$,37,5) = "ALL ") : _
- IF NOT ZWasA THEN _
- GOTO 8080
- IF MsgFromCaller THEN _
- GOTO 8080
- Year$ = DATE$
- WasWK$ = TIME$
- MID$(ZMsgRec$,123,6) = CHR$(VAL(MID$(Year$,1,2))) + _
- CHR$(VAL(MID$(Year$,4,2))) + _
- CHR$(VAL(MID$(Year$,9,2))) + _
- CHR$(VAL(MID$(WasWK$,1,2))) + _
- CHR$(VAL(MID$(WasWK$,4,2))) + _
- CHR$(VAL(MID$(WasWK$,7,2)))
- GOSUB 12986
- PUT 1,ZMsgPtr(ZMsgDimIndex,1)
- GOSUB 12987
- 8080 GOSUB 12979
- ZOutTxt$ = ""
- RETURN
- '
- ' * UNCOMPRESS MESSAGE PRIOR TO DISPLAY
- '
- 9000 IF NOT ZJustSearching THEN _ 'Pe 02/05/90
- GOSUB 4656: _
- CALL SkipLine (1) : _
- ZLinesInMsg = 1 : _
- MsgDimXtra = 150 : _
- REDIM ZOutTxt$(MsgDimXtra) : _
- Remain$ = "" : _
- HiLitedLine = 0
- FOR WasX = 2 TO VAL(MID$(ZMsgRec$,117,4))
- WasJ = 1
- GET 1
- IF ZJustSearching THEN _ 'Pe 02/05/90
- ZOutTxt$ = ZMsgRec$ : _
- CALL AllCaps (ZOutTxt$) : _
- HiLitePos = INSTR(ZOutTxt$,SearchString$) : _
- IF HiLitePos > 0 THEN _
- HiLiteRec = LOC(1) : _
- WasX = 9999 : _
- GOTO 9090 _
- ELSE GOTO 9090
- 9050 ZWasB = INSTR(WasJ,ZMsgRec$,CHR$(227))
- IF ZRet THEN _
- RETURN
- 9060 ZWasC = ZWasB - WasJ
- IF ZWasC < 0 THEN _
- ZWasC = 128
- 9070 ZOutTxt$ = MID$(ZMsgRec$,WasJ,ZWasC)
- IF HiLiteRec = LOC(1) THEN _
- IF HiLitePos >= WasJ AND HiLitePos < WasJ+ZWasC THEN _
- HiLiteRec = -1 : _
- Bracketed = ZTrue : _
- ZOutTxt$(0) = ZOutTxt$ : _
- CALL Bracket (ZOutTxt$,HiLitePos-WasJ+1,HiLitePos+LEN(SearchString$)-WasJ,ZEmphasizeOn$,ZEmphasizeOff$)
- IF ZWasB = 0 THEN _
- Remain$ = ZOutTxt$ : _
- GOTO 9090 _
- ELSE ZOutTxt$ = Remain$ + ZOutTxt$ : _
- Remain$ = "" : _
- WasJ = ZWasB + 1
- 9085 IF LEFT$(ZOutTxt$,1) = ZStartOfHeader$ OR _
- LEFT$(ZOutTxt$,LEN(ZScreenOutMsg$)) = ZScreenOutMsg$ THEN _
- GOTO 9050
- ZOutTxt$(ZLinesInMsg) = ZOutTxt$
- IF Bracketed THEN _
- Bracketed = ZFalse : _
- HiLitedLine = ZLinesInMsg
- ZLinesInMsg = ZLinesInMsg + 1
- IF ZLinesInMsg > MsgDimXtra THEN _
- ZLinesInMsg = ZLinesInMsg - 1 : _
- CALL SkipLine (1) : _
- CALL QuickTPut1 ("Message too long. Truncated to " + STR$(MsgDimXtra) + " lines!") : _
- ZOutTxt$ = "" : _
- RETURN
- IF NOT DontPrint THEN _ ' KG030201
- GOSUB 12979 : _ ' KG030201
- IF ZRet THEN _
- ZOutTxt$ = "" : _
- RETURN _ ' KG030201
- ELSE CALL AskMore ("",ZTrue,ZTrue,ZAnsIndex,ZFalse) : _ ' KG030201
- IF ZNo THEN _ ' KG030201
- DontPrint = ZTrue ' KG030201
- GOTO 9050
- 9090 NEXT
- IF DontPrint = ZTrue THEN _
- GOTO 5160
- IF ZJustSearching AND HiLitePos > 0 THEN _ 'Pe 02/05/90
- ZJustSearching = ZFalse : _ 'Pe 02/05/90
- GET 1,ZMsgPtr(ZMsgDimIndex,1) : _
- GOSUB 8000 : _
- GOTO 9000
- ZOutTxt$ = ""
- RETURN
- '
- ' * C - COMMAND FROM UTILITY MENU (CLOCK - TIME ON SYSTEM)
- 9099 GOSUB 9100 'Pe 02/11/89
- CALL BankTime
- CALL AskMore ("",ZTrue,ZFalse,WasX,ZTrue) 'Pe 02/11/89
- RETURN 'PE 02/11/89
- '
- 9100 CALL RptTime
- RETURN
- '
- ' * WRITE A RECORD TO THE RBBS-PC "USER" FILE
- '
- 9440 IF ZUserFileIndex > 0 AND ZUserFileIndex < 32768 THEN _
- PUT 5,ZUserFileIndex
- RETURN
- '
- ' * DEFINE USER FILE RECORD VARIABLES TO COMPENSATE FOR THE BUG IN QUICKBASIC
- ' * THAT REQUIRES A FIELD STATMENT TO BE EXECUTED WITHIN EACH SEPARATELY
- ' * COMPILED PROGRAM -- EVEN THOUGH A FIELD STATEMENT WAS EXECUTED WHEN THE
- ' * FILE WAS OPENED IN ANOTHER SEPERATELY COMPILED SUBROUTINE
- '
- 9450 IF LOF(5) < 1 THEN _
- ZWasDF$ = ZActiveUserFile$ : _
- RETURN 13600
- FIELD 5,31 AS ZUserName$, _
- 15 AS ZPswd$, _
- 2 AS ZSecLevel$, _
- 14 AS ZUserOption$, _
- 24 AS ZCityState$, _
- 2 AS MachineType$, _
- 1 AS ZBankTime$,_ 'SRK 030690
- 4 AS ZTodayDl$, _
- 4 AS ZTodayBytes$, _
- 4 AS ZDlBytes$, _
- 4 AS ZULBytes$, _
- 14 AS ZLastDateTimeOn$, _
- 3 AS ZListNewDate$, _
- 2 AS ZUserDnlds$, _
- 2 AS ZUserUplds$, _
- 2 AS ZElapsedTime$
- FIELD 5,128 AS ZUserRecord$
- RETURN
- '
- ' * GET USER DEFAULTS
- '
- 9500 GOSUB 9450
- GOSUB 5370
- IF ZWasA THEN _
- ZUserSecLevel = ZSysopSecLevel _
- ELSE ZUserSecLevel = CVI(ZSecLevel$)
- ZLastMsgRead = CVI(MID$(ZUserOption$,3,2))
- if len(ZBankTime$) = 0 then ZBankTime$ = chr$(0) 'SRK 030690
- ZBankTime = ASC(ZBankTime$) 'SRK 030690
- ZUserXferDefault$ = MID$(ZUserOption$,5,1)
- IF ZUserXferDefault$ = " " THEN _
- ZUserXferDefault$ = "N"
- CALL XferType (2,ZTrue)
- WasX = ASC(MID$(ZUserOption$,6,1))
- ZWasGR = (WasX MOD 3)
- ZBoldText$ = CHR$(48 - (WasX > 50))
- ZUserTextColor = (WasX - ZWasGR)/3 + 21
- IF ZUserTextColor > 37 THEN _
- ZUserTextColor = ZUserTextColor - 7
- IF ZEmphasizeOff$ <> "" THEN _
- CALL QuickTPut (ZColorReset$,0)
- IF ZEmphasizeOnDef$ <> "" THEN _
- ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + ";40;" + MID$(STR$(ZUserTextColor),2) + "m" _
- ELSE ZEmphasizeOff$ = ""
- IF ZWasGR = 1 AND NOT ZEightBit THEN _
- ZWasGR = 0
- CALL SetGraphic (ZWasGR, ZUserGraphicDefault$)
- ZRightMargin = CVI(MID$(ZUserOption$,7,2))
- IF ZRightMargin > 72 THEN _
- ZRightMargin = 72
- ZWasCI$ = ZCityState$
- CALL Trim (ZWasCI$)
- 9510 UserOptions = CVI(MID$(ZUserOption$,9,2))
- ZPromptBell = (UserOptions AND 1) > 0
- ZExpertUser = (UserOptions AND 2) > 0
- CALL SetExpert
- ZNulls = (UserOptions AND 4) > 0
- ZUpperCase = (UserOptions AND 8) > 0
- ZLineFeeds = (UserOptions AND 16) > 0
- ZCheckBulletLogon = (UserOptions AND 32) > 0
- ZSkipFilesLogon = (UserOptions AND 64) > 0
- ZAutoDownDesired = (UserOptions AND 128) > 0
- ZReqQuesAnswered = (UserOptions AND 256) > 0
- ZMailWaiting = (UserOptions AND 512) > 0
- WasX = (UserOptions AND 1024 ) > 0
- CALL SetHiLite (NOT WasX)
- IF NOT ZHiLiteOff THEN _
- CALL QuickTPut (ZEmphasizeOff$,0)
- ZTurboKeyUser = (UserOptions AND 2048) > 0
- ZTurboKey = ZFalse
- GOSUB 11480
- ZPageLength = ASC(MID$(ZUserOption$,13,1))
- IF SubBoard THEN _
- GOTO 9520
- WasX$ = ZEchoer$
- ZEchoer$ = MID$(ZUserOption$,14,1)
- IF INSTR("ICR",ZEchoer$) = 0 THEN _
- ZEchoer$ = "R"
- IF WasX$ <> ZEchoer$ THEN _
- GOSUB 9525
- CALL SetEcho (ZEchoer$)
- 9520 ZNul$ = MID$(STRING$(5,0),1, - 5 * ZNulls)
- CALL SetCrLf
- ZUseTPut = (ZUpperCase OR ZXOnXOff)
- ZPswdSave$ = ZPswd$
- RETURN
- 9525 IF ZEchoer$ = "R" THEN _
- ZOutTxt$ = "RBBS now set" _
- ELSE IF ZEchoer$ = "C" THEN _
- ZOutTxt$ = "Please set your communications package" _
- ELSE ZOutTxt$ = "Intermediate host now set"
- CALL QuickTPut1 (ZOutTxt$ + " to echo what you type")
- RETURN
- '
- ' * B - COMMAND FROM MAIN MENU (READ BULLETINS)
- '
- 9700 ReturnOn$ = "*SN"
- WasA1$ = ZBulletinMenu$
- 9701 CALL SubMenu ("Choose one, or L to list this menu again, or [RETURN] for Main Menu",_ ' Bh
- WasA1$, ZBulletinPrefix$,"",ReturnOn$,_
- ZUserGraphicDefault$,ZFalse,ZFalse,ZFalse,"")
- IF ZWasQ = 0 THEN _
- RETURN
- CALL CheckCarrier
- IF ZSubParm = -1 THEN _
- RETURN 10595
- IF (ZWasZ$ = "*" OR ZWasZ$ = "S") THEN _
- ZPrevPrefix$ = "" : _
- GOTO 9760
- ZStopInterrupts = ZFalse
- IF ZWasZ$ = "N" THEN _
- GOSUB 1242 : _
- IF WasZ <> 0 THEN _
- CALL QuickTPut1 ("No NEWS available") : _
- GOTO 9701 _
- ELSE GOTO 9703
- CALL BufFile (ZFileName$,ZAnsIndex)
- 9703 CALL UpdtCalr ("Read bulletin " + ZFileName$,1)
- GOTO 9701
- '
- ' * CHECK AND REVIEW NEW BULLETINS SINCE Last LOGON
- '
- 9750 CALL CheckNewBul (BoardCheckDate$,NumNewBullets,NewBullets$)
- RETURN
- 9760 ' **** [entry when want review plus chance to read] *********
- GOSUB 9750
- IF NumNewBullets > 0 THEN _
- ZLastIndex = NumNewBullets + 1 : _
- ZOutTxt$ = "Read ALL new bulletins ([Y],N)" : _
- GOSUB 12999 : _
- IF NOT ZNo THEN _
- ZAnsIndex = 1: _
- GOTO 9700
- ZLastIndex = 0
- IF ZAnsIndex < 1 THEN _
- RETURN
- GOTO 9701
- '
- ' * W - COMMAND FROM MAIN MENU (WHO'S ON THE OTHER NODES)
- '
- 9800 CALL WhosOn (NodesInSystem)
- CALL AskMore ("",ZTrue,ZFalse,WasX,ZTrue) 'Pe 02/11/89
- GOSUB 5344
- RETURN
- '
- '*** CHAt Mod ***********
- 9801' IF NodesInSystem < 2 THEN _ 'CHT021301
- ' RETURN
- ' ZOutTxt$ = "CHAT with another Node Y/[N] "
- ' GOSUB 12999
- ' IF NOT ZYes THEN _
- ' RETURN
- ' CALL CBChat(NodesInSystem)
- ' GOSUB 5344
- ' RETURN
-
- '
- ' * 1 - COMMAND FROM SYSOP MENU (DISPLAY COMMENTS)
- '
- 10070 'CALL Muzak (7) 'Pe 02/04/90
- ZFileName$ = ZCmntsFile$
- IF NOT ZStopInterrupts THEN _
- ZOutTxt$ = "* Ctrl-K(^K) / ^X aborts. ^S suspends, ^Q resumes *" : _
- GOSUB 12976
- GOSUB 20150
- RETURN
- '
- ' * U - COMMAND FROM UTILITY MENU (DISPLAY USERS)
- ' * 2 - COMMAND FROM SYSOP MENU (DISPLAY USERS)
- '
- 10090 'CALL Muzak (6) 'Pe 02/04/90
- ZOutTxt$ = "List - U)sers, R)ecent callers"
- CALL SkipLine (1)
- GOSUB 12930
- IF ZWasQ = 0 THEN _
- RETURN
- CALL AllCaps (ZUserIn$(ZAnsIndex))
- ON INSTR("UR",ZUserIn$(ZAnsIndex)) + 1 GOTO 10090,10096,10093
- 10093 IF (ZUserSecLevel < ZSysopSecLevel) OR NodesInSystem <=1 THEN _ 'PE Cal
- CALL DispCall : RETURN 'CAL
- ZOutTxt$ = "Display which node: (1-"+STR$(NodesInSystem)+")" 'CAL
- CALL SkipLine (1) 'CAL
- GOSUB 12999 'CAL
- IF VAL(ZUserIn$(ZAnsIndex)) > NodesInSystem THEN RETURN 'CAL
- IF LEN(ZUserIn$(ZAnsIndex)) = 0 THEN RETURN 'CAL
- ZCallersFile$ = LEFT$(ZCallersFile$,LEN(ZCallersFile$)-1) + _ 'CAL
- ZUserIn$(ZAnsIndex) 'CAL
- CALL SetCall 'CAL
- CALL DispCall 'CAL
- ZCallersFile$ = ZOrigCallers$ 'CAL
- CALL SetCall 'CAL
- RETURN 'DGS-CAL
- 10096 UserRecordHold$ = ZUserRecord$
- GOSUB 12700
- CALL OpenUser (HighestUserRecord)
- GOSUB 9450
- ZStopInterrupts = ZFalse
- ZNonStop = (ZPageLength < 1)
- WasI = 1
- ZWasZ$ = ZSysopPswd1$ + " " + ZSysopPswd2$
- 10097 IF WasI > HighestUserRecord OR ZRet THEN _
- GOTO 10099
- GET 5,WasI
- WasX$ = MID$(ZUserRecord$,ZStartHash,ZLenHash)
- IF ASC(WasX$)=0 OR LEFT$(WasX$,3)=" " OR LEFT$(ZPswd$,3)=" " THEN _
- GOTO 10098
- IF INSTR(WasX$,ZWasZ$) > 0 OR ZSysopSecLevel <= CVI(MID$(ZUserRecord$,47,2)) THEN _
- IF NOT ZSysop THEN _
- GOTO 10098
- CALL AskMore ("",ZTrue,ZTrue,WasXX,ZFalse)
- IF ZNo OR ZSubParm = -1 THEN _
- GOTO 10099
- ZOutTxt$ = LEFT$(WasX$,36) + ZCityState$ + ZLastDateTimeOn$
- GOSUB 12979
- 10098 WasI = WasI + 1
- GOTO 10097
- 10099 ZOutTxt$ = ""
- LSET ZUserRecord$ = UserRecordHold$
- ZStopInterrupts = ZTrue
- RETURN
- '
- ' * 3 - COMMAND FROM SYSOP MENU (RECOVER MESSAGES)
- '
- 10390 MsgRecovered = ZFalse
- 10391 ZOutTxt$ = "Recover Msg #" + ZPressEnter$
- GOSUB 12932
- CALL CheckInt (ZUserIn$(ZAnsIndex))
- IF ZErrCode <> 0 THEN _
- GOTO 10391
- MsgToRecover = ZTestedIntValue
- IF MsgToRecover < 1 THEN _
- GOTO 10392
- GOSUB 5344
- ActionFlag = ZFalse
- CALL RecoverMsg (MsgToRecover,FirstMsgRecord,ActionFlag,ZConfName$) 'Pe 02/03/90
- MsgRecovered = MsgRecovered OR ActionFlag
- GOTO 10391
- 10392 IF MsgRecovered THEN _
- ActionFlag = ZTRUE : _
- GOTO 1900
- RETURN
- '
- ' * 4 - COMMAND FROM SYSOP MENU (DELETE COMMENTS)
- '
- 10530 ZOutTxt$ = "Delete comments (Y/[N])"
- GOSUB 12995
- IF ZYes THEN _
- CALL OpenOutW (ZCmntsFile$)
- CLOSE 2
- 10550 RETURN
- '
- ' * TIME LIMIT EXCEEDED EXIT
- '
- 10553 CALL UpdtCalr ("Time limit exceeded",1)
- CALL QuickTPut1 ("Sorry "+ZFirstName$ +" Your time limit has expired")
- GOTO 10562 'Pe 02/03/90
-
- '
- ' * Q - COMMAND FROM GLOBAL FUNCTIONS
- 10560 GOSUB 41000 'Pe 02/04/90
- IF ZExpertUser THEN Logoff$ = "L"
- ' IF ZYes AND ZConfMode AND _
- ' ZCmntsAsMsgs THEN LOGOZFF$ = "L"
- IF Logoff$ = "L" THEN 10562
- '
- 10562 GOSUB 9100 'Pe 02/03/90
- IF NOT ZSysop AND _
- ZUserSecLevel < ZSecExemptFromEpilog THEN _
- ZFileName$ = ZEpilog$ : _
- ' GOSUB 11520 ' Bh BETTER FIX THIS
- IF ZLocalUserMode OR NOT ZLocalUser THEN _
- CALL UpdtCalr ("Logged off",1)
- 'CALL Muzak (4) 'Pe 02/04/90
- GOTO 10595
- 10570 GOSUB 41000 'Pe 02/04/90
- CALL QuickTPut (" A)bort Logoff "+ ZCrLf$+ _
- " C)omment to Sysop then log off "+ZCrLf$ + _
- " G)o ahead Log me off (NO Comment) " + ZCrLf$ ,1)
- ZOutTxt$ = " Enter Choice (A,C,[G]) "
- ZSubParm = 1
- ZTurboKey = -ZTurboKeyUser
- CALL TGet
- CALL AllCaps (ZUserIn$)
- WasX = INSTR("ACG",ZUserIn$)
- IF ZUserIn$ = "" THEN _
- GetOut = ZTrue : _
- GOTO 10562
- ON WasX GOTO 10571,10572,10573
- GOTO 10573
- 10571 RETURN
- 10572 LogOff$ = "G"
- GetOut = ZTrue
- GOTO 1800
- 10573 GetOut = ZTrue
- LogOff$ = "L" 'Pe 02/04/89
- GOTO 10560
- '10574 GOSUB 9099 'Pe 03/20/90
- ' GOTO 10570
- 10590 CALL UpdtCalr ("Sleep Disconnect",1)
- SubBoard = ZFalse
- 10595 CALL GetTime
- GOSUB 13700
- IF ZDnldCompleted = ZTrue AND ZAutoEnd = 1 THEN _ 'AUTOLOGOFF MOD
- GOSUB 46000 'Pe 02/03/90
- ZSubParm = 0
- CALL Carrier
- IF ZSubParm = -1 THEN _
- GOTO 10597
- IF ZConfName$ = OrigMsgName$ THEN _
- GetOut = ZTrue
- IF (SubBoard AND (NOT GetOut) AND (NOT ZSleepDisconnect)) THEN _
- GOSUB 5380 : _
- ZHomeConf$ = "M" : _
- CALL QuickTPut1 ("Time limit exceeded in " + ZConfName$) : _
- SubBoard = ZFalse : _
- GOTO 1205
- 10597 CALL UpdateU (ZTrue)
- GOTO 13540
- 10620 CALL UpdtCalr(ZWasLG$(ZLogonErrorIndex),2)
- IF ZExitToDoors THEN _
- CALL UpdateU (ZTrue)
- 10621 IF ZActiveUserName$ = "" THEN _
- ZActiveUserName$ = "NAME UNAVAILABLE"
- ZWasZ$ = ZActiveUserName$ + _
- " on at " + _
- ZCurDate$ + _
- ", " + _
- ZTime$ + _
- "** LOGON DENIED **, " + _
- ZBaudParity$
- ZWasNG$ = ZWasZ$ + _
- SPACE$(128 - LEN(ZWasZ$))
- 10698 'CALL Muzak (5) 'Pe 02/04/90
- IF ZFunctionKey = 22 THEN _
- GOTO 13545
- ZOutTxt$ = "Access denied!"
- GOSUB 12976
- CALL DelayTime (8 + ZBPS)
- GOTO 13545
- '
- ' * M - COMMAND FROM UTILITY MENU (CHANGE MARGINS)
- '
- 10925 UtilMarginChange = ZTrue
- GOSUB 3100
- UtilMarginChange = ZFalse
- RETURN
- '
- ' * 7 - COMMAND FROM SYSOP MENU (EXIT TO DOS)
- '
- 10930 IF ZDosVersion < 2 OR _
- (ZRequiredRings = 0 AND NOT ZNoDoorProtect) THEN _
- CALL QuickTPut1 ("Remote DOS unavailable") : _
- RETURN
- 10932 IF ZLocalUser AND NOT ZDebug THEN _
- CALL QuickTPut1 ("Only for remote SYSOP's") : _
- RETURN
- CALL DosExit
- ZSubParm = -9
- CALL FindFKey
- GOTO 202
- '
- ' * D - COMMAND FROM MAIN MENU (EXIT TO DOORS)
- '
- 10970 IF NOT ZDoorsAvail OR _
- (ZRequiredRings = 0 AND NOT ZNoDoorProtect) THEN _
- CALL QuickTPut1 ("No doors available !") : _
- RETURN
- IF ZTimeLock AND 1 AND NOT ZHasDoored THEN _
- CALL TimeLock : _
- IF NOT ZOK THEN _
- RETURN
- 10974 WasA1$ = ZMenu$(5)
- ' CALL Talk (5,ZOutTxt$) 'Pe 02/04/90
- ZStackC = ZTrue
- CALL SubMenu ("Choose one, or L to display this menu again" + ZPressEnterExpert$, _ ' Bh
- WasA1$,"",".BAT","",_
- ZUserGraphicDefault$,ZTrue,ZFalse,ZTrue,"")
- IF ZWasQ = 0 THEN _
- RETURN
- IF ZSubParm = -1 THEN _
- RETURN 10595
- 10986 ZWasZ$ = ZFileName$
- CALL DoorExit
- RETURN
- '
- ' * 5 - COMMAND FROM SYSOP MENU (USER FILE MAINTENANCE)
- '
- 11000 WasTU = ZUserFileIndex
- CALL DefaultU
- UserRecordHold$ = ZUserRecord$
- RegDateHold$ = ZRegDate$
- 11001 ZStopInterrupts = ZTrue
- WasI = 1
- ScanUsers = ZFalse
- IF EditFromRead = 1 THEN GOTO 11341
- ZTurboKey = -ZTurboKeyUser
- ZOutTxt$ = "A)dd, L)st, P)rt, M)od, S)can users"
- GOSUB 12998
- 11003 IF ZWasQ = 0 THEN _
- IF EditFromRead > 0 THEN _
- GOTO 11325 _
- ELSE _
- ZUserFileIndex = WasTU : _
- GOTO 20093
- WasQQ = 0
- ZWasZ$ = LEFT$(ZUserIn$(1),1)
- CALL AllCaps (ZWasZ$)
- IF ZWasZ$ = "A" THEN _
- GOTO 12300 _
- ELSE IF ZWasZ$ = "M" THEN _
- ZStopInterrupts = ZTrue _
- ELSE IF ZWasZ$ = "P" THEN _
- WasQQ = ZTrue _
- ELSE IF ZWasZ$ = "S" THEN _
- ScanUsers = ZTrue : _
- ZStopInterrupts = ZTrue _
- ELSE IF ZWasZ$ <> "L" THEN _
- GOTO 11001
- 11005 CALL OpenUser (HighestUserRecord)
- GOSUB 9450
- WasZ = 1
- IF ScanUsers THEN _
- ZOutTxt$ = "Scan for N)ame, P)wd, C)" + ZUserLocation$ + ", L)evel" + _
- LEFT$(", H)ash id",-9*(ZStartHash > 1 AND ZLenHash > 0)) : _
- GOSUB 12999 : _
- ZOutTxt$ = "" : _
- ScanFunction$ = LEFT$(ZUserIn$(1),1) : _
- CALL AllCaps (ScanFunction$) : _
- ZCR = 0 : _
- GOSUB 12979 : _
- GOSUB 12966 : _
- GOTO 12962
- 11010 FOR WasJ = WasZ TO HighestUserRecord
- GET 5,WasJ
- 11015 WasX$ = MID$(ZUserRecord$,ZStartHash,ZLenHash)
- IF ASC(WasX$) = 0 OR LEFT$(WasX$,3) = " " THEN _
- GOTO 11310
- WasOF = CVI(ZSecLevel$)
- IF WasOF > ZUserSecLevel THEN _
- IF NOT ZGlobalSysop THEN _
- GOTO 11310
- ZOutTxt$ = ZFG4$ + RIGHT$(" " + STR$(LOC(5)),4) + _
- ":" + _
- ZFG1$ + ZUserName$ + _
- ZFG2$ + "SECURITY" + _
- RIGHT$(" " + STR$(WasOF),5) + _
- " "
- 11020 ZOutTxt$ = ZOutTxt$ + _
- ZFG3$ + "Password = " + _
- ZPswd$ + ZEmphasizeOff$
- 11025 IF WasQQ THEN _
- CALL Printit (ZOutTxt$)
- 11027 GOSUB 12979
- IF ZRet <> 0 THEN _
- GOTO 11330
- IF WasOF < OrigMainSec THEN _
- ZOutTxt$ = ZEmphasizeOn$ + "<Locked out>" + ZEmphasizeOff$ + SPACE$(7) : _
- GOTO 11030
- IF WasOF >= ZSysopSecLevel THEN _
- ZOutTxt$ = ZEmphasizeOn$ + " (SYSOP) " + ZEmphasizeOff$ + SPACE$(8) : _
- GOTO 11030
- ZOutTxt$ = SPACE$(19)
- 11030 ZOutTxt$ = ZOutTxt$ + _
- ZLastDateTimeOn$ + _
- " " + _
- ZFG4$ + ZCityState$ + ZEmphasizeOff$
- 11100 IF WasQQ THEN _
- CALL Printit (ZOutTxt$)
- 11101 CALL QuickTPut1 (ZOutTxt$)
- IF ZRet <> 0 THEN _
- GOTO 11330
- ZOutTxt$ = " DOWNLOADS = " + _
- RIGHT$(" " + STR$(CVI(ZUserDnlds$)),5) + _
- " " + _
- "UPLOADS = " + _
- RIGHT$(" " + STR$(CVI(ZUserUplds$)),5) + _
- " " + _
- " Times on ="
- ZOutTxt$ = ZOutTxt$ + RIGHT$(" " + STR$(CVI(MID$(ZUserOption$,1,2))),5) + _
- " " + _
- "TIME USED = " + _
- RIGHT$(" " + STR$(CVI(ZElapsedTime$)),4) + _
- " Min"
- IF WasQQ THEN _
- CALL Printit (ZOutTxt$)
- 11105 CALL QuickTPut1 (ZOutTxt$)
- IF ZRet <> 0 THEN _
- GOTO 11330 'Pe 02/03/90
- ZOutTxt$ = "BYTES: Dwn=" + STR$(CVS(ZDlBytes$)) + _
- " Up=" + STR$(CVS(ZULBytes$)) + _
- " TODAY Dwn: #=" + STR$(CVS(ZTodayDl$)) + _
- " Bytes=" + STR$(CVS(ZTodayBytes$)) +ZCrLF$ + _
- " Banked Time=" + STR$(ASC(ZBankTime$)) 'Pe 03/21/90
- IF WasQQ THEN _
- CALL Printit (ZOutTxt$)
- CALL QuickTPut1 (ZOutTxt$)
- IF ZRet <> 0 THEN _
- GOTO 11330
- 11106 IF (ZStartIndiv = 0 OR ZLenIndiv = 0) AND _
- (ZStartHash = 0 OR ZLenHash = 0) AND _
- NOT ZRestrictByDate THEN _
- GOTO 11107
- IF (ZStartHash > 1 AND ZLenHash > 0) THEN _
- ZOutTxt$ = "Hash: " + MID$(ZUserRecord$,ZStartHash,ZLenHash) _
- ELSE ZOutTxt$ = ""
- IF (ZStartIndiv > 1 AND ZLenIndiv > 0) THEN _
- ZOutTxt$ = ZOutTxt$ + " Indiv: " + MID$(ZUserRecord$,ZStartIndiv,ZLenIndiv)
- IF ZRestrictByDate THEN _
- GOSUB 11480 : _
- ZOutTxt$ = ZOutTxt$ + " Registered: " + _
- RegDisplayDate$
- CALL QuickTPut1 (ZOutTxt$)
- IF WasQQ THEN _
- CALL Printit (ZOutTxt$)
- IF ZRet <> 0 THEN _
- GOTO 11330
- 11107 IF NOT ZStopInterrupts THEN _
- GOTO 11310
- 11110 ZOutTxt$ = "D)el,F)ind,M)enu,N)ewPW,P)rnt,R)eset gr,Q)uit" +ZCrLf$
- ZOutTxt$ = ZOutTxt$ +"S)ecLvl,U)ser#,X)fers,T)imeUsed,B)ankTime" 'Pe 03/21/90
- IF ZRestrictByDate THEN _
- ZOutTxt$ = ZOutTxt$ + _
- ",$)RegDate"
- GOSUB 12999
- IF NOT ScanUsers AND ZWasQ = 0 THEN _
- GOTO 11310
- 11115 ZWasZ$ = LEFT$(ZUserIn$(1),1)
- CALL AllCaps (ZWasZ$)
- WasX = INSTR("DNPQFSMR$UXTB",ZWasZ$) 'Pe 03/21/90
- IF ZWasZ$ = "" AND ScanUsers THEN _
- GOTO 12965
- ON WasX GOTO 11130,11160,11220,11320,11340,11390,11330,11400,11450,11127,11490,11420,11430 ' Pe 03/21/90
- GOTO 11110
- 11125 WasZ = VAL(ZUserIn$)
- IF WasZ < 1 OR WasZ > HighestUserRecord THEN _
- GOTO 11127
- GOTO 11010
- 11127 ZOutTxt$ = "What record #"
- GOSUB 12995
- GOTO 11125
- '
- ' * D - COMMAND FROM 5- USER MAINTENANCE OPTIONS (DELETE USER)
- '
- 11130 ZOutTxt$ = "Delete user (Y/[N])"
- GOSUB 12995
- IF ZYes THEN _
- LSET ZUserName$ = CHR$(0) + _
- "deleted user" : _
- LSET ZSecLevel$ = MKI$(ZMinLogonSec - 1) : _
- LSET ZLastDateTimeOn$ = "01-01-80" + _
- " " + _
- ZTimeLoggedOn$
- GOTO 11290
- '
- ' * N - COMMAND FROM 5- USER MAINTENANCE OPTIONS (CHANGE USER PASSWORD)
- '
- 11160 GOSUB 12800
- GOTO 11290
- '
- ' * P - COMMAND FROM 5- USER MAINTENANCE OPTIONS (PRINT USER FILE)
- '
- 11220 WasQQ = NOT WasQQ
- GOTO 11015
- 11290 ZUserFileIndex = LOC(5)
- GOSUB 12989
- GOSUB 9440
- GOSUB 12991
- ZUserFileIndex = 0
- GOTO 11015
- 11310 IF ScanUsers THEN _
- GOTO 12965
- 11311 NEXT
- '
- ' * Q - COMMAND FROM 5- USER MAINTENANCE OPTIONS (QUIT TO MAIN MENU)
- '
- 11320 ZUserFileIndex = WasTU
- LSET ZUserRecord$ = UserRecordHold$
- ZRegDate$ = RegDateHold$
- IF EditFromRead > 0 THEN _
- GOTO 11325
- RETURN 1200
- 11325 ZReply = ZFalse
- JustReplied = ZTrue
- QuotedReply = ZTrue
- EditFromRead = 0
- CALL GetMsgAttr
- DontPrint = ZTrue
- ZUserIn$ = "="
- GOTO 4560
- '
- ' * M - COMMAND FROM 5- USER MAINTENANCE OPTIONS (MAIN USER MAINT. MENU)
- '
- 11330 CLOSE 2
- IF EditFromRead > 0 THEN _
- EditFromRead = 2
- GOTO 11001
- '
- ' * F - COMMAND FROM 5- USER MAINTENANCE OPTIONS (FIND USER)
- '
- 11340 ZOutTxt$ = ZPromptHash$ + _
- " to find"
- CALL SkipLine (1)
- GOSUB 12995
- IF ZWasQ = 0 THEN _
- GOTO 11340
- TempHashValue$ = ZUserIn$
- 11341 IF LEN(TempHashValue$) < 3 OR LEN(TempHashValue$) > ZLenHash THEN _
- GOTO 11340
- CALL AllCaps (TempHashValue$)
- IF ZStartIndiv < 1 THEN _
- GOTO 11345
- 11342 ZOutTxt$ = ZPromptIndiv$ + _
- " to find"
- GOSUB 12995
- IF ZWasQ = 0 THEN _
- GOTO 11342
- TempIndivValue$ = ZUserIn$
- IF LEN(TempIndivValue$) > ZLenIndiv THEN _
- GOTO 11342
- CALL AllCaps (TempIndivValue$)
- 11345 GOSUB 12600
- GOSUB 12984
- ZUserFileIndex = 0
- IF Found THEN _
- GOTO 11015
- 11380 ZOutTxt$ = TempHashValue$ + _
- " " + _
- TempIndivValue$ + _
- " not found"
- GOSUB 12977
- GOTO 11310
- '
- ' * S - COMMAND FROM 5- USER MAINTENANCE OPTIONS (CHANGE USER SECURITY)
- '
- 11390 GOSUB 11395
- LSET ZSecLevel$ = MKI$(WasOF)
- GOTO 11290
- 11395 ZOutTxt$ = "New sec level"
- GOSUB 12995
- CALL AllCaps (ZUserIn$(1))
- ZWasZ$ = ZUserIn$(1)
- WasOF = VAL(ZWasZ$)
- IF WasOF > ZUserSecLevel THEN _
- WasOF = ZUserSecLevel
- RETURN
- '
- ' * R - COMMAND FROM 5- USER MAINTENANCE OPTIONS (RESET USER GRAPHICS)
- '
- 11400 ZWasA = CVI(MID$(ZUserOption$,9,2))
- ZWasA = ZWasA AND &HFAFF ' TURN HIGHLIGHTING OFF
- LSET ZUserOption$ = LEFT$(ZUserOption$,5) + _
- "0" + _
- MID$(ZUserOption$,7,2) + _
- MKI$(ZWasA) + _
- MID$(ZUserOption$,11)
- GOTO 11290
- '*****************************************************************
- '* T - COMMAND FROM 5---CHANGE TIME LEFT 'Pe 02/03/90 *
- '*****************************************************************
- 11420 ZOutTxt$ = ZCrLf$ + "Enter NEW value for Time used, (ENTER) = No Change"
- GOSUB 12995
- IF ZWasQ = 0 THEN _
- GOTO 11290
- LSET ZElapsedTime$ = MKI$(VAL(ZUserIn$(1)))
- GOTO 11290
- '
- '******************** Time BAnk Changes ******************
- '
- 11430 ZOutTxt$ = ZCrLf$ + "Enter NEW value for Time BANK, (ENTER) = No Change"
- GOSUB 12995
- IF ZWasQ = 0 THEN _
- GOTO 11290
- ZBankTime = VAL(ZUserIn$(1))
- LSET ZBankTime$ = CHR$(ZBankTime)
- GOTO 11290
- '
- ' * $ - COMMAND FROM 5 - USER MAINTENANCE (CHANGE REGISTRATION DATE)
- '
- 11450 ZOutTxt$ = "Enter new registration date (MM-DD-YY)"
- GOSUB 12995
- IF ZWasQ = 0 THEN _
- GOTO 11015
- 11455 WorkDate$ = ZUserIn$(1)
- IF LEN(WorkDate$) < 8 THEN _
- GOTO 11450
- GOSUB 11470
- IF NOT ZOK THEN _
- GOTO 11450
- LSET ZUserOption$ = LEFT$(ZUserOption$,10) + _
- ZRegDate$ + _
- MID$(ZUserOption$,13)
- GOSUB 11480
- ZRegDate$ = RegDateHold$
- GOTO 11290
- '
- ' * CALCULATE REGISTRATION DATES
- '
- 11470 IF LEN(WorkDate$) < 10 THEN _
- WorkDate$ = LEFT$(WorkDate$,6) + _
- "19" + _
- RIGHT$(WorkDate$,2)
- TodayRegYY = VAL(MID$(WorkDate$,7))
- TodayRegMM = VAL(LEFT$(WorkDate$,2))
- TodayRegDD = VAL(MID$(WorkDate$,4,2))
- ZOK = TodayRegYY > 1979 AND TodayRegMM > 0 AND _
- TodayRegMM < 13 AND TodayRegDD > 0 AND _
- TodayRegDD < 32
- IF ZOK THEN _
- CALL TwoByteDate (TodayRegYY,TodayRegMM,TodayRegDD,ZRegDate$)
- RETURN
- 11480 WasX$ = MID$(ZUserOption$,11,2)
- IF CVI(WasX$) <> 0 THEN _
- ZRegDate$ = WasX$ : _
- ELSE GOSUB 11482
- CALL UnPackDate (ZRegDate$,UserRegYY,UserRegMM,UserRegDD,RegDisplayDate$)
- IF CVI(WasX$) = 0 THEN _
- RegDisplayDate$ = "00-00-00"
- RETURN
- 11482 WorkDate$ = DATE$
- GOTO 11470
- '
- ' * X - COMMAND FROM 5 - USER MAINTENANCE (CHANGE XFER COUNTERS) *
- '
- 11490 CALL QuickTPut1 ("[ENTER] leaves unchanged")
- ZOutTxt$ = "Upload file total"
- GOSUB 12995
- IF LEN(ZUserIn$(1)) > 0 THEN _
- LSET ZUserUplds$ = MKI$(VAL(ZUserIn$(1)))
- ZOutTxt$ = "Upload BYTE total"
- GOSUB 12995
- IF LEN(ZUserIn$(1)) > 0 THEN _
- LSET ZULBytes$ = MKS$(VAL(ZUserIn$(1)))
- ZOutTxt$ = "Download file total"
- GOSUB 12995
- IF LEN(ZUserIn$(1)) > 0 THEN _
- LSET ZUserDnlds$ = MKI$(VAL(ZUserIn$(1)))
- ZOutTxt$ = "Download BYTE total"
- GOSUB 12995
- IF LEN(ZUserIn$(1)) > 0 THEN _
- LSET ZDlBytes$ = MKS$(VAL(ZUserIn$(1)))
- ZOutTxt$ = "Files downloaded TODAY"
- GOSUB 12995
- IF LEN(ZUserIn$(1)) > 0 THEN _
- LSET ZTodayDl$ = MKS$(VAL(ZUserIn$(1)))
- ZOutTxt$ = "Bytes downloaded TODAY"
- GOSUB 12995
- IF LEN(ZUserIn$(1)) > 0 THEN _
- LSET ZTodayBytes$ = MKS$(VAL(ZUserIn$(1)))
- GOTO 11290
- '
- ' * ALLOW USERS TO ANSWER A "QUESTIONNAIRE" BASED ON THE RBBS-PC SCRIPT
- '
- 11520 CALL AskUsers ' Bh BETTER FIX THIS
- IF NOT ZOK THEN _
- RETURN
- IF ZAdjustedSecurity THEN _
- GOSUB 12989 : _
- LSET ZSecLevel$ = MKI$(ZUserSecLevel) : _
- GOSUB 9440 : _
- GOSUB 12991 : _
- CALL SetPrompt : _
- CALL XferType (2,ZTrue) : _
- GOSUB 5135
- REDIM ZOutTxt$(ZMsgDim)
- IF ZSubParm = -1 THEN _
- RETURN 10595
- ZOK = ZTrue
- RETURN
- '
- ' * A - COMMAND FROM 5- USER MAINTENANCE OPTIONS (ADD USER)
- '
- 12300 WasA1$ = ""
- Attempts = 0
- UserSecLevelSave = ZUserSecLevel
- FirstNameSave$ = ZFirstName$
- LastNameSave$ = ZLastName$
- ActiveUserNameSave$ = ZActiveUserName$
- CityStateSave$ = ZWasCI$
- HashValueSave$ = HashValue$
- IndivValueSave$ = IndivValue$
- GOSUB 12500
- GOSUB 12840
- GOSUB 12850
- GOSUB 12598
- IF ZUserFileIndex = 0 THEN _
- GOSUB 12984 : _
- GOTO 12330
- IF Found THEN _
- WasD$ = "User already exists" : _
- GOSUB 1315 : _
- GOSUB 12984 : _
- GOTO 12330
- 12310 GOSUB 12630
- GOSUB 12800
- GOSUB 11395
- ZTempSecLevel = WasOF
- GOSUB 12900
- LSET ZLastDateTimeOn$ = ZCurDate$ + _
- " " + _
- ZTimeLoggedOn$
- GOSUB 12960
- CALL AllCaps (ZUserIn$)
- LSET ZCityState$ = ZUserIn$
- LSET ZElapsedTime$ = MKI$(0)
- IF ZStartHash > 1 THEN _
- MID$(ZUserRecord$,ZStartHash,ZLenHash) = HashValue$
- IF ZStartIndiv > 1 THEN _
- MID$(ZUserRecord$,ZStartIndiv,ZLenIndiv) = IndivValue$
- GOSUB 9440
- 12320 GOSUB 12991
- 12330 ZUserSecLevel = UserSecLevelSave
- ZFirstName$ = FirstNameSave$
- ZLastName$ = LastNameSave$
- ZActiveUserName$ = ActiveUserNameSave$
- ZWasCI$ = CityStateSave$
- HashValue$ = HashValueSave$
- IndivValue$ = IndivValueSave$
- ZUserFileIndex = WasTU
- LSET ZUserRecord$ = UserRecordHold$
- GOTO 11001
- '
- ' * GET USER First AND Last NAMES
- '
- 12500 IF Attempts > 5 THEN _
- ZFF = ZTrue : _
- RETURN
- 12510 GOSUB 12700
- Attempts = Attempts + 1
- ZOutTxt$ = WasA1$ + _
- ZFirstNamePrompt$
- CALL SkipLine (1)
- ZLogonActive = ZTrue
- GOSUB 12555
- ZLogonActive = ZFalse
- CALL Trim (ZWasZ$)
- ZFirstName$ = ZWasZ$
- 12530 ZOutTxt$ = WasA1$ + _
- ZLastNamePrompt$
- ZParseOff = ZTrue
- GOSUB 12555
- 12540 CALL Trim (ZWasZ$)
- ZLastName$ = ZWasZ$
- IF LEN(ZLastName$) < 2 THEN _
- IF LEN(ZFirstName$) > 2 THEN _
- GOTO 12500
- IF (LEN(ZFirstName$) + LEN(ZLastName$)) > 30 THEN _
- GOTO 12500
- IF UserSecLevelSave < ZSysopSecLevel THEN _
- IF (LEN(ZFirstName$) < 2 OR LEN(ZLastName$) < 2) THEN _
- GOTO 12500 _
- ELSE IF LEFT$(ZFirstName$,1)=" " OR LEFT$(ZLastName$,1)=" " THEN _
- GOTO 12500
- 12550 ZActiveUserName$ = MID$(ZFirstName$ + " " + ZLastName$,1,31)
- IF HashIndiv > 1 THEN _
- IF ZWasQ < 3 THEN _
- GOSUB 12558 : _
- IF ZNo THEN _
- GOTO 12500
- ZWasZ$ = ZFirstName$
- RETURN
- '
- ' * CHECK FOR NAMES NOT ALLOWED
- '
- 12555 GOSUB 12932
- IF ZWasQ = 0 THEN _
- RETURN 12500
- 12556 ZWasZ$ = ZUserIn$(ZAnsIndex)
- 12557 CALL AllCaps (ZWasZ$)
- CALL RemNonAlf (ZWasZ$,31,91)
- RETURN
- 12558 ZOutTxt$ = "Are you '" + _
- ZActiveUserName$ + _
- "' ([Y],N)"
- GOSUB 12995
- RETURN
- 12570 Found = ZFalse
- CALL OpenWork (2,ZTrashcanFile$)
- IF ZErrCode = 53 THEN _
- GOTO 710
- 12580 IF EOF(2) THEN _
- RETURN
- INPUT #2,InvalidName$
- IF ZWasZ$ <> InvalidName$ THEN _
- GOTO 12580
- Found = ZTrue
- RETURN
- 12595 CALL QuickTPut1 ("Name not valid here. Call recorded")
- CALL UpdtCalr ("Name violation: "+ZActiveUserName$,1)
- GOTO 10621
- '
- ' * COMMON SEARCH USER FILE ROUTINE
- '
- 12598 TempHashValue$ = HashValue$
- TempIndivValue$ = IndivValue$
- 12600 GOSUB 4910
- GOSUB 12988
- IF ZInConfMenu THEN _
- IF NOT ZPrivateDoor THEN _
- CALL QuickTPut1 ("Checking Users...")
- 12605 CALL OpenUser (HighestUserRecord)
- GOSUB 9450
- CALL FindUser (TempHashValue$,TempIndivValue$,ZStartHash,ZLenHash,_
- ZStartIndiv,ZLenIndiv,HighestUserRecord,Found,_
- ZUserFileIndex,ZWasSL)
- IF Found THEN _
- RETURN
- IF CurUserCount < (HighestUserRecord-1)*.95 THEN _
- RETURN
- ZOutTxt$ = "No room for new users in " + ZConfName$
- CALL UpdtCalr (ZOutTxt$,2)
- IF ZActiveUserFile$ <> ZMainUserFile$ THEN _
- ZUserFileIndex = 0 : _
- RETURN
- IF ZRememberNewUsers AND NOT ZSurviveNoUserRoom THEN _
- GOSUB 1397
- ZUserFileIndex = 0
- IF ZSurviveNoUserRoom THEN _
- ZRememberNewUsers = ZFalse
- RETURN
- '
- ' * AUGMENT USER COUNT, LOCK 4 REC BLOCK IN USER, UNLOCK FILES
- '
- 12630 GOSUB 23000
- CurUserCount = CurUserCount + (ZWasSL = 0) * ZRememberNewUsers
- 12632 GOSUB 24000
- GOSUB 12985
- IF ZRememberNewUsers THEN _
- GOSUB 12989
- GOSUB 12990
- RETURN
- '
- ' * INFORM USER OF WHAT CONFERENCE USER FILE HE IS VIEWING
- '
- 12700 IF ZConfMode THEN _
- ZOutTxt$ = "Users of " + _
- ZConfName$ + _
- ":" : _
- GOSUB 12979
- RETURN
- '
- ' * GET PASSWORD FROM NEWUSER
- '
- 12800 CALL NewPassword ("Enter PASSWORD you'll use to logon again",ZFalse)
- IF ZSubParm < 0 THEN _
- GOTO 202
- IF UserSecLevelSave < ZSysopSecLevel THEN _
- IF ZUserIn$ = SPACE$(LEN(ZUserIn$)) THEN _
- GOTO 12800
- LSET ZPswd$ = ZWasZ$
- RETURN
- '
- ' * GET HASH VALUE FOR CURRENT USER TO LOOK UP IN THE USER'S FILE
- '
- 12840 IF ZStartHash = 1 THEN _
- HashValue$ = ZActiveUserName$ : _
- RETURN
- WasX$ = WasA1$ + _
- ZPromptHash$
- CALL UntilRight (WasX$,HashValue$,2,ZLenHash)
- RETURN
- '
- ' * GET FIELD TO INDIVIDUATE ONE USER FROM ANOTHER (NAME FIELD IS DEFAULT)
- '
- 12850 IF ZStartIndiv < 1 THEN _
- RETURN
- IF ZStartIndiv = 1 THEN _
- IndivValue$ = ZActiveUserName$ : _
- RETURN
- WasX$ = WasA1$ + _
- ZPromptIndiv$
- CALL UntilRight (WasX$,IndivValue$,2,ZLenIndiv)
- RETURN
- '
- ' * SET NEWUSER DEFAULTS
- '
- 12900 LSET ZUserName$ = ZActiveUserName$
- LSET ZUserOption$ = MKI$(0) + _
- MKI$(0) + _
- " 0" + _
- MKI$(64) + _
- MKI$(16) + _
- MKI$(0) + _
- CHR$(23) + _
- ZDefaultEchoer$
- LSET ZUserDnlds$ = MKI$(0)
- LSET ZUserUplds$ = MKI$(0) 'Pe 02/16/90
- LSET ZTodayDl$ = MKS$(0)
- LSET ZTodayBytes$ = MKS$(0)
- LSET ZDlBytes$ = MKS$(0)
- LSET ZULBytes$ = MKS$(0)
- LSET ZSecLevel$ = MKI$(ZTempSecLevel)
- LSET ZElapsedTime$ = MKI$(0)
- LSET ZBankTime$ = CHR$(0) 'Pe 03/25/90
- RETURN
- 12930 ZTurboKey = -ZTurboKeyUser
- 12932 CALL PopCmdStack
- GOTO 12997
- '
- ' * GET CITY AND STATE FROM NEWUSER
- '
- 12960 ZOutTxt$ = WasA1$ + _
- ZUserLocation$
- GOSUB 12995
- IF ZWasQ = 0 THEN _
- GOTO 12960
- IF ZUserIn$ = SPACE$(LEN(ZUserIn$)) THEN _
- GOTO 12960
- CALL AllCaps (ZUserIn$)
- LSET ZCityState$ = ZUserIn$
- ZWasCI$ = ZUserIn$
- RETURN
- '
- ' * S - COMMAND FROM 5 - USER MAINTENANCE OPTIONS (SCAN USERS)
- '
- 12962 WasX = 0
- ZFF = ZFalse
- ZMacroMin = 99
- ZOutTxt$ = "String to search"
- GOSUB 12998
- IF ZWasQ = 0 THEN _
- GOTO 11001
- CALL AllCaps (ZUserIn$)
- WasWK$ = ZUserIn$
- IF ScanFunction$ = "L" THEN _
- WasWK$ = "," + _
- STR$(VAL(WasWK$)) + _
- ","
- 12963 GET 5,WasI
- GOSUB 12966
- WasX = INSTR(ScanField$,WasWK$)
- IF WasX > 0 THEN _
- GOTO 11015
- 12965 WasI = WasI + 1
- IF WasI > HighestUserRecord THEN _
- LSET ZUserRecord$ = UserRecordHold$ : _
- GOTO 11001
- WasX = 0
- GOTO 12963
- 12966 ZFF = INSTR("NCPLH",ScanFunction$)
- 12967 ON ZFF GOTO 12968,12969,12970,12972,12971
- GOTO 11001
- '
- ' * N - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (SEARCH FOR NAME)
- '
- 12968 ScanField$ = ZUserName$
- RETURN
- '
- ' * C - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (SEARCH FOR CITY/ST)
- '
- 12969 ScanField$ = ZCityState$
- RETURN
- '
- ' * P - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (SEARCH FOR PASSWORD)
- '
- 12970 ScanField$ = ZPswd$
- RETURN
- '
- ' * H - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (SEARCH FOR HASH ID)
- '
- 12971 IF ZStartHash > 0 AND ZLenHash > 0 THEN _
- ScanField$ = MID$(ZUserRecord$,ZStartHash,ZLenHash)
- RETURN
- '
- ' * L - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (SEARCH FOR LEVEL)
- '
- 12972 ScanField$ = "," + _
- STR$(CVI(ZSecLevel$)) + _
- ","
- RETURN
- '
- ' * CALLS INTO SEPARATELY COMPILED SUBROUTINES (RBBS-SUB)
- '
- '
- ' * STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL OUTPUT ROUTINE
- '
- 12975 ZSubParm = 1
- GOTO 12981
- 12976 ZSubParm = 2
- GOTO 12981
- 12977 ZSubParm = 3
- GOTO 12981
- 12978 ZSubParm = 4
- GOTO 12981
- 12979 ZSubParm = 5
- GOTO 12981
- 12980 ZSubParm = 6
- 12981 CALL TPut
- 12983 IF ZSubParm < 0 THEN _
- GOTO 202
- IF ZSubParm = 8 THEN _
- GOSUB 12995
- RETURN
- '
- ' * STANDARD ENTRY FOR RBBS-PC'S FILE LOCKING WHEN RUNNING MULTIPLE RBBS-PC'S
- '
- 12984 ZSubParm = 1 ' LOCK USERS & MESSAGES
- GOTO 12994
- 12985 ZSubParm = 2 ' UNLOCK MESSAGES AND FLUSH
- Flushed = ZTrue
- GOTO 12994
- 12986 ZSubParm = 3 ' LOCK MESSAGES
- GOTO 12994
- 12987 ZSubParm = 4 ' UNLOCK MESSAGES
- GOTO 12994
- 12988 ZSubParm = 5 ' LOCK USERS
- GOTO 12994
- 12989 ZSubParm = 6 ' LOCK USER BLOCK
- GOTO 12994
- 12990 ZSubParm = 7 ' UNLOCK USERS
- GOTO 12994
- 12991 ZSubParm = 8 ' UNLOCK USER BLOCK
- GOTO 12994
- 12992 ZSubParm = 9 ' LOCK COMMENTS/UPLOAD DIR
- GOTO 12994
- 12993 ZSubParm = 10 ' UNLOCK COMMENTS/UPLOAD DIR
- 12994 CALL FileLock
- IF Flushed THEN _
- FIELD 1,128 AS ZMsgRec$ : _
- Flushed = ZFalse
- IF ZSubParm = -1 THEN _
- ZSubParm = -9 : _
- CALL FindFKey : _
- GOTO 202
- RETURN
- '
- ' * STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL INPUT ROUTINE
- '
- 12995 GOSUB 12997
- ZSubParm = 1
- 12996 CALL TGet
- 12997 IF ZSubParm < 0 THEN _
- GOTO 202
- RETURN
- 12998 ZOutTxt$ = ZOutTxt$ + _
- ZPressEnter$
- GOTO 12995
- 12999 ZTurboKey = -ZTurboKeyUser
- GOTO 12995
- '
- ' * MAIN SYSTEM ERROR TRAP - ALL ERRORS PASS THROUGH THIS ROUTINE
- '
- 13000 IF ZDebug THEN _
- ZOutTxt$ = "DEBUG Trap ERL=" + _
- STR$(ZWasEL) + _
- " ERR=" + _
- STR$(ZErrCode) : _
- CALL Printit(ZOutTxt$) : _
- WasD$ = ZOutTxt$ : _
- GOSUB 1315
- IF ZWasEL = 1905 AND ZErrCode = 63 THEN _
- CLOSE 1 : _
- KILL ZActiveMessageFile$ : _
- GOTO 5350
- IF ZWasEL = 4371 AND ZErrCode = 6 THEN _
- GOTO 1200
- IF ZWasEL = 4740 THEN _
- GOTO 4745
- IF ZWasEL = 5151 AND ZErrCode = 62 THEN _
- CALL UpdtCalr (ZPswdFile$ + " bad format!",2) : _
- GOTO 5160
- 13500 CALL LogError
- CALL QuickTPut1 (ZCallersRecord$)
- GOTO 1200
- '
- ' * COMMON EXIT FROM RBBS-PC (I.E. "ABANDON ALL HOPE OH YE WHO ENTER HERE")
- '
- 13538 CALL UpdtCalr ("No calls. Recycling.",1)
- GOTO 13549
- 13540 IF ZLocalUser THEN _
- IF NOT ZLocalUserMode THEN _
- GOTO 13549
- 13543 IF (NOT ZSysop) THEN _
- IF ((ZUserFileIndex = 0 AND ZRememberNewUsers) OR _
- ZNewUser = ZTrue) THEN _
- GOTO 13549
- 13545 CALL UpdateC
- 13549 GOSUB 13700
- IF ZLocalUser OR _
- ZModemOffHook THEN _
- GOTO 13555
- OUT ZModemCntlReg,INP(ZModemCntlReg) AND 254
- CALL DelayTime (ZDTRDropDelay)
- OUT ZModemCntlReg,INP(ZModemCntlReg) OR 1
- 13553 CALL DelayTime (ZDTRDropDelay)
- CALL TakeOffHook
- 13555 ZActiveMessageFile$ = ZOrigMsgFile$
- GOSUB 12986
- GOSUB 5344
- GET 1,ZNodeRecIndex
- MID$(ZMsgRec$,57,1) = "I"
- MID$(ZMsgRec$,40,2) = " 0"
- MID$(ZMsgRec$,72,2) = " 0"
- IF MID$(ZMsgRec$,101,2) = ZCarriageReturn$+ZCarriageReturn$ THEN _ ' KG030602
- MID$(ZMsgRec$,101,2) = " 0" ' KG030602
- PUT 1,ZNodeRecIndex
- GOSUB 12985
- CLOSE 1,2,3,4,5
- IF ZRecycleToDos THEN _
- GOTO 203
- RUN 100
- 13600 CLS
- LOCATE ,,0
- CALL PScrn (ZWasDF$ + " file not found/invalid. Run CONFIG.")
- CALL DelayTime (3)
- GOTO 203
- 13700 IF ZMsgFileLock THEN _
- GOSUB 12987
- 13710 IF ZUserFileLock THEN _
- GOSUB 12990
- 13720 IF ZUserBlockLock THEN _
- GOSUB 12991
- RETURN
- '
- ' * C/R - COMMAND FROM 5 - USER MAINTENANCE SCAN FUNCTION (QUIT TO MAIN MENU)
- '
- 20093 LSET ZUserRecord$ = UserRecordHold$
- GOSUB 9500
- 20095 RETURN 1200
- '
- ' * V - COMMAND FROM FILES MENU (VIEW ARC CONTENTS)
- '
- 20140 CALL GetArc
- IF ZSubParm = -1 THEN _
- GOTO 13540
- IF ZDenyAccess THEN _
- GOTO 1386
- RETURN
- '
- ' * GO TO THE FILE SYSTEM TO LIST THE SYSOP'S COMMENTS
- '
- 20150 ZFileSysParm = 1
- GOTO 20200
- '
- ' * GO TO THE FILE SYSTEM TO LIST THE FILE DIRECTORIES
- '
- 20155 ZFileSysParm = 2
- GOTO 20200
- '
- ' * GO TO THE FILE SYSTEM TO DOWNLOAD FILES
- '
- 20160 ZFileSysParm = 3
- GOTO 20200
- '
- ' * GO TO THE FILE SYSTEM WHEN RETURNING FROM EXTERNAL PROTOCOLS
- '
- 20165 ZFileSysParm = 4
- GOTO 20200
- '
- ' * GO TO THE FILE SYSTEM TO UPLOAD FILES
- '
- 20170 ZFileSysParm = 5
- GOTO 20200
- '
- ' * GO TO THE FILE SYSTEM TO SCAN FILE SYSTEM DIRECTORIES
- '
- 20175 ZFileSysParm = 6
- GOTO 20200
- '
- ' * GO TO THE FILE SYSTEM TO HANDLE "PERSONAL" FILES
- '
- 20180 ZFileSysParm = 7
- GOTO 20200
- '
- ' * GO TO THE FILE SYSTEM TO LIST "NEW" FILES
- '
- 20185 ZFileSysParm = 8
- GOTO 20200
- '
- ' * RETURN TO THE FILE SYSTEM AFTER HANDLING EXTENDED FILE DESCRIPTIONS
- '
- 20190 ZFileSysParm = 9
- 20200 CALL FileSystem
- IF ZDnldCompleted AND ZAutoEnd = 1 THEN _
- GOTO 20235 'AUTO Loggoff Mod
- ON ZFileSysParm GOTO 20205, _
- 20210, _
- 20215, _
- 20220, _
- 20225, _
- 20230, _
- 20235
- 20205 RETURN
- 20210 RETURN 202
- 20215 RETURN 1200
- 20220 RETURN 1380
- 20225 ZSysopComment = ZTrue
- ZMaxMsgLines = ZMaxExtendedLines
- GOSUB 2008
- GOTO 20190
- 20230 RETURN 10553
- 20235 RETURN 10595
- '
- ' * GET MESSAGE HEADER RECORD DATA
- '
- 23000 GET 1,1
- HighMsgNumber = VAL(LEFT$(ZMsgRec$,8))
- AutoAddSec = CVI(MID$(ZMsgRec$,9,2))
- CallsToDate! = VAL(MID$(ZMsgRec$,11,10))
- CurUserCount = VAL(MID$(ZMsgRec$,57,5))
- FirstMsgRecord = VAL(MID$(ZMsgRec$,68,7))
- ZNextMsgRec = VAL(MID$(ZMsgRec$,75,7))
- HighestMsgRecord = VAL(MID$(ZMsgRec$,82,7))
- IF ZActiveMessageFile$ = ZOrigMsgFile$ THEN _
- NodesInSystem = VAL(MID$(ZMsgRec$,127))
- RETURN
- 23100 GET 1,ZNextMsgRec
- IF MID$(ZMsgRec$,61,1) = ":" THEN _
- CALL CheckInt (MID$(ZMsgRec$,117,4)) : _
- IF ZErrCode = 0 AND (ZTestedIntValue > 1) AND (ZTestedIntValue < 100) THEN _
- WasY = ZTestedIntValue : _
- CALL CheckInt (MID$(ZMsgRec$,2,4)) : _
- IF ZErrCode = 0 AND ZTestedIntValue > HighMsgNumber THEN _
- HighMsgNumber = ZTestedIntValue : _
- ZNextMsgRec = ZNextMsgRec + WasY : _
- CALL QuickTPut1 ("Correcting Msg Header") : _
- MsgCorrected = ZTrue : _
- GOTO 23100
- RETURN
- '
- ' * UPDATE MESSAGE HEADER RECORD DATA
- '
- 24000 MID$(ZMsgRec$,1,8) = STR$(HighMsgNumber)
- MID$(ZMsgRec$,11,10) = STR$(CallsToDate!)
- MID$(ZMsgRec$,57,5) = STR$(CurUserCount)
- MID$(ZMsgRec$,68,7) = STR$(FirstMsgRecord)
- MID$(ZMsgRec$,75,7) = STR$(ZNextMsgRec)
- MID$(ZMsgRec$,82,7) = STR$(HighestMsgRecord)
- PUT 1,1
- RETURN
- '
- ' * A - COMMAND FROM Library MENU (ARCHIVE A SELECTED Library DISK)
- '
- 30000 ZSubParm = 4
- ' CALL Library
- IF ZSubParm = -1 THEN _
- RETURN 10595
- RETURN
- '
- ' * C - COMMAND FROM Library MENU (CHANGE TO A Library DISK)
- '
- 30100 ZSubParm = 2
- ' CALL Library
- RETURN
- '
- ' * D - COMMAND FROM Library MENU (DOWNLOAD A DISK/FILE FROM Library)
- '
- 30200 IF ZTimeLock AND 2 AND NOT ZHasPrivDoor THEN _
- CALL TimeLock : _
- IF NOT ZOK THEN _
- RETURN
- IF ZLibDiskChar$ = "0000" THEN _
- CALL QuickTPut1 ("You must select a Library disk first!") : _
- RETURN
- ZSubParm = 3
- ' CALL Library
- GOTO 20160
- '
- ' * CALCULATE TIME REMAINING FOR USER
- '
- 41000 CALL CheckTimeRemain (MinsRemaining)
- IF ZSubParm = -1 THEN _
- RETURN 10553
- RETURN
- '
- ' * SHOW USER CURRENT ACCESS LEVEL
- '
- 41070 ZOutTxt$ = "Granted access level" + _
- STR$(ZUserSecLevel) + _
- MID$(" (SYSOP)",1,-8 * (ZUserSecLevel >= ZSysopSecLevel))
- GOSUB 12975
- RETURN
- '
- ' * NULLS SET FOR NEW USERS
- '
- 42700 CALL SkipLine (1)
- CALL QuickTPut1 ("TurboKey: act on 1 char command without waiting for [ENTER]")
- ZOutTxt$ = "Want TurboKeys (Y/[N])"
- GOSUB 12999
- ZTurboKeyUser = NOT ZYes
- CALL Toggle (8)
- RETURN
- '
- ' * F - COMMAND FROM UTILITY MENU (FILE Transfer DEFALUT MODE)
- ' * FILE Transfer DEFAULT SET FOR NEW USERS
- '
- 42800 ZFF = INSTR(ZDefaultXfer$,ZUserXferDefault$)
- IF ZFF = 0 THEN _
- ZFF = INSTR(ZInternalEquiv$,"N")
- CALL QuickTPut1 ("Current Protocol: "+MID$(ZDefaultXfer$,ZFF,1))
- 42805 ZOutTxt$ = "Default "
- CALL XferType (3,ZExpertUser)
- IF ZSubParm = -1 THEN _
- RETURN 10595
- ZUserXferDefault$ = ZWasFT$
- 42810 ZOutTxt$ = "Protocol: " + ZProtoPrompt$
- GOSUB 12979
- RETURN
- '
- ' * C - COMMAND FROM UTILITY MENU (CHANGE CASE Toggle)
- ' * UPPER/LOWER CASE SET FOR NEW USERS
- '
- 42850 GOSUB 9525
- 42851 ZOutTxt$ = "Change to R)BBS, C)aller's software" + _
- MID$(", I)ntermediate host",1,-20 * (ZHostEchoOn$ <> "")) + _
- ZPressEnterExpert$
- GOSUB 12930
- IF ZWasQ = 0 THEN _
- RETURN
- 42852 ZWasZ$ = LEFT$(ZUserIn$(ZAnsIndex),1)
- CALL AllCaps (ZWasZ$)
- IF INSTR("ICR",ZWasZ$) = 0 THEN _
- GOTO 42851
- ZEchoer$ = ZWasZ$
- CALL SetEcho (ZEchoer$)
- GOSUB 9525
- RETURN
- 42950 ZOutTxt$ = "CAN YOUR TERMINAL DISPLAY LOWER CASE ([Y]/N)"
- GOSUB 12995
- ZUpperCase = NOT ZNo
- CALL Toggle(3)
- RETURN
- '
- ' * G - COMMAND FROM UTILITY MENU (GRAPHICS WANTED)
- ' * Graphic MENUS SELECTION SET FOR NEW USERS
- '
- ' 43000 ZPrevPUI$ = "" 'ANSIEd ' Bh 110790
- 43000 GOSUB 43005
- GOTO 43022
- 43005 CALL AskGraphics
- IF ZSubParm = -1 THEN _
- RETURN 10595
- IF ZWasQ = 0 THEN _
- RETURN
- 43020 ZOutTxt$ = "Text Graphics: " + _
- MID$("None AsciiColor",ZWasGR * 5 + 1,5)
- GOSUB 12979
- RETURN
- ' 43022 ZPrevPUI$ = "" 'ANSIEd ' Bh 110790
- 43022 IF ZEmphasizeOnDef$ = "" THEN _
- RETURN
- ZOutTxt$ = "Do you want Color prompts ([Y],N)"
- GOSUB 12999
- ZHiLiteOff = NOT ZNo
- CALL Toggle(5)
- RETURN
- 43025 CALL Graphic (ZUserGraphicDefault$,ZFileName$)
- '
- ' * DISPLAY NON-BREAKABLE TEXT FILES
- '
- 43027 ZStopInterrupts = ZTrue
- CALL BufFile (ZFileName$,WasX)
- CALL Carrier
- IF ZSubParm = -1 THEN _
- RETURN 10595
- ZStopInterrupts = ZFalse
- RETURN
- '
- ' * MAKE INPUT STRING HIDDEN (USE *'S TO ECHO INPUT)
- '
- 45010 ZHidden = ZTrue
- GOSUB 12995
- ZHidden = ZFalse
- RETURN
- 46000 ZSubParm = 1
- ZOutTxt$ = "AutoLogOff Counter Active. Press [RETURN] to cancel" ' Bh
- IF ZLocalUser THEN _
- GOTO 46050
- CALL AbortLogOff
- IF ZWasQ = 0 THEN _
- CALL QuickTPut("Log Off Aborted.......",1) : _
- ZAutoEnd = 0 : _
- RETURN 1205
- GetOut = ZTrue
- 46050 RETURN 10597
-