ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/BBS/RBBS_PC/173_BAS.ZIP/RBBSSUB1.BAS

BASIC Source File | 1990-02-10 | 52.2 KB | 1,662 lines

' $linesize:132
' $title: 'RBBS-SUB1.BAS CPC17.3, Copyright 1986-90 by D. Thomas Mack'
'  Copyright 1990 by D. Thomas Mack, all rights reserved.
'  Name ...............: RBBSSUB1.BAS
'  First Released .....: February 11, 1990
'  Subsequent Releases.:
'  Copyright ..........: 1986-1990
'  Purpose.............:
'     Subprorams that require error trapping are incorporated
'     within RBBSSUB1.BAS as separately callable subroutines
'     in order to free up as much code as possible within
'     the 64WasK code segment used by RBBS-PC.BAS.
'  Parameters..........: Most parameters are passed via a COMMON statement.
'
' Subroutine  Line               Function of Subroutine
'   Name     Number
'  ChangeDir   20101   Change subdirectory
'  CheckInt    58360   Check input is valid integer
'  CommPut     59275   Write string to communications port
'  FindFile    59790   Determine whether a file exists without opening it
'  FindFree    51098   Find amount of space on the upload disk drive
'  FindItX     20219   Find if a file exists on a device
'  FindUser    12598   Find a user in the USERS file
'  FlushCom    20308   Read all characters in the communications port
'  GetCom       1418   Read a character from the communications port
'  GetPassword 58280   Read RBBS-PC's "PASSWORD" file
'  GETWRK      58330   Read record from file number 2
'  KillWork    58258   Delete a RBBS-PC "WORK" file
'  NetBIOS     20898   Lock/Unlock NetBIOS semaphore files
'  OpenCom       200   Open communications port (number 3)
'  OpenFMS     58188   Open the upload management system directory
'  OpenOutW    28218   Open RBBS-PC's "WORK" file (number 2) for output
'  OpenRSeq     1479   Open a sequential file (number 2) for random I/O
'  OpenUser     9398   Open the USER file (number 5)
'  OpenWork    57978   Open RBBS-PC's work file (number 2)
'  OpenWorkA   58340   Open RBBS-PC's "WORK" file (number 2) for append
'  Printit     13673   Print line on the local PC printer
'  PrintWork   58320   Print string to file #2 w/o CR/LF
'  PrintWorkA  58350   Print string to file #2 with CR/LF
'  PutCom      59650   Write to the communications port
'  PutWork     59660   Write to work file randomly
'  RBBSPlay    59680   Plays a musical string
'  ReadAny     58310   Read file number 2 into ZOutTxt$
'  ReadDef       112   Read configuration file
'  ReadDir     58290   Read entire lines
'  ReadParms   58300   Read certain number of parameters from file 2
'  Talk        59700   RBBS-PC Voice synthesizer support for sight impaired
'  SetCall       108   Find where next callers record is
'  UpdateC     43048   Update the caller's file with elasped session time
'  UpdtCalr    13661   Update to the caller's file
'
'  $INCLUDE: 'RBBS-VAR.BAS'
'
108 ' $SUBTITLE: 'SetCall - subroutine to find last callers rec'
' $PAGE
'
'  NAME    -- SetCall
'
'  INPUTS  --     PARAMETER                    MEANING
'
'  OUTPUTS --  ZCallersFileIndex!
'
'  PURPOSE --  To find where to leave off on callers file
'
    SUB SetCall STATIC
    ON ERROR GOTO 65000
    IF PrevCaller$ = ZCallersFile$ OR ZCallersFilePrefix$ = "" THEN _
       EXIT SUB
    PrevCaller$ = ZCallersFile$
    ZCallersFileIndex! = 1
    CLOSE 2
    CLOSE 4
    IF ZShareIt THEN _
       OPEN ZCallersFile$ FOR RANDOM SHARED AS #4 LEN=64 _
    ELSE OPEN "R",4,ZCallersFile$,64
    FIELD 4,64 AS ZCallersRecord$
    IF LOF(4) > 0 THEN _
       ZCallersFileIndex! = LOF(4) / 64
    IF ZCallersFileIndex! < 1 THEN _
       ZCallersFileIndex! = 0
    ZUserIn$ = STRING$(13,0)
110 GET 4,ZCallersFileIndex!
    IF ZErrCode > 0 THEN _
       ZErrCode = 0 : _
       ZCallersFileIndex! = 0 : _
       EXIT SUB
    IF LEFT$(ZCallersRecord$,13) = ZUserIn$ THEN _
       ZCallersFileIndex! = ZCallersFileIndex! - 1 : _
       GOTO 110
    END SUB

112 ' $SUBTITLE: 'ReadDef - subroutine to read RBBS-PC.DEF file'
' $PAGE
'
'  NAME    -- ReadDef
'
'  INPUTS  --     PARAMETER                    MEANING
'                ZConfigFileName$            NAME OF RBBS-PC.DEF FILE
'                ZSubParm = -62              ONLY READ THE .DEF FILE
'
'  OUTPUTS --  ALL THE RBBS-PC.DEF PARAMETERS
'
'  PURPOSE --  TO READ THE PARAMETERS FROM THE RBBS-PC.DEF FILE
'
     SUB ReadDef (ConfigFile$) STATIC
     ON ERROR GOTO 65000
'
' **** OPEN AND READ RBBS-PC CONFIGURATION DEFINITIONS ***
'
117 IF ZSubParm <> -62 THEN _
       IF PrevRead$ = ConfigFile$ THEN _
          EXIT SUB _
       ELSE PrevRead$ = ConfigFile$
    CLOSE 2
    ZBulletinSave$ = ZBulletinMenu$
    CALL OpenWork (2,ConfigFile$)
    ZCurDef$ = ConfigFile$
    INPUT #2,ZWasDF$, _
             ZDnldDrives$, _
             ZSysopPswd1$, _
             ZSysopPswd2$, _
             ZSysopFirstName$, _
             ZSysopLastName$, _
             ZRequiredRings, _
             ZStartOfficeHours, _
             ZEndOfficeHours, _
             ZMinsPerSession, _
             ZWasDF, _
             ZWasDF, _
             ZUpldDir$, _
             ZExpertUserDef, _
             ZActiveBulletins, _
             ZPromptBellDef, _
             ZWasDF, _
             ZMenusCanPause, _
             ZMenu$(1), _
             ZMenu$(2), _
             ZMenu$(3), _
             ZMenu$(4), _
             ZMenu$(5), _
             ZMenu$(6), _
             ZConfMenu$, _
             ZWasDF, _
             ZWelcomeInterruptable, _
             ZRemindFileXfers, _
             ZPageLengthDef, _
             ZMaxMsgLinesDef, _
             ZDoorsAvail, _
             ZWasDF$, _
             ZMainMsgFile$, _
             ZMainMsgBackup$
    INPUT #2, WasX$, _
              ZCmntsFile$, _
              ZMainUserFile$, _
              ZWelcomeFile$, _
              ZNewUserFile$, _
              ZMainDirExtension$
    CALL BreakFileName (WasX$,ZWasY$,ZWasDF$,ZWasZ$,ZFalse)
    IF ZWasDF$ <> "" THEN _
       ZCallersFile$ = WasX$
    INPUT #2, ZWasDF$
    IF ZComPort$ <> "COM0" THEN _
       IF NOT ZConfMode THEN _
          ZComPort$ = ZWasDF$
    INPUT #2, ZBulletinsOptional, _
              ZModemInitCmd$, _
              ZRTS$, _
              ZWasDF, _
              ZFG, _
              ZBG, _
              ZBorder
    IF ZConfMode THEN _
       INPUT #2, ZWasDF$, _
                 ZWasDF$ _
    ELSE INPUT #2, ZRBBSBat$ , _
                   ZRCTTYBat$
    INPUT #2,ZOmitMainDir$, _
             ZFirstNamePrompt$, _
             ZHelp$(3), _
             ZHelp$(4), _
             ZHelp$(7), _
             ZHelp$(9), _
             ZBulletinMenu$, _
             ZBulletinPrefix$, _
             ZWasDF$, _
             ZMsgReminder, _
             ZRequireNonASCII, _
             ZAskExtendedDesc, _
             ZMaxNodes, _
             ZNetworkType
    IF ZConfMode THEN _
         INPUT #2, ZwasDF _
    ELSE INPUT #2, ZRecycleToDos
    INPUT #2,ZWasDF, _
             ZWasDF, _
             ZTrashcanFile$
    INPUT #2,ZMinLogonSec, _
             ZDefaultSecLevel, _
             ZSysopSecLevel, _
             ZFileSecFile$, _
             ZSysopMenuSecLevel, _
             ZConfMailList$, _
             ZMaxViolations, _
             ZOptSec(50), _   ' SECURITY FOR ZSysop COMMANDS 1
             ZOptSec(51), _
             ZOptSec(52), _
             ZOptSec(53), _
             ZOptSec(54), _
             ZOptSec(55), _
             ZOptSec(56), _   ' ZSysop 7
             ZPswdFile$, _
             ZMaxPswdChanges, _
             ZMinSecForTempPswd, _
             ZOverWriteSecLevel, _
             ZDoorsTermType, _
             ZMaxPerDay
    INPUT #2,ZOptSec(1), _   ' SECURITY FOR MAIN MENU COMMANDS 1
             ZOptSec(2), _
             ZOptSec(3), _
             ZOptSec(4), _
             ZOptSec(5), _
             ZOptSec(6), _
             ZOptSec(7), _
             ZOptSec(8), _
             ZOptSec(9), _
             ZOptSec(10), _
             ZOptSec(11), _
             ZOptSec(12), _
             ZOptSec(13), _
             ZOptSec(14), _
             ZOptSec(15), _
             ZOptSec(16), _
             ZOptSec(17), _
             ZOptSec(18), _   ' MAIN COMMAND 18
             ZMinNewCallerBaud, _
             ZWaitBeforeDisconnect
    INPUT #2,ZOptSec(19), _      ' Security for FILE COMMANDS 1
             ZOptSec(20), _
             ZOptSec(21), _
             ZOptSec(22), _
             ZOptSec(23), _
             ZOptSec(24), _
             ZOptSec(25), _
             ZOptSec(26), _      ' FILE COMMAND 8
             ZOptSec(27), _      ' SECURITY FOR UTILITY COMMANDS 1
             ZOptSec(28), _
             ZOptSec(29), _
             ZOptSec(30), _
             ZOptSec(31), _
             ZOptSec(32), _
             ZOptSec(33), _
             ZOptSec(34), _
             ZOptSec(35), _
             ZOptSec(36), _
             ZOptSec(37), _
             ZOptSec(38), _   ' UTIL COMMAND 12
             ZOptSec(46), _   ' SECURITY FOR GLOBAL COMMANDS 1
             ZOptSec(47), _
             ZOptSec(48), _
             ZOptSec(49), _
             ZUpldTimeFactor!, _
             ZComputerType, _
             ZRemindProfile, _
             ZRBBSName$, _
             ZCmdsBetweenRings, _
             ZMNPSupport, _
             ZPagingPtrSupport$
    IF ZConfMode THEN _
         INPUT #2, ZwasDF _
    ELSE INPUT #2, ZModemInitBaud$
             IF ZErrCode > 0 THEN _
                EXIT SUB
118 INPUT #2, ZTurnPrinterOff,_    ' Turn printer off each recycle
              ZDirPath$, _    ' Where dir files are stored
              ZMinSecToView, _
              ZLimitSearchToFMS, _
              ZDefaultCatCode$, _
              ZDirCatFile$, _
              ZNewFilesCheck, _
              ZMaxDescLen, _
              ZShowSection, _
              ZCmndsInPrompt, _
              ZNewUserSetsDefaults, _
              ZHelpPath$, _
              ZHelpExtension$, _
              ZMainCmds$, _
              ZFileCmd$, _
              ZUtilCmds$, _
              ZGlobalCmnds$, _
              ZSysopCmds$
    INPUT #2, ZRecycleWait, _
              ZOptSec(39), _       ' SECURITY FOR Library COMMANDS 1
              ZOptSec(40), _
              ZOptSec(41), _
              ZOptSec(42), _
              ZOptSec(43), _
              ZOptSec(44), _
              ZOptSec(45), _       ' Library COMMANDS 7
              ZLibDrive$, _
              ZLibDirPath$, _
              ZLibDirExtension$, _
              ZLibWorkDiskPath$, _
              ZLibMaxDisk, _
              ZLibMaxDir, _
              ZLibMaxSubdir, _
              ZLibSubdirPrefix$, _
              ZLibArcPath$, _
              ZLibArcProgram$, _
              ZLibCmds$
'
' *****  ESTABLISH COMMUNICATION PORT REGISTERS AND COMMANDS   ***
' *****     GET DOS SUB-DIRECTORY RBBS-PC OPTIONS              ***
'
    INPUT #2, ZUpldPath$, _              ' Where upl dir goes
              ZMainFMSDir$, _       ' Shared dir in FMS
              ZAnsMenu$, _
              ZReqQues$,_
              ZRememberNewUsers,_
              ZSurviveNoUserRoom,_
              ZPromptHash$,_
              ZStartHash,_
              ZLenHash,_
              ZPromptIndiv$,_
              ZStartIndiv,_
              ZLenIndiv
    INPUT #2, ZBypassMsgs, _
              ZMusic, _
              ZRestrictByDate, _
              ZDaysToWarn, _
              ZDaysInRegPeriod, _
              ZVoiceType, _
              ZRestrictValidCmds, _
              ZNewUserDefaultMode, _
              ZNewUserLineFeeds, _
              ZNewUserNulls, _
              ZFastFileList$, _
              ZFastFileLocator$, _
              ZMsgsCanGrow, _
              ZWrapCallersFile$, _
              ZRedirectIOMethod, _
              ZAutoUpgradeSec, _
              ZHaltOnError, _
              ZNewPublicMsgsSec, _
              ZNewPrivateMsgsSec, _
              SecNeededToChangeMsgs, _
              ZSLCategorizeUplds, _
              ZBaudot, _
              ZHourMinToDropToDos, _
              ZExpiredSec, _
              ZDTRDropDelay, _
              ZAskID, _
              ZMaxRegSec, _
              ZBufferSize, _
              ZMLCom, _
              ZNoDoorProtect, _
              ZDefaultExtension$, _
              ZNewUserDefaultProtocol$, _
              ZNewUserGraphics$, _
              ZNetMail$, _
              ZMasterDirName$, _
              ZProtoDef$, _
              ZUpcatHelp$, _
              ZAllwaysStrewTo$, _
              ZLastNamePrompt$
119 INPUT #2, ZPersonalDrvPath$, _
              ZPersonalDir$, _
              ZPersonalBegin, _
              ZPersonalLen, _
              ZPersonalProtocol$, _
              ZPersonalConcat , _
              ZPrivateReadSec, _
              ZPublicReadSec, _
              ZSecChangeMsg
    IF ZConfMode THEN _
         INPUT #2, ZwasDF _
    ELSE INPUT #2, ZKeepInitBaud
    INPUT #2, ZMainPUI$
    IF ZConfMode THEN _
       INPUT #2, ZWasDF$,ZWasDF$,ZWasDF$ _
    ELSE INPUT #2, ZDefaultEchoer$, _
                   ZHostEchoOn$, _
                   ZHostEchoOff$
    INPUT #2, ZSwitchBack, _
              ZDefaultLineACK$, _
              ZAltdirExtension$, _
              ZDirPrefix$
    IF ZConfMode THEN _
       INPUT #2, ZWasDF, _
                 ZWasDF, _
                 ZWasDF _
    ELSE INPUT #2, ZWasDF,_
                   ZModemInitWaitTime, _
                   ZModemCmdDelayTime
    INPUT #2, ZTurboRBBS, _
              ZSubDirCount, _
              ZWasDF, _
              ZUpldToSubdir, _
              ZWasDF, _
              ZUpldSubdir$, _
              ZMinOldCallerBaud, _
              ZMaxWorkVar, _
              ZDiskFullGoOffline, _
              ZExtendedLogging
     IF ZConfMode THEN _
        INPUT #2, ZWasDF$, _
                  ZWasDF$, _
                  ZWasDF$, _
                  ZWasDF$ _
     ELSE INPUT #2, ZModemResetCmd$, _
                    ZModemCountRingsCmd$, _
                    ZModemAnswerCmd$, _
                    ZModemGoOffHookCmd$
     INPUT #2,ZDiskForDos$, _
              ZDumbModem, _
              ZCmntsAsMsgs
     IF ZConfMode THEN _
        INPUT #2, ZWasDF, _
                  ZWasDF, _
                  ZWasDF, _
                  ZWasDF, _
                  ZWasDF, _
                  ZWasDF _
     ELSE INPUT #2, ZLSB,_
                    ZMSB,_
                    ZLineCntlReg,_
                    ZModemCntlReg,_
                    ZLineStatusReg,_
                    ZModemStatusReg
     INPUT #2,ZKeepTimeCredits, _
              ZXOnXOff, _
              ZAllowCallerTurbo, _
              ZUseDeviceDriver$, _
              ZPreLog$, _
              ZNewUserQuestionnaire$, _
              ZEpilog$, _
              ZRegProgram$, _
              ZQuesPath$, _
              ZUserLocation$, _
              ZWasDF$, _
              ZWasDF$, _
              ZWasDF$, _
              ZEnforceRatios, _
              ZSizeOfStack, _
              ZSecExemptFromEpilog, _
              ZUseBASICWrites, _
              ZDosANSI, _
              ZEscapeInsecure, _
              ZUseDirOrder, _
              ZAddDirSecurity, _
              ZMaxExtendedLines, _
              ZOrigCommands$
     INPUT #2,ZLogonMailLevel$, _
              ZMacroDrvPath$, _
              ZMacroExtension$, _
              ZEmphasizeOnDef$, _
              ZEmphasizeOffDef$, _
              ZFG1Def$, _
              ZFG2Def$, _
              ZFG3Def$, _
              ZFG4Def$, _
              ZSecVioHelp$
     IF ZConfMode THEN _
        INPUT #2,ZWasDF _
     ELSE INPUT #2,ZFossil
     INPUT #2,ZMaxCarrierWait, _
              ZWasDF, _
              ZSmartTextCode, _
              ZTimeLock, _
              ZWriteBufDef, _
              ZSecKillAny, _
              ZDoorsDef$, _
              ZScreenOutMsg$, _
              ZAutoPageDef$
     IF ZErrCode > 0 THEN _
        EXIT SUB
     ZConfigFileName$ = ConfigFile$
     CALL EditDef
     END SUB
200 ' $SUBTITLE: 'OpenCom - subroutine to open the communications port'
' $PAGE
'
'  NAME    -- OpenCom
'
'  INPUTS  --     PARAMETER                    MEANING
'                BaudRate$                  BAUD TO OPEN MODEM
'                Parity$                    PARITY TO OPEN MODEM
'
'  OUTPUTS -- BaudTest!                     BAUD RATE TO SET RS232 AT
'
'  PURPOSE -- To open the communications port.
'
    SUB OpenCom (BaudRate$,Parity$) STATIC
    ON ERROR GOTO 65000
    IF ZFossil THEN _
       IF ZRTS$ = "YES" THEN _
          ZFlowControl = ZTrue : _
          Flow = &H00F2 : _
          CALL FosFlowCtl(ZComPort,Flow)
    IF INSTR(Parity$,"N") THEN _
       Parity = 2 : _                                     ' No PARITY
       DataBits = 3 : _                                   ' 8 DATA BITS
       StopBits = 0 _                                     ' 1 STOP BIT
    ELSE Parity = 3 : _                                   ' EVEN PARITY
         DataBits = 2 : _                                 ' 7 DATA BITS
         StopBits = 0                                     ' 1 STOP BIT
    IF NOT ZFossil THEN _
       GOTO 202
    IF Baudrate$ = "38400" THEN _
       ComSpeed = &H9600 _
    ELSE ComSpeed = VAL(BaudRate$)
    CALL FosSpeed(ZComPort,ComSpeed,Parity,DataBits,StopBits)
    EXIT SUB
202 CLOSE 3
    IF ZRTS$ = "YES" THEN _
       ZFlowControl = ZTrue : _
       WasX$ = ",CS26600,CD,DS" _
    ELSE WasX$ = ",RS,CD,DS"
    WasX = (VAL(BaudRate$) > 19200)
    IF WasX THEN _
       ZWasY$ = "19200" _
    ELSE ZWasY$ = BaudRate$
    OPEN ZComPort$ + ":" + ZWasY$ + Parity$ + WasX$ AS #3
'
' ****************************************************************************
' *  RAISE THE RTS SIGNAL IF THE MODEM USES RTS FOR MODEM FLOW CONTROL (ONCE
' *  IT IS RAISED, IT WILL STAY UP UNTIL THE REGISTER IS CLEARED OUT).
' ****************************************************************************
'
    END SUB
1418 ' $SUBTITLE: 'GetCom -- subroutine reads a char. from  comm. port'
' $PAGE
'
'  NAME    -- GetCom
'
'  INPUTS  --   PARAMETER     MEANING
'                 Strng$       STRING TO READ A CHARACTER INTO FROM
'                              THE COMMUNICATIONS PORT (FILE #3)
'
'  OUTPUTS --   Strng$
'
'  PURPOSE -- Reads a character from the communications port.
'
     SUB GetCom (Strng$) STATIC
     ON ERROR GOTO 65000
1420 IF ZFOSSIL THEN _
        CALL FOSRXChar(ZComPort,Char) : _
        Strng$ = CHR$(Char) _
     ELSE Strng$ = INPUT$(1,3)
1421 IF ZErrCode = 57 THEN _
        LineStatus = INP(ZLineStatusReg) : _
        ZErrCode = 0 : _
        GOTO 1420
     END SUB
1479 ' $SUBTITLE: 'OpenRSeq  - open sequential file randomly'
' $PAGE
'
'  NAME    -- OpenRSeq
'
'  INPUTS  -- PARAMETER             MEANING
'             FilName$      NAME OF SEQUENTIAL FILE TO OPEN AS #2
'
'  OUTPUTS -- NumRecs      NUMBER OF 128-BYTE RECORDS IN THE FILE
'             LenLastRec   NUMBER OF BYTES IN THE LAST RECORD (IT
'                          MAY BE LESS THAN OR EQUAL TO 128).
'
'  PURPOSE -- Open a sequential file as file #2 and read it randomly
'
     SUB OpenRSeq (FilName$,NumRecs,LenLastRec,RecLen) STATIC
     ON ERROR GOTO 65000
     CLOSE 2
1480 ZErrCode = 0
1481 IF ZShareIt THEN _
        OPEN FilName$ FOR RANDOM SHARED AS #2 LEN=RecLen _
     ELSE OPEN "R",2,FilName$,RecLen
     IF ZErrCode = 52 THEN _
        GOTO 1480
     FIELD #2, RecLen AS ZDnldRecord$
     WasI# = LOF(2)
     NumRecs = FIX(WasI#/RecLen)
     LenLastRec = WasI# - CDBL(NumRecs) * RecLen
     IF LenLastRec > 0 THEN _
        NumRecs = NumRecs + 1 _
     ELSE LenLastRec = RecLen
     END SUB
9398 ' $SUBTITLE: 'OpenUser - subroutine to open users file as #5'
' $PAGE
'
'  NAME    -- OpenUser
'
'  INPUTS  --     PARAMETER                    MEANING
'                 ZShareIt
'
'  OUTPUTS -- ZActiveUserFile$
'             ZCityState$
'             ZElapsedTime$
'             ZLastDateTimeOn$
'             LastRec                # OF Last RECORD IN USERS FILE
'             ZListNewDate$
'             ZPswd$
'             ZSecLevel$
'             ZUserDnlds$
'             ZUserName$
'             ZUserOption$
'             ZUserRecord$
'             ZUserUplds$
'
'  PURPOSE -- Open the user file as file #5
'
      SUB OpenUser (LastRec) STATIC
      ON ERROR GOTO 65000
'
' ****  OPEN AND DEFINE USER FILE RECORD VARIABLES  ****
'
9400 CLOSE 5
     IF ZShareIt THEN _
        OPEN ZActiveUserFile$ FOR RANDOM SHARED AS #5 LEN=128 _
     ELSE OPEN "R",5,ZActiveUserFile$,128
     WasI# = LOF(5)
     LastRec = FIX(WasI#/128)
     FIELD 5,31 AS ZUserName$, _
             15 AS ZPswd$, _
              2 AS ZSecLevel$, _
             14 AS ZUserOption$,  _
             24 AS ZCityState$, _
              3 AS MachineType$, _
              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$
     END SUB
12598 ' $SUBTITLE: 'FindUser - subroutine to search users file for a name'
' $PAGE
'
'  NAME    -- FindUser
'
'  INPUTS  --     PARAMETER                    MEANING
'             HashToLookFor$        STRING TO SEARCH FOR IN USERS
'             IndivToLookFor$       STRING TO USE TO INDIVIDUATE
'                                   USERS WITH SAME HASH
'             StartHashPos          WHERE HASH FIELD STARTS IN THE
'                                  "USERS" FILE
'             LenHashField          LENGTH OF THE HASH FIELD
'             StartIndivPos         WHERE THE FIELD TO DISTINGUISH
'                                   AMONG USERS (I.E. WITH THE SAME
'                                   NAME) STARTS IN THE "USERS" FILE
'                                   (SET TO 0 IF NONE TO BE USED)
'             LenIndivField         LENGTH OF FIELD TO DISTINGUISH
'                                   AMONG USERS
'             MaxPosition           HIGHEST RECORD TO SEARCH OR USE
'
'  NOTE: THIS SUBROUTINE ASSUMES THE "USERS" FILE IS OPEN AS FILE 2.
'
'  OUTPUTS -- WhetherFound          SET TO "TRUE" IF USER WAS Found
'                                   OTHERWISE IT IS "FALSE"
'             PosToUse              NUMBER OF THE "USERS" RECORD THAT
'                                   BELONGS TO THE USER (IF Found) OR
'                                   TO USE FOR THE USER (IF THE USER
'                                   WASN'T Found)
'             PosToReclaim          SET TO 0 IF THE RECORD NUMBER
'                                   SELECTED FOR THIS USER HAS NEVER
'                                   BEEN USED.
'
'  PURPOSE -- To search the "USERS" file and determine the record
'             number to use for the caller in the "USERS" file.
'
      SUB FindUser (HashToLookFor$,IndivToLookFor$,StartHashPos,_
                    LenHashField,StartIndivPos,LenIndivField,_
                    MaxPosition,WhetherFound,_
                    PosToUse,PosToReclaim) STATIC
      ON ERROR GOTO 65000
      ZErrCode = 0
      WhetherFound = 0
      IF HashToLookFor$ = SPACE$(LEN(HashToLookFor$)) THEN _
         EXIT SUB
      EmptyRec$ = SPACE$(LenHashField)
      EmptyIndiv$ = SPACE$(LenIndivField)
      NewUser$ = LEFT$("NEWUSER  ",LenHashField + 2)
      FIELD 5, 128 AS Filler$
      WasX$ = HashToLookFor$ + SPACE$(LenHashField - LEN(HashToLookFor$))
      CALL HashRBBS (HashToLookFor$,MaxPosition,PosToUse,ZWasDF)
12600 ZWasY$ = IndivToLookFor$ + SPACE$(LenIndivField - LEN(IndivToLookFor$))
      PosToReclaim = 0
12610 GET 5,PosToUse
      IF ZErrCode > 0 THEN _
         IF ZErrCode = 63 THEN _
            ZErrCode = 0 : _
            GOTO 12621 _
         ELSE ZErrCode = 0 : _
         GOTO 12620
      HashValue$ = MID$(Filler$,StartHashPos,LenHashField)
      IF WasX$ = HashValue$ THEN _
         IF StartIndivPos < 1 THEN _
           WhetherFound = ZTrue : _
           GOTO 12622 _
         ELSE IndivValue$ = MID$(Filler$,StartIndivPos,LenIndivField) : _
              IF ZWasY$ = IndivValue$ OR IndivValue$ = EmptyIndiv$ THEN _
                 WhetherFound = ZTrue : _
                 GOTO 12622
      IF HashValue$ = EmptyRec$ THEN _
         PosToUse = PosToReclaim - (PosToReclaim = 0) * PosToUse : _
         WhetherFound = ZFalse : _
         GOTO 12622
      IF ASC(HashValue$) = 0 OR INSTR(HashValue$,NewUser$) = 1 THEN _
         IF PosToReclaim = 0 THEN _
            PosToReclaim = PosToUse
12620 PosToUse = PosToUse + ZWasDF
      IF PosToUse > MaxPosition - 1 THEN _
         PosToUse = PosToUse - MaxPosition
      GOTO 12610
12621 IF PosToReclaim = 0 THEN _
         PosToReclaim = PosToUse
      GOTO 12620
12622 END SUB
13661 ' $SUBTITLE: 'UpdtCalr - subroutine to write to CALLERS file'
' $PAGE
'
'  NAME    -- UpdtCalr
'
'  INPUTS  --     PARAMETER                    MEANING
'                 ErrMsg$                   MESSAGE TO GO IN CALLER LOG
'                 EXTLog               = 1  CHECK FOR EXTENDED LOGGING
'                                           BEFORE UPDATING.
'                                      = 2  UPDATE CALLER LOG WITH ZWasZ$
'
'  OUTPUTS -- ZCurDate$           CURRENT DATE (MM-DD-YY)
'             ZTime$                    CURRENT TIME (I.E. 1:13 PM)
'             TIME.LOGGEND.ON$        TIME USER LOGGED ON (HH:MM:SS)
'
'  PURPOSE -- To update the caller's file and/or print on the
'             local printer if it is enabled
'
      SUB UpdtCalr (ErrMsg$,EXTLog) STATIC
      ON ERROR GOTO 65000
      IF ZCallersFilePrefix$ = "" OR (ZLocalUser AND ZSysop) THEN _
         EXIT SUB
      WasX$ = "     " + ErrMsg$
13663 ZErrCode = 0
      FIELD 4, 64 AS ZCallersRecord$
      IF ZErrCode > 0 THEN _
         CALL QuickTPut1 ("Caller's file:  error"+STR$(ZErrCode)) : _
         ZErrCode = 0 : _
         EXIT SUB
      ON EXTLog GOTO 13665,13670
'
' ****  EXTENDED LOGGING ENTRY  ***
'
13665 IF NOT ZExtendedLogging THEN _
         EXIT SUB
      CALL AMorPM
      WasX$ = WasX$ + " at " + ZTime$
'
' ****  UPDATE CALLERS FILE WITH USER ACTIVITY  ****
'
13670 LSET ZCallersRecord$ = WasX$
      CALL Printit (ZCallersRecord$)
      IF ZLocalUser AND ZPrinter THEN _
         EXIT SUB
      ZCallersFileIndex! = ZCallersFileIndex! + 1
13672 PUT 4,ZCallersFileIndex!
      END SUB
13673 ' $SUBTITLE: 'Printit - subroutine to print on the local printer'
' $PAGE
'
'  NAME    -- Printit
'
'  INPUTS  --     PARAMETER                    MEANING
'                 Strng$              STRING TO WRITE TO THE Printer
'
'  OUTPUTS -- NONE
'
'  PURPOSE -- To write to the printer attached to the pc running
'             RBBS-PC and toggle the printer switch off whenever
'             the printer is/becomes unavailable
'
      SUB Printit (Strng$) STATIC
      ON ERROR GOTO 65000
13674 IF ZPrinter THEN _
         LPRINT Strng$
      END SUB
20101 ' $SUBTITLE: 'ChangeDir - subroutine to change subdirectories'
' $PAGE
'
'  NAME    -- ChangeDir
'
'  INPUTS  -- PARAMETER                    MEANING
'             NewDir$                      NAME OF SUBDIRECTORY
'
'  OUTPUTS -- ZOK                           TRUE IF CHDIR SUCCESSFUL
'             ZErrCode                      ERROR CODE
'
'  PURPOSE -- Change subdirectory
'
      SUB ChangeDir (NewDir$) STATIC
      ON ERROR GOTO 65000
      ZErrCode = 0
      ZOK = ZTrue
20103 CHDIR NewDir$
      END SUB
20219 ' $SUBTITLE: 'FINDITX - subroutine to find if a file exists'
' $PAGE
'
'  NAME    -- FINDITX
'
'  INPUTS  -- PARAMETER                    MEANING
'             FilName$                 NAME OF FILE TO FIND
'             FileNum                  # TO OPEN FILE AS
'
'  OUTPUTS -- ZOK                      TRUE IF FILE EXISTS
'             ZErrCode                 ERROR CODE
'
'  PURPOSE -- Determine whether a file exists
'
      SUB FindItX (FilName$,FileNum) STATIC
      ON ERROR GOTO 65000
      ZErrCode = 0
      ZOK = ZFalse
      IF LEN(FilName$) < 1 THEN _
         EXIT SUB
      IF ZTurboRBBS THEN _
         CALL FindFile (FilName$,ZOK) : _
         IF ZOK THEN _
            GOTO 20222 _
         ELSE EXIT SUB
20221 CALL BadFileChar (FilName$,ZOK)
      IF NOT ZOK THEN _
         EXIT SUB
      ZOK = ZFalse
      NAME FilName$ AS FilName$
      IF ZErrCode = 53 THEN _
         ZErrCode = 0 : _
         EXIT SUB
20222 CLOSE FileNum
20223 CALL OpenWork (FileNum,FilName$)
      IF ZErrCode = 64 OR ZErrCode = 76 THEN _
         ZOK = ZFalse : _
         EXIT SUB
      ZOK = ZTrue
      END SUB
20308 ' $SUBTITLE: 'FlushCom -- subroutine reads all char. from  comm. port'
' $PAGE
'
'  NAME -- FlushCom
'
'  INPUTS --   PARAMETER     MEANING
'              STrng$       STRING TO READ CHARACTERS INTO FROM
'                           THE COMMUNICATIONS PORT (FILE #3)
'
'  OUTPUTS --   Strng$
'
'  PURPOSE -- Reads all characters from the communications port.
'
      SUB FlushCom (Strng$) STATIC
      ON ERROR GOTO 65000
      IF ZLocalUser THEN _
         EXIT SUB
      Strng$ = ""
      IF NOT ZFossil THEN _
         GOTO 20311
20310 CALL FosReadAhead(ZComPort,Char)
      IF Char <> -1 THEN _
         CALL FOSRXChar(ZComPort,Char) : _
         Strng$ = Strng$ + CHR$(Char) : _
         GOTO 20310
      EXIT SUB
20311 Strng$ = INPUT$(LOC(3),3)                     ' FLUSH THE COMM BUFFER
20312 IF ZErrCode = 57 THEN _
         LineStatus = INP(ZLineStatusReg) : _
         ZErrCode = 0 : _
         GOTO 20311
      END SUB
20898 ' $SUBTITLE: 'NetBIOS - subroutine to lock/unlock using NetBIOS'
' $PAGE
'
'  NAME    -- NetBIOS   (WRITTEN BY DOUG AZZARITO)
'
'  INPUTS  -- IBMLockCmd       = 1-LOCK, 0-UNLOCK
'             IBMFileLock      = 5 USERS FILE
'                              = 6 SEMAPHORE FILE
'             IBMRecLock       = RECORD NUMBER TO LOCK
'
'  OUTPUTS -- NONE
'
'  PURPOSE -- Lock and unlock files using NetBIOS commands.
'             If lock fails, this routine tries forever.
'
      SUB NetBIOS (IBMLockCmd,IBMFileLock,IBMRecLock) STATIC
      STATIC IBMCount
      ON ERROR GOTO 65000
29900 ON IBMLockCmd + 1 GOTO 29920, 29910
      EXIT SUB
'
' *****  LOCK LOOP   ****
'
29910 ZErrCode = 0
      IF IBMFileLock = 6 AND IBMRecLock = 3 THEN _
         IBMCount = IBMCount + 1 : _
         IF IBMCount > 1 THEN _
            EXIT SUB
      LOCK IBMFileLock, IBMRecLock TO IBMRecLock
      IF ZErrCode <> 0 THEN _
         GOTO 29910
      EXIT SUB
29920 ZErrCode = 0
      IF IBMFileLock = 6 AND IBMRecLock = 3 THEN _
         IBMCount = IBMCount - 1 : _
         IF IBMCount > 0 THEN _
            EXIT SUB _
         ELSE IBMCount = 0
      UNLOCK IBMFileLock, IBMRecLock TO IBMRecLock
      IF ZErrCode <> 0 THEN _
         GOTO 29920
      END SUB
43048 ' $SUBTITLE: 'UpdateC - update of callers log on exiting'
' $PAGE
'
'  NAME    -- UpdateC
'
'  INPUTS  --     PARAMETER                    MEANING
'             ZCallersFileIndex!
'             ZFirstName$
'             ZWasHHH
'             ZLastName$
'             ZWasMMM
'             ZWasNG$
'             ZWasSSS
'             ZSysopFirstName$
'             ZSysopLastName$
'
'  OUTPUTS -- ZCallersRecord$
'             ZCallersFileIndex!
'             ZSysop
'
'  PURPOSE -- Update the callers file at logoff so that the number
'             of hours, minutes, and seconds for the session are
'             recorded as the last 9 characters of the 64-character
'             callers file record
'
      SUB UpdateC STATIC
      ON ERROR GOTO 65000
      IF ZCallersFilePrefix$ = "" THEN _
         EXIT SUB
'
' ****  UPDATE CALLERS FILE AT LOGOFF  ***
'
43050 FIELD 4,55 AS ZCallersRecord$,3 AS Hours$,3 AS Minutes$,3 AS Seconds$
      LSET ZCallersRecord$ = MID$(ZWasNG$,65,55)
      LSET Hours$ = STR$(ZSessionHour)
      LSET Minutes$ = STR$(ZSessionMin)
      LSET Seconds$ = STR$(ZSessionSec)
      ZCallersFileIndex! = ZCallersFileIndex! + 1
      PUT 4,ZCallersFileIndex!
      FIELD 4,64 AS ZCallersRecord$
      LSET ZCallersRecord$ = LEFT$(ZWasNG$,64)
      ZCallersFileIndex! = ZCallersFileIndex! + 1
      PUT 4,ZCallersFileIndex!
43060 LSET ZCallersRecord$ = STRING$(64,CHR$(0))
      ZCallersFileIndex! = ZCallersFileIndex! + 1
      PUT 4,ZCallersFileIndex!
      ZCallersFileIndex! = ZCallersFileIndex! + 1
      PUT 4,ZCallersFileIndex!
      IF ZOrigCallers$ <> ZCallersFile$ THEN _
         ZCallersFile$ = ZOrigCallers$ : _
         CALL SetCall : _
         GOTO 43050
      END SUB
51098 ' $SUBTITLE: 'FindFree - subroutine to find space on a device'
' $PAGE
'
'  NAME    -- FindFree
'
'  INPUTS  --     PARAMETER                    MEANING
'                 ZWasZ$                       NAME OF FILE TO FIND
'
'  OUTPUTS -- ZFreeSpace$                      NUMBER OF BYTES FREE
'
'  PURPOSE -- To determine amount of free space on a device
'
      SUB FindFree STATIC
      ON ERROR GOTO 65000
      ZErrCode = 0
52000 IF ZTurboRBBS THEN _
         GOTO 52003
      ZFreeSpace$ = ""
      CLS
      ZErrCode = 0
52001 FILES ZWasZ$
      IF ZErrCode = 53 AND (ZWasZ$ = ZCmntsFile$ OR ZWasZ$ = ZUpldDriveFile$ ) THEN _
         CALL OpenOutW (ZWasZ$) : _
         GOTO 52000
      IF ZErrCode = 53 AND ZWasZ$ = ZUpldDir$ THEN _
         ZOutTxt$ = "Upload directory missing.  Tell SYSOP" : _
         ZSubParm = 6 : _
         CALL TPut : _
         GOTO 52002
      FOR WasX = 1 TO 25
         ZFreeSpace$ = ZFreeSpace$ + CHR$(SCREEN (3,WasX))
      NEXT
52002 ZSubParm = 1
      CALL Line25
      EXIT SUB
52003 WasAX = 0
      WasBX = 0
      WasCX = 0
      WasDX = 0
      IF MID$(ZWasZ$,2,1) = ":" THEN _
         WasAX = ASC(ZWasZ$) - ASC("A") + 1
      CALL RBBSFree (WasAX,WasBX,WasCX,WasDX)
      WasI# = CDBL(WasAX) * (WasBX + 65536! * (-(WasBX < 0)))
      WasI# = WasI# * WasCX
      ZFreeSpace$ = STR$(WasI#) + _
                    " bytes free"
      END SUB
57978 ' $SUBTITLE: 'OpenWork - subroutine to open RBBS-PC's work file (2)'
' $PAGE
'
'  NAME   -- OpenWork
'
'  INPUTS --     PARAMETER                    MEANING
'                FileNum                    # OF FILE TO OPEN AS
'                FilName$                   NAME OF FILE TO FIND
'                ZShareIt                   USE DOS' "SHARE" FACILITIES
'
'  OUTPUTS -- ZErrCode                        ERROR CODE
'
'  PURPOSE -- To open RBBS-PC's "work" file (number 2)
'
      SUB OpenWork (FileNum,FilName$) STATIC
      ON ERROR GOTO 65000
58000 CLOSE FileNum
58010 ZErrCode = 0
58020 IF ZShareIt THEN _
         OPEN FilName$ FOR INPUT SHARED AS #FileNum _
      ELSE OPEN "I",FileNum,FilName$
      IF ZErrCode = 52 THEN _
         GOTO 58010
58030 END SUB
58190 ' $SUBTITLE: 'OpenFMS - subroutine to open the FMS directory'
' $PAGE
'
'  NAME    -- OpenFMS
'
'  INPUTS  -- PARAMETER                      MEANING
'             ZShareIt                DOS SHARING FLAG
'             ZFMSDirectory$          NAME OF FMS DIRECTORY
'
'  OUTPUTS -- LastRec                NUMBER OF THE Last
'                                    RECORD IN THE FILE
'
'  PURPOSE -- To open the upload directory as a random file and find
'             the number of the last record in the file.
'
      SUB OpenFMS (LastRec) STATIC
      ON ERROR GOTO 65000
      FileLength = 38 + ZMaxDescLen
      CLOSE 2
      IF ZActiveFMSDir$ = "" THEN _
         IF ZMenuIndex = 6 THEN _
            ZActiveFMSDir$ = ZLibDir$ _
         ELSE ZActiveFMSDir$ = ZFMSDirectory$
      IF ZShareIt THEN _
         OPEN ZActiveFMSDir$ FOR RANDOM SHARED AS #2 LEN=FileLength _
      ELSE OPEN "R",2,ZActiveFMSDir$,FileLength
      IF ZErrCode > 0 THEN _
         CALL QuickTPut1 ("Drive/path does not exist or bad name for FMS dir " + _
                     ZActiveFMSDir$) : _
         END
      LastRec = LOF(2)/FileLength
      IF ZActiveFMSDir$ = PrevFMS$ THEN _
         EXIT SUB
      PrevFMS$ = ZActiveFMSDir$
      FIELD 2, FileLength AS FMSRec$
      GET #2,1
      ZWasA = (LEFT$(FMSRec$,4) <> "\FMS")
      ZUpInc = 2*(INSTR(FMSRec$," TOP ") = 0 OR ZWasA) + 1
      ZDateOrderedFMS = ZWasA OR (INSTR(FMSRec$," NOSORT") = 0)
      ZWasDF = INSTR(FMSRec$,"CH(")
      ZChainedDir$ = ""
      IF ZWasDF > 0 AND (NOT ZWasA) THEN _
         WasX = INSTR(ZWasDF,FMSRec$,")") : _
         IF WasX > 0 THEN _
            ZChainedDir$ = MID$(FMSRec$,ZWasDF+3,WasX-ZWasDF-3) : _
            CALL FindFile (ZChainedDir$,ZOK) : _
            IF NOT ZOK THEN _
               ZChainedDir$ = ""
      END SUB
58220 ' $SUBTITLE: 'OpenOutW - sub to open output work file (2)'
' $PAGE
'
'  NAME    -- OpenOutW
'
'  INPUTS  --     PARAMETER                 MEANING
'                 ZFileName$            NAME OF FILE TO FIND
'                 ZShareIt              USE DOS' "SHARE" FACILITIES
'
'  OUTPUTS -- ZErrCode                        ERROR CODE
'
'  PURPOSE -- To open RBBS-PC's "work" file (number 2) for output
'
      SUB OpenOutW (FilName$) STATIC
      ON ERROR GOTO 65000
      CLOSE 2
58225 ZErrCode = 0
58230 IF ZShareIt THEN _
         OPEN FilName$ FOR OUTPUT SHARED AS #2 _
      ELSE OPEN "O",2,FilName$
58235 END SUB
58260 ' $SUBTITLE: 'KillWork - subroutine to delete a "work" file'
' $PAGE
'
'  NAME    -- KillWork
'
'  INPUTS  --     PARAMETER                    MEANING
'                 FilName$                  NAME OF FILE TO DELETE
'
'  OUTPUTS -- ZErrCode                        ERROR CODE
'
'  SUBROUTINE PURPOSE -- To delete a RBBS-PC "work" file
'
      SUB KillWork (FilName$) STATIC
      ON ERROR GOTO 65000
      CLOSE 2
      ZErrCode = 0
58270 KILL FilName$
58275 END SUB
58280 ' $SUBTITLE: 'GetPassword - sub to read the "passwords" file'
' $PAGE
'
'  NAME    -- GetPassword
'
'                          PARAMETER             MEANING
'  INPUTS  -- FILE # 2 OPENED
'
'  OUTPUTS -- ZTempPassword$
'             ZTempSecLevel
'             ZTempTimeAllowed
'             ZTempRegPeriod
'             ZTempMaxPerDay
'
'  PURPOSE -- To read the RBBS-PC "PASSWORDS" file
'
      SUB GetPassword STATIC
      ON ERROR GOTO 65000
      ZErrCode = 0
      INPUT #2,ZTempPassword$,     ZTempSecLevel, _
               ZTempTimeAllowed,  ZTempMaxPerDay, _
               ZTempRegPeriod,    ZStartTime, _
               ZEndTime,           ZByteMethod, _
               ZRatioRestrict#, ZInitialCredit#, _
               ZTempTimeLock
58285 END SUB
58290 ' $SUBTITLE: 'ReadDir - subroutine to read the "DIR" files'
' $PAGE
'
'  NAME    -- ReadDir
'
'             PARAMETER                MEANING
'  INPUTS  -- FileNum                  WHICH # FILE TO READ
'             WhichLine                HOW MANY LINES TO ADVANCE
'
'  OUTPUTS -- ZOutTxt$
'
'  PURPOSE -- To read possible "DIR" files
'
      SUB ReadDir (FileNum,WhichLine) STATIC
      ON ERROR GOTO 65000
      ZErrCode = 0
      FOR WasI = 1 TO WhichLine
         LINE INPUT #FileNum,ZOutTxt$
      NEXT
58295 END SUB
58300 ' $SUBTITLE: 'ReadParms - subroutine to read parameter values'
' $PAGE
'
'  NAME    -- ReadParms
'
'               PARAMETER             MEANING
'  INPUTS  -- FILE # 2 OPENED
'             NumParms               # parameters to read
'             WhichLine              Which set of parms to return
'  OUTPUTS -- ARA.TO.USER$           Array of string values
'             FILE.SECURITY
'             FilePswd$
'
'  PURPOSE -- To read different values, where values are
'             separated by a comma or carriage-return-line-feed.
'
      SUB ReadParms (AraToUse$(1),NumParms,WhichLine) STATIC
      ON ERROR GOTO 65000
      ZErrCode = 0
      FOR WasJ = 1 TO WhichLine
         FOR WasI = 1 TO NumParms
            INPUT #2,AraToUse$(WasI)
         NEXT
      NEXT
58305 END SUB
58310 ' $SUBTITLE: 'ReadAny - subroutine to read file 2 into ZOutTxt$'
' $PAGE
'
'  NAME    -- ReadAny
'
'               PARAMETER             MEANING
'  INPUTS  -- FILE # 2 OPENED
'
'  OUTPUTS -- ZOutTxt$
'
'  PURPOSE -- To read file #2 into ZOutTxt$
'
      SUB ReadAny STATIC
      ON ERROR GOTO 65000
      ZErrCode = 0
      INPUT #2,ZOutTxt$
58315 END SUB
58320 ' $SUBTITLE: 'PrintWork - subroutine to print to file 2'
' $PAGE
'
'  NAME    -- PrintWork
'
'               PARAMETER             MEANING
'  INPUTS  -- FILE # 2 OPENED
'             STRING TO WRITE OUT
'
'  OUTPUTS -- NONE
'
'  PURPOSE -- To print a string to file #2
'
      SUB PrintWork (Strng$) STATIC
      ON ERROR GOTO 65000
      ZErrCode = 0
      PRINT #2,Strng$;
58325 END SUB
58330 ' $SUBTITLE: 'GetWork - subroutine to read file 2'
' $PAGE
'
'  NAME    -- GetWork
'
'               PARAMETER             MEANING
'  INPUTS  -- RecLen            Length of record
'
'  OUTPUTS -- NONE
'
'  PURPOSE -- To read a record from file #2
'
      SUB GetWork (RecLen) STATIC
      ON ERROR GOTO 65000
      ZErrCode = 0
      FIELD 2, RecLen AS ZDnldRecord$
      GET 2,(LOC(2)+1)
58335 END SUB
58340 ' $SUBTITLE: 'OpenWorkA - subroutine to open output work file (2)'
' $PAGE
'
'  NAME    -- OpenWorkA
'
'  INPUTS  --     PARAMETER                    MEANING
'              FilName$                  NAME OF FILE TO FIND
'              ZShareIt                  USE DOS' "SHARE" FACILITIES
'
'  OUTPUTS -- ZErrCode                        ERROR CODE
'
'  PURPOSE -- To open RBBS-PC's "work" file (number 2) for appended output
'
      SUB OpenWorkA (FilName$) STATIC
      ON ERROR GOTO 65000
      CLOSE 2
      ZErrCode = 0
      IF ZShareIt THEN _
         OPEN FilName$ FOR APPEND SHARED AS #2 _
      ELSE OPEN "A",2,FilName$
58345 END SUB
58350 ' $SUBTITLE: 'PrintWorkA - subroutine to print to file 2 with CR'
' $PAGE
'
'  NAME    -- PrintWorkA
'
'                          PARAMETER             MEANING
'  INPUTS  --            FILE # 2 OPENED
'                        STRING TO WRITE OUT
'
'  OUTPUTS -- NONE
'
'  PURPOSE -- To print a string to file #2 followed by a carriage return
'
      SUB PrintWorkA (Strng$) STATIC
      ON ERROR GOTO 65000
      ZErrCode = 0
      PRINT #2,Strng$
58355 END SUB
58360 ' $SUBTITLE: 'CheckInt - subroutine to check input is an integer'
' $PAGE
'
'  NAME    -- CheckInt
'
'             PARAMETER             MEANING
'  INPUTS  -- Strng$         STRING TO VERIFY CAN BE AN INTEGER
'
'  OUTPUTS -- ZErrCode             = 0 MEANS IT IS AN INTEGER VALUE
'                                 <> 0 MEANS IT IS NOT AN INTEGER VALUE
'             ZTestedIntValue  Integer value of expression
'
'  PURPOSE -- To validate that a string represents an integer
'
      SUB CheckInt (Strng$) STATIC
      ON ERROR GOTO 65000
      ZErrCode = 0
      WasX$ = Strng$
      CALL Trim (WasX$)
      ZTestedIntValue = VAL(LEFT$(WasX$,INSTR(WasX$+" "," ")-1))
58365 END SUB
59650 ' $SUBTITLE: 'PutCom -- subroutine to write to communications port'
' $PAGE
'
'  NAME    --  PutCom
'
'  INPUTS  --   PARAMETER     MEANING
'                STNG$       STRING TO PRINT TO COMM PORT
'              ZFlowControl  WHETHER USING CLEAR TO SEND FOR FLOW
'                            CONTROL BETWEEN THE PC AND THE MODEM
'
'  OUTPUTS --
'
'  PURPOSE -- Checks for carrier drop and flow control (xon/xoff)
'             before writing to the communications port.
'
      SUB PutCom (Strng$) STATIC
      ON ERROR GOTO 65000
      IF ZLocalUser THEN _
         EXIT SUB
      CALL CheckCarrier
      IF ZSubParm = -1 THEN _
         EXIT SUB
      IF NOT ZXOffEd THEN _
         GOTO 59652
      ZSubParm = 1
      CALL Line25
      ZWasY$ = ZXOff$
      XOffTimeout! = TIMER + ZWaitBeforeDisconnect
      WHILE ZWasY$ = ZXOff$ AND ZSubParm <> -1
         Char = -1
         WHILE Char = -1 AND ZSubParm <> -1
            GOSUB 59654
         WEND
         IF Char <> -1 THEN _
            CALL GetCom(ZWasY$) : _
            IF ZXOnXOff AND ZWasY$ <> ZXOn$ THEN _
               ZWasY$ = ZXOff$
      WEND
      ZXOffEd = ZFalse
      ZSubParm = 1
      CALL Line25
59652 ZNotCTS = ZFalse
      IF NOT ZFossil THEN _
         PRINT #3,Strng$; : _
         EXIT SUB
      IF Strng$ = "" THEN _
         EXIT SUB
      FOR WasN = 1 TO LEN(Strng$)
          Char = ASC(MID$(Strng$,WasN,1))
59653     CALL FosTXChar(ZComPort,Char,Result)
          IF Result = 0 THEN _
             GOTO 59653
      NEXT
      EXIT SUB
59654 CALL EofComm (Char)
      CALL GoIdle
      CALL CheckCarrier
      CALL CheckTime(XOffTimeout!, TempElapsed!,1)
      IF ZSubParm = 2 THEN _
         ZSubParm = -1
      RETURN
      END SUB
59660 ' $SUBTITLE: 'PutWork -- subroutine to write to upload files'
' $PAGE
'
'  NAME    -- PutWork
'
'  INPUTS  --   PARAMETER     MEANING
'                STNG$       STRING TO WRITE TO FILE
'                RecNum      RECORD NUMBER TO WRITE
'                RecLen      LENGTH OF RECORD TO WRITE
'
'  OUTPUTS --
'
'  PURPOSE -- Writes uploaded file records to work file
'
      SUB PutWork (Strng$,RecNum,RecLen) STATIC
      ON ERROR GOTO 65000
      FIELD #2,RecLen AS ZUpldRec$
      LSET ZUpldRec$ = Strng$
      RecNum = RecNum + 1
      PUT #2,RecNum
      END SUB
59680 ' $SUBTITLE: 'RBBSPlay -- subroutine to play music'
' $PAGE
'
'  NAME    -- RBBSPlay
'
'  INPUTS  --   PARAMETER     MEANING
'               Strng$      STRING TO PLAY
'
'  OUTPUTS --
'
'  PURPOSE -- Play music.  Skip if get an error.
'
      SUB RBBSPlay (StringToPlay$) STATIC
      PLAY StringToPlay$
      ZErrCode = 0
      END SUB
59700 ' $SUBTITLE: 'Talk -- subroutine for voice response'
' $PAGE
'
'  NAME    -- Talk
'
'  INPUTS  --   PARAMETER     MEANING
'               ZVoiceType    TYPE OF VOICE SYNTHESIZER
'               VoiceRecord   RECORD NUMBER TO RETRIEVE
'
'  OUTPUTS --
'
'  PURPOSE -- Retrieve voice record and send to voice synthesizer
'
      SUB Talk (VoiceRecord,StringWork$) STATIC
      IF ZVoiceType = 0 THEN _
         EXIT SUB
      IF VoiceRecord > 0 THEN _
         GOTO 59720
      CLOSE 7,8
      IF ZVoiceType = 1 THEN _
         OPEN "COM2:2400,E,7,1,CS65535" AS #7 : _
         LPRINT "OPENED COM PORT"
      IF ZShareIt THEN _
         OPEN "RBBSTALK.DEF" FOR RANDOM SHARED AS #8 LEN=32 _
      ELSE OPEN "R",8,"RBBSTALK.DEF",32
      FIELD 8,30 AS TalkRecord$,2 AS Dummy$
      EXIT SUB
59720 IF NOT ZSnoop THEN _
         EXIT SUB
      IF VoiceRecord < 65 THEN _
         GET 8,VoiceRecord : _
         StringWork$ = TalkRecord$ : _
         CALL Trim (StringWork$)
59721 IF ZSmartTextCode THEN _
         CALL SmartText (StringWork$, CRFound,ZFalse)
59722 IF ZVoiceType = 1 THEN _
         PRINT #7,StringWork$
59723 IF ZVoiceType = 2 THEN _
         CALL RBBSHS (CHR$(LEN(StringWork$)+1)+StringWork$+CHR$(13))
      END SUB
59725 ' $SUBTITLE: 'CommPut -- Writes to communications port'
' $PAGE
'
'  NAME    -- CommPut
'
'  INPUTS  --   PARAMETER     MEANING
'               Strng$        String to write
'               ZFossil       Whether using Fossil driver
'
'  OUTPUTS --
'
'  PURPOSE -- Send string to comm port.  Recovers from errors.
'
      SUB CommPut (Strng$) STATIC
      ON ERROR GOTO 65000
      IF ZFossil THEN _
         Bytes = LEN(Strng$) : _
         CALL FosWrite(ZComPort,Bytes,Strng$) _
      ELSE PRINT #3,Strng$;
      END SUB
59790 ' $SUBTITLE: 'FindFile -- subroutine to find a file'
' $PAGE
'
'  NAME    --  FindFile
'
'  INPUTS  --  PARAMETER         MENANING
'               FilName$         NAME OF FILE TO LOOK FOR
'               FExists          WHETHER FILE EXISTS
'
'  OUTPUTS --  RETURNED.VALUE    VALUE RETURNED
'                                TRUE  = FILE EXISTS
'                                TRUE = FILE DOES NOT EXIST
'
'  PURPOSE --  Determine whether passed file FilName$ exists
'              Unlike, FindIt, this routine does not open any
'              file and, hence, does not create one in determining
'              whether a file exists.
'
      SUB FindFile (FilName$,FExists) STATIC
      CALL BadFileChar (FilName$,FExists)
59791 IF FExists THEN _
         IOErrorCount = 0 : _
         CALL RBBSFind (FilName$,WasZ,WasY,WasM,WasD) : _
         FExists = (WasZ = 0)
      END SUB
'  $SUBTITLE: 'Error Handling for separately compiled subroutines'
'  $PAGE
'
'
' Error handling for the separately compiled subroutines of RBBS-PC
'
'
65000 IF ZDebug THEN _
         ZOutTxt$ = "RBBSSUB1 DEBUG Error Trap Entry ERL=" + _
              STR$(ERL) + _
              " ERR=" + _
              STR$(ERR) : _
         IF ZPrinter THEN _
            CALL Printit(ZOutTxt$) _
         ELSE CALL LPrnt(ZOutTxt$,1)
      ZErrCode = ERR
'
'     SetCall
'
      IF ERL = 110 THEN _
          RESUME NEXT
'
'     OPEN CONFIG FILE
'
       IF ERL => 117 AND ERL <= 119 THEN _
          RESUME NEXT
'
'     OPEN COM PORT ERROR HANDLING
'
      IF ERL = 200 THEN _
         CLS : _
         CALL PScrn (ZComPort$ + " does not exist/not responding- Error" + STR$(ERR)) : _
         STOP
'
'     GetCom ERROR HANDLING
'
       IF ERL = 1420 AND ERR = 57 THEN _
          RESUME NEXT
       IF ERL = 1420 AND ERR = 69 THEN _
          ZSubParm = -1 :_
          RESUME NEXT
'
'      OPENRESEQ ERROR HANDLING
'
       IF ERL = 1481 THEN _
           ZErrCode = ERR : _
           RESUME NEXT
'
'      OpenUser ERROR HANDLING
'
       IF ERL = 9400 AND ERR = 75 AND ZShareIt THEN _
          CALL DelayTime (30) : _
          RESUME
'
'      FindUser ERROR HANDLING
'
       IF ERL = 12610 THEN _
          RESUME NEXT
'
'     UpdtCalr ERROR HANDLING
'
       IF ERL = 13663 THEN _
          RESUME NEXT
       IF ERL = 13672 AND ERR = 61 THEN _
          CALL QuickTPut1 ("Disk Full") : _
          IF ZDiskFullGoOffline THEN _
             GOTO 65010 _
          ELSE RESUME NEXT
       IF ERL = 13672 THEN _
          ZCallersFileIndex! = ZCallersFileIndex! - 1 : _
          RESUME NEXT
'
'     ZPrinter ERROR HANDLING
'
       IF ERL = 13674 THEN _
          ZPrinter = ZFalse : _
          RESUME
'
'      ChangeDir ERROR HANDLING
'
       IF ERL = 20103 THEN _
          ZOK = ZFalse : _
          RESUME NEXT
'
'     FindIt ERROR HANDLING
'
       IF ERL = 20221 THEN _
          RESUME NEXT
       IF ERL = 20223 AND ZErrCode = 58 THEN _
          ZErrCode = 64 : _
          ZOK = ZFalse : _
          RESUME NEXT
       IF ERL = 20223 AND ZErrCode = 76 THEN _
          CALL LPrnt("Bad path.  File name is " + FilName$,1) : _
          ZErrCode = 76 : _
          ZOK = ZFalse : _
          RESUME NEXT
       IF ERL => 20221 AND ERL <= 20223 AND ZErrCode = 70 _
          AND ZNetworkType = 6 THEN _
             ZErrCode = 0 : _
             RESUME NEXT
       IF ERL => 20221 AND ERL <= 20223 THEN _
          RESUME
'
'     FlushCom ERROR HANDLING
'
       IF ERL = 20311 AND ERR = 57 THEN _
          RESUME NEXT
       IF ERL = 20311 AND ERR = 69 THEN _
          ZAbort = ZTrue : _
          ZSubParm = -1 : _
          RESUME NEXT
'
'     NetBIOS ERROR HANDLING
'
       IF ERL => 29900 AND ERL <= 29920 THEN _
          RESUME NEXT
'
'     UpdateC ERROR HANDLING
'
      IF ERL => 43050 AND ERL <= 43060 AND ERR = 61 THEN _
         ZOutTxt$ = "* Disk full - terminating *" : _
         ZSubParm =2 : _
         CALL TPut : _
         IF ZDiskFullGoOffline THEN _
           GOTO 65010 _
         ELSE SYSTEM
'
'     CheckInt ERROR HANDLING
'
       IF (ERL = 59652 OR ERL = 59727) AND ERR = 24 THEN _
          ZNotCTS = ZTrue : _
          CALL Line25 : _
          ZErrCode = 0 : _
          RESUME
       IF ERL => 52000 AND ERL <= 59725 THEN _
          RESUME NEXT
'
'     FindFile ERROR HANDLING
'
       IF ERL = 59791 THEN _
          IF ERR = 57 THEN _
             CALL DelayTime (1) : _
             CALL UpdtCalr ("SLOW I/O ERROR",1) : _
             IOErrorCount = IOErrorCount + 1 : _
             IF IOErrorCount < 11 THEN _
                RESUME
'
'     CATCH ALL OTHER ERRORS
'
       ZOutTxt$ = "RBBS-SUB1 Untrapped Error" + _
            STR$(ERR) + _
            " in line" + _
            STR$(ERL)
       CALL QuickTPut1 (ZOutTxt$)
       CALL UpdtCalr (ZOutTxt$,2)
       RESUME NEXT
'     SHARED ROUTINE FOR GOING OFF LINE WHEN DISK FULL
65010  CALL OpenCom(ZModemInitBaud$,",N,8,1")
       CALL TakeOffHook
       IF ZFossil THEN _
          CALL FOSExit(ZComPort)
       SYSTEM