' $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 4, 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
'  FileLock    21993 Allow files to be shared among multiple RBBS-PC's 'Pe 02/04/90
'  FindFile    59790   Determine whether a file exists without opening it ' AC012601
'  FindFree    51098   Find amount of space on the upload disk drive
'  FindItX     20219   Find if a file exists on a device             ' KG061001
'  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
'  ViewTxt     60140   Display ASCII file from Compressed file 'Pe 02/03/90
'
'  $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, _                                      ' DA111103
             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, _                                       ' KG080801
             ZMaxMsgLinesDef, _
             ZDoorsAvail, _
             ZWasDF$, _
             ZMainMsgFile$, _
             ZMainMsgBackup$
    INPUT #2, WasX$, _
              ZCmntsFile$, _
              ZMainUserFile$, _
              ZWelcomeFile$, _
              ZNewUserFile$, _
              ZMainDirExtension$
    CALL BreakFileName (WasX$,ZWasY$,ZWasDF$,ZWasZ$,ZFalse)
    IF ZWasDF$ <> "" THEN _                                          ' RB060403
       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                                            ' JM122202
    IF ZConfMode THEN _                                              ' JM122202
         INPUT #2, ZwasDF _                                          ' JM122202
    ELSE INPUT #2, ZRecycleToDos                                     ' JM122202
    INPUT #2,ZWasDF, _                                               ' JM122202
             ZWasDF, _
             ZTrashcanFile$
    INPUT #2,ZMinLogonSec, _
             ZDefaultSecLevel, _                                     ' KG020901
             ZSysopSecLevel, _
             ZFileSecFile$, _
             ZSysopMenuSecLevel, _
             ZConfMailList$, _
             ZMaxViolations, _
             ZOptSec(50), _   ' SECURITY FOR Sysop 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$                                      ' RK122301
    IF ZConfMode THEN _                                              ' RK122301
         INPUT #2, ZwasDF _                                          ' RK122301
    ELSE INPUT #2, ZModemInitBaud$                                   ' RK122301
             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, _
              ZArkViewPath$, _             'Pe 02/04/90
              ZFastFileList$, _                                      ' KG102201
              ZFastFileLocator$, _                                   ' KG102201
              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                                          ' RK122301
    IF ZConfMode THEN _                                              ' RK122301
         INPUT #2, ZwasDF _                                          ' RK122301
    ELSE INPUT #2, ZKeepInitBaud                                     ' RK122301
    INPUT #2, ZMainPUI$                                              ' RK122301
    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 UnString(ZEmphasizeOnDef$,";40")     'ANSIEd   ' Bh 110790
'     CALL UnString(ZEmphasizeOffDef$,";40")    '
'     CALL UnString(ZFG1Def$,";40")             '
'     CALL UnString(ZFG2Def$,";40")             '
'     CALL UnString(ZFG3Def$,";40")             '
'     CALL UnString(ZFG4Def$,";40")             '
     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 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
202 CLOSE 3                                                          ' RK010401
    IF ZRTS$ = "YES" THEN _
       ZFlowControl = ZTrue : _
       WasX$ = ",CS26600,CD,DS" _
    ELSE WasX$ = ",RS,CD,DS"
    WasX = (VAL(BaudRate$) > 19200)                                  ' KG092503
    IF WasX THEN _                                                   ' KG092503
       ZWasY$ = "19200" _                                            ' KG092503
    ELSE ZWasY$ = BaudRate$                                          ' KG092503
    OPEN ZComPort$ + ":" + ZWasY$ + Parity$ + WasX$ AS #3            ' KG092503
'
' ****************************************************************************
' *  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 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$, _
              2 AS MachineType$, _
              1 AS ZBankTime$,_                        'SRK030690
              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                                                    ' KG061203
      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                                 ' KG123103
      ON ERROR GOTO 65000
      ZErrCode = 0
      ZOK = ZTrue
20103 CHDIR NewDir$                                                  ' KG123103
      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             ' KG061001
'
'  OUTPUTS -- ZOK                      TRUE IF FILE EXISTS
'             ZErrCode                 ERROR CODE
'
'  PURPOSE -- Determine whether a file exists
'
      SUB FindItX (FilName$,FileNum) STATIC                          ' KG061001
      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 : _                                            ' AC082901
         EXIT SUB
20222 CLOSE FileNum                                                  ' KG061001
20223 CALL OpenWork (FileNum,FilName$)                               ' KG061001
      IF ZErrCode = 64 OR ZErrCode = 76 THEN _
         ZOK = ZFalse : _                                            ' KG012603
         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$ = ""
20310
20311 Strng$ = INPUT$(LOC(3),3)                     ' FLUSH THE COMM BUFFER
20312 IF ZErrCode = 57 THEN _
         LineStatus = INP(ZLineStatusReg) : _
         ZErrCode = 0 : _
         GOTO 20311
      END SUB
'
'  'Pe 02/04/90  Moved FileLock sub here for Error Traping
21993 ' $SUBTITLE: 'FileLock - subroutine to share RBBS-PC files'
' $PAGE
'
'  NAME    -- FileLock
'
'  INPUTS  --     PARAMETER                    MEANING
'             ZSubParm               = 1 UNLOCK USERS AND MESSAGES
'                                      2 FLUSH MESSAGE RECORD TO DISK
'                                        AND UNLOCK MESSAGES
'                                      3 LOCK MESSAGE FILE
'                                      4 UNLOCK MESSAGE FILE
'                                      5 LOCK USER FILE
'                                      6 LOCK 4 RECORD BLOCK IN USER
'                                        FILE
'                                      7 UNLOCK USER FILE
'                                      8 UNLOCK 4 RECORD BLOCK IN USER
'                                        FILE
'                                      9 LOCK UPLOAD DIRECTORY OR
'                                        COMMENTS FILE
'                                     10 UNLOCK UPLOAD DIRECTORY OR
'                                        COMMENTS FILE
'               ACTIVE.MESSAGE FILE$     NAME OF MESSAGE FILE
'               ZActiveUserFile$         NAME OF USER FILE
'               CONFIG.FILE.NAME$        FILE NAME TO FLUSH RECORD FROM
'               ZWasEN$                  UPLOAD DIRECTORY OR COMMENTS
'                                        FILE NAME TO LOCK/UNLOCK
'               ZNetworkType             TYPE OF NETWORK LOCKING TO USE
'
'  OUTPUTS -- ZSubParm = -1 TERMINATE RBBS-PC IMMEDATELY
'             ZBlk
'             ZLockDrive
'             ZLockFileName$
'             ZLockStatus$
'             ZMsgFileLock
'             ZUserBlockLock
'             ZUserFileLock
'             ZUserFileIndex
'
'  PURPOSE -- To lock and unlock the shared RBBS-PC files when
'             multiple copies of RBBS-PC are sharing the same
'             files in either a multi-tasking DOS environment or
'             in a local area network environment
'
      SUB FileLock STATIC
      ON ZSubParm GOSUB 21995,21996,22000,25000,26000, _
                                    26500,27000,27500,29000,29500
      EXIT SUB
'
'
' *  UNLOCK USERS AND MESSAGES
'
'
21995 GOSUB 27000
      GOSUB 25000
      RETURN
'
'
' *  FLUSH MESSAGE FILE DATA TO DISK BY OPENING DUMMY FILE # 1
'
'
21996 CLOSE 1
      IF ZShareIt THEN _
         OPEN ZConfigFileName$ FOR INPUT SHARED AS #1 _
      ELSE OPEN "I",1,ZConfigFileName$
'
'
' *  UNLOCK MESSAGES
'
'
      GOSUB 25000
      CALL OpenMsg
      RETURN
'
'
' *  LOCK MESSAGE FILE
'
'
22000 IF ZMsgFileLock = ZTrue THEN _
         RETURN
      ZMsgFileLock = ZTrue
      MID$(ZLockStatus$,1,2) = "LM"
      ZSubParm = 2
      CALL Line25
      ZLockFileName$ = ZActiveMessageFile$
      ON ZNetworkType GOTO 22100,22200,22300,22400,22500,29700
      RETURN
'
'
' *  LOCK MESSAGE FILE (MULTI-LINK)
'
'
22100 WasAX = &H0
      WasBX = &H1
      IF ZMultiLinkPresent > 0 THEN _
         CALL RBBSML(WasAX,WasBX)
      RETURN
'
'
' *  LOCK MESSAGE FILE (OMNINET)
'
'
22200 CALL BreakFileName (ZActiveMessageFile$,Drive$,Prefix$,Ext$,ZFalse)
      WasCC$ = CHR$(1) + _
            LEFT$(Prefix$ + SPACE$(8),8)
      GOSUB 28000
      IF WasCT = 0 THEN _
         RETURN
      CALL DelayTime (1)
      GOTO 22200
'
'
' *  LOCK MESSAGE FILE (ORCHID PC-NET)
' *  LOCK USER FILE (ORCHID PC-NET)
' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (ORCHID PC-NET)
'
'
22300 GOSUB 28100
      CALL LPLKIT(ZLockDrive,ZLockFileName$,ZWasA)
      RETURN
'
'
' *  LOCK SYSTEM (DESQview)
'
'
22400 CALL DVLock("MESSAGE")
      RETURN
'
'
' *  LOCK MESSAGE FILE (10 NET)
' *  LOCK USER FILE (10 NET)
' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (10 NET)
'
'
22500 GOSUB 28100
      CALL LPLK10(ZLockDrive,ZLockFileName$,ZWasA)
      RETURN
'
'
' *  UNLOCK MESSAGE FILE
'
'
25000 IF NOT ZMsgFileLock THEN _
         RETURN
      ZMsgFileLock = ZFalse
      MID$(ZLockStatus$,1,2) = "UM"
      ZSubParm = 2
      CALL Line25
      ZLockFileName$ = ZActiveMessageFile$
      ON ZNetworkType GOTO 25100,25200,25300,25400,25500,29800
      RETURN
'
'
' *  UNLOCK MESSAGE FILE (MULTI-LINK)
'
'
25100 WasAX = &H100
      WasBX = &H1
      IF ZMultiLinkPresent > 0 THEN _
         CALL RBBSML(WasAX,WasBX)
      RETURN
'
'
' *  UNLOCK MESSAGE FILE (OMNINET)
'
'
25200 CALL BreakFileName (ZActiveMessageFile$,Drive$,Prefix$,Ext$,ZFalse)
      WasCC$ = CHR$(17) + _
            LEFT$(Prefix$ + SPACE$(8),8)
      GOSUB 28000
      IF WasCT = 128 THEN _
         RETURN
      CALL DelayTime (1)
      GOTO 25200
'
'
' *  UNLOCK MESSAGE FILE (ORCHID PC-NET)
' *  UNLOCK USER FILE (ORCHID PC-NET)
' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (ORCHID PC-NET)
'
'
25300 GOSUB 28100
      CALL UNLOKIT(ZLockDrive,ZLockFileName$,ZWasA)
      RETURN
'
'
' *  UNLOCK MESSAGE FILE (DESQVIEW)
'
'
25400 CALL DVUnlock("MESSAGE")
      RETURN
'
'
' *  UNLOCK MESSAGE FILE (10 NET)
' *  UNLOCK USER FILE (10 NET)
' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (10 NET)
'
'
25500 GOSUB 28100
      CALL UNLOK10(ZLockDrive,ZLockFileName$,ZWasA)
      RETURN

'
'
' *  LOCK USER FILE
'
'
26000 IF ZUserFileLock = ZTrue THEN _
         RETURN
      ZUserFileLock = ZTrue
      MID$(ZLockStatus$,4,2) = "LU"
      ZSubParm = 2
      CALL Line25
      ZLockFileName$ = ZActiveUserFile$
      ON ZNetworkType GOTO 26100,26200,22300,26300,22500,29720
      RETURN
'
'
' *  LOCK USER FILE (MULTI-LINK)
'
'
26100 WasAX = &H0
      WasBX = &H2
      IF ZMultiLinkPresent > 0 THEN _
         CALL RBBSML(WasAX,WasBX)
      RETURN
'
'
' *  LOCK USER FILE (OMNINET)
'
'
26200 CALL BreakFileName (ZActiveUserFile$,Drive$,Prefix$,Ext$,ZFalse)
      WasCC$ = CHR$(1) + _
            LEFT$(Prefix$ + SPACE$(8),8)
      GOSUB 28000
      IF WasCT = 0 THEN _
         RETURN
      CALL DelayTime (1)
      GOTO 26200
'
'
' *  LOCK USER FILE (DESQVIEW)
'
'
26300 CALL DVLock("USER")
      RETURN
'
'
' *  LOCK 4 RECORD BLOCK IN USER FILE
'
'
26500 IF ZUserBlockLock = ZTrue THEN _
         RETURN
      ZUserBlockLock = ZTrue
      ZBlk = (ZUserFileIndex / 4) + .26
      MID$(ZLockStatus$,7,2) = "LB"
      ZSubParm = 2
      CALL Line25
      ON ZNetworkType GOTO 26600,26700,26800,26750,26900,29730
      RETURN
'
'
' *  LOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)
'
'
26600 WasAX = &H0
      WasBX = ZBlk + 10
      IF ZMultiLinkPresent > 0 THEN _
         CALL RBBSML(WasAX,WasBX)
      RETURN
'
'
' *  LOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
'
'
26700 WasCC$ = CHR$(1) + _
            "BLK" + _
            RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
      GOSUB 28000
      IF WasCT = 0 THEN _
         RETURN
      CALL DelayTime (1)
      GOTO 26700
'
'
' *  LOCK 4 RECORD BLOCK IN USER FILE (DESKVIEW)
'
'
26750 CALL DVLock("BLK" + RIGHT$("0000" + MID$(STR$(ZBlk),2),5))
      RETURN
'
'
' *  LOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)
'
'
26800 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
                        "BLK" + _
                        RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
      GOTO 22300
'
'
' *  LOCK 4 RECORD BLOCK IN USER FILE (10 NET)
'
'
26900 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
                        "BLK" + _
                        RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
      GOTO 22500
'
'
' *  UNLOCK USER FILE
'
'
27000 IF NOT ZUserFileLock THEN _
         RETURN
      ZUserFileLock = ZFalse
      MID$(ZLockStatus$,4,2) = "UU"
      ZSubParm = 2
      CALL Line25
      ZLockFileName$ = ZActiveUserFile$
      ON ZNetworkType GOTO 27100,27200,25300,27300,25500,29820
      RETURN
'
'
' *  UNLOCK USER FILE (MULTI-LINK)
'
'
27100 WasAX = &H100
      WasBX = &H2
      IF ZMultiLinkPresent > 0 THEN _
         CALL RBBSML(WasAX,WasBX)
      RETURN
'
'
' *  UNLOCK USER FILE (OMNINET)
'
'
27200 CALL BreakFileName (ZActiveUserFile$,Drive$,Prefix$,Ext$,ZFalse)
      WasCC$ = CHR$(17) + _
            LEFT$(Prefix$ + SPACE$(8),8)
      GOSUB 28000
      IF WasCT = 128 THEN _
         RETURN
      CALL DelayTime (1)
      GOTO 27200
'
'
' *  UNLOCK USER FILE (DESQVIEW)
'
'
27300 CALL DVUnlock("USER")
      RETURN
'
'
' *  UNLOCK 4 RECORD BLOCK IN USER FILE
'
'
27500 IF NOT ZUserBlockLock THEN _
         RETURN
      ZUserBlockLock = ZFalse
      ZBlk = (ZUserFileIndex / 4) + .26
      MID$(ZLockStatus$,7,2) = "UB"
      ZSubParm = 2
      CALL Line25
      ON ZNetworkType GOTO 27600,27700,27800,27750,27900,29830
      RETURN
'
'
' *  UNLOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)
'
'
27600 WasAX = &H100
      WasBX = ZBlk + 10
      IF ZMultiLinkPresent > 0 THEN _
         CALL RBBSML(WasAX,WasBX)
      RETURN
'
'
' *  UNLOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
'
'
27700 WasCC$ = CHR$(17) + _
            "BLK" + _
            RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
      GOSUB 28000
      IF WasCT = 128 THEN _
         RETURN
      CALL DelayTime (1)
      GOTO 27700
'
'
' *  UNLOCK 4 RECORD BLOCK IN USER FILE (DESQVIEW)
'
'
27750 CALL DVUnlock("BLK" + RIGHT$("0000" + MID$(STR$(ZBlk),2),5))
      RETURN
'
'
' *  UNLOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)
'
'
27800 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
                        "BLK" + _
                        RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
      GOTO 25300
'
'
' *  UNLOCK 4 RECORD BLOCK IN USER FILE (10-NET)
'
'
27900 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
                        "BLK" + _
                        RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
      GOTO 25500
'
'
' *  CORVUS OMNINET INTERFACE
'
'
28000 WasCC$ = ZLineFeed$ + _
            CHR$(0) + _
            CHR$(11) + _
            WasCC$
      CALL CDSend(WasCC$)
      CALL CDRecv(ZWasCN$)
      WasCT = ASC(MID$(ZWasCN$,3,1))
      IF WasCT => 128 THEN _
         CALL LPrnt("CORVUS LOCK FAIL",1) : _
         ZSubParm = -1
28010 WasCT = ASC(MID$(ZWasCN$,4,1))
      IF WasCT => 129 THEN _
         CALL LPrnt("CORVUS FULL",1) : _
         ZSubParm = -1
      RETURN
'
'
' *  ORCHID PC-NET & 10 NET INTERFACE
'
'
28100 CALL AllCaps (ZLockFileName$)
      ZLockDrive = ASC(LEFT$(ZLockFileName$,1)) - ASC("A")
      ZLockFileName$ = ZLockFileName$ + _
                        STRING$(32 - LEN(ZLockFileName$),0)
      ZWasA = 0
      RETURN
'
'
' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$
'
'
29000 IF LockedEn$ = ZWasEN$ THEN _
         RETURN
      LockedEn$ = ZWasEN$
      MID$(ZLockStatus$,10,2) = "LD"
      ZSubParm = 2
      CALL Line25
      ZLockFileName$ = ZWasEN$
      ON ZNetworkType GOTO 29100,29010,22300,29300,22500,29710
29010 RETURN
'
'
' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (MULTI-LINK)
'
'
29100 WasAX = &H0
      WasBX = &H3
      IF ZMultiLinkPresent > 0 THEN _
         CALL RBBSML(WasAX,WasBX)
      RETURN
'
'
' *  LOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
'
'
29300 CALL DVLock("MISC")
      RETURN
'
'
' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$
'
'
29500 IF LockedEn$ <> ZWasEN$ THEN _
         RETURN
      LockedEn$ = ""
      MID$(ZLockStatus$,10,2) = "UD"
      ZSubParm = 2
      CALL Line25
      ZLockFileName$ = ZWasEN$
      ON ZNetworkType GOTO 29600,29510,25300,29650,25500,29810
29510 RETURN
'
'
' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (MULTI-LINK)
'
'
29600 WasAX = &H100
      WasBX = &H3
      IF ZMultiLinkPresent > 0 THEN _
         CALL RBBSML(WasAX,WasBX)
      EXIT SUB
'
'
' *  UNLOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
'
'
29650 CALL DVUnlock("MISC")
      RETURN
'
'
' *  NetBIOS SEMAPHORE LOCK MECHANISM
' *     Only the USERS file is actually locked.  All other files are locked
' *     by means of the semaphore file IBMFLAGS.  Each IBMFLAGS record is a
' *     file semaphore as follows:
' *        RECORD 1 = MESSAGES file lock status
' *        RECORD 2 = Comments/Upload dir locked
' *        RECORD 3 = entire USERS file lock
'
'
' * Lock MESSAGES
29700 CALL NetBIOS (1,6,1)
      RETURN

' * Lock Comments/Upload dir
29710 CALL NetBIOS (1,6,2)
      RETURN

' * Lock USERS file
29720 CALL NetBIOS (1,6,3)
      RETURN

' * Lock single USERS record
29730 CALL NetBIOS (1,6,3)
      RETURN

' * UNLOCK MESSAGES
29800 CALL NetBIOS (0,6,1)
      RETURN

' * UNLOCK Comments/Upload dir
29810 CALL NetBIOS (0,6,2)
      RETURN

' * UNLOCK USERS file
29820 CALL NetBIOS (0,6,3)
      RETURN

' * UNLOCK single USERS record
29830 CALL NetBIOS (0,6,3)
      RETURN
      END SUB
29898 ' $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 ZExitToDoors THEN EXIT SUB                              'DGS-005
      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)))        ' DA050204
      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
      FileLength = 32 + ZMaxDescLen                    ' Bh 082790
      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
If ZErrCode > 0 Then                    'Pe 02/02/90
   ZerrCode = 0
Call QuickTPut1 (CHR$(7) +  "Error Has Occured...try again !!! ")
   LastRec = 0
   EXIT SUB
END IF
      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           ' KG083102
'
'  PURPOSE -- To validate that a string represents an integer
'
      SUB CheckInt (Strng$) STATIC
      ON ERROR GOTO 65000
      ZErrCode = 0
      WasX$ = Strng$                                                 ' KG083102
      CALL Trim (WasX$)                                              ' KG083102
      ZTestedIntValue = VAL(LEFT$(WasX$,INSTR(WasX$+" "," ")-1))     ' KG083102
58365 END SUB
59650 ' $SUBTITLE: 'PutCom -- subroutine to write to communications port'
' $PAGE
'
'  NAME    --  PutCom
'
'  INPUTS  --   PARAMETER     MEANING
'                Strng$       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                                              ' KG061203
      IF ZSubParm = -1 THEN _
         EXIT SUB
      IF NOT ZXOffEd THEN _
         GOTO 59652
      ZSubParm = 1
      CALL Line25
      ZWasY$ = ZXOff$
      XOffTimeout! = TIMER + ZWaitBeforeDisconnect                   ' DA110304
      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
      PRINT #3,Strng$;
      EXIT SUB
59653
59654 CALL EofComm (Char)
      CALL GoIdle
      CALL CheckCarrier                                              ' KG061203
      CALL CheckTime(XOffTimeout!, TempElapsed!,1)                   ' DA110302
      IF ZSubParm = 2 THEN _                                         ' DA110302
         ZSubParm = -1                                               ' DA110302
      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
'
'********************************************************************
'  THREAD1            First message thread routine                  *
'  THREAD2            Second message thread routine                 *
'  THREAD3            Third message thread routine                  *
'********************************************************************
'===========================================================================
59670 ' $SUBTITLE: 'Thread1 - create/update threaded message file'
' $PAGE
'
'  SUBROUTINE NAME    -- THREAD1
'
'  INPUT PARAMETERS   --    PARAMETER              MEANING
'                           HighMsgNumber    This reply's message number
'                           CurMsg        Message number being replied
'
'  OUTPut PARAMETERS  --     <<NONE>>
'
'  SUBROUTINE PURPOSE -- SUBROUTINE TO...
'
      SUB Thread1 (HighMsgNumber,CurMsg,ZConfName$) STATIC
CALL BreakFileName (ZMainMsgFile$,Drive$,Prefix$,Ext$,ZTrue) 'Pe 08/02/89
        IF INSTR(ZConfName$," ") = 0 THEN   'PE102587
         ZFileName$ = Drive$ +ZConfName$ + "T"  'PE08/02/89
        ELSE
           ZFileName$ = Drive$ +LEFT$(ZConfName$,INSTR(ZConfName$," ")-1)+"T" 'PE 08/02/89
      END IF
      CurMsg$ = STR$(CurMsg)
      HighMsgNumber$ = STR$(HighMsgNumber)
      OPEN "R",9,ZFileName$,12
      FIELD 9, 6 AS CM$, 6 AS HMN$
      LSET CM$ = CurMsg$
      LSET HMN$ = HighMsgNumber$
      PUT #9,INT(LOF(9)/12)+1
      CLOSE (9)
 END SUB       ' THREAD1
'
59671 ' $SUBTITLE: 'Thread2 - a message was killed - check threaded message file'
' $PAGE
'
'  SUBROUTINE NAME    -- THREAD2
'
'  INPUT PARAMETERS   --    PARAMETER              MEANING
'                           MsgToKill        Killed message's number
'
'  OUTPut PARAMETERS  --     <<NONE>>
'
'  SUBROUTINE PURPOSE -- SUBROUTINE TO ...
'
      SUB Thread2 (MsgToKill,ActiveMessages,ZConfName$) STATIC
CALL BreakFileName (ZMainMsgFile$,Drive$,Prefix$,Ext$,ZTrue) 'Pe 08/02/89
      IF INSTR(ZConfName$," ") = 0 THEN     'PE102587
        ZFileName$ = Drive$ +ZConfName$ + "T"   'Pe 08/02/89
      ELSE
        ZFileName$ = Drive$+LEFT$(ZConfName$,INSTR(ZConfName$," ")-1)+"T" 'Pe 08/02/89
      END IF
      OPEN "R",9,ZFileName$,12
      FIELD 9, 6 AS CM$, 6 AS HMN$
       FOR I = 1 TO INT(LOF(9)/12)
          GET 9,I
          IF VAL(CM$) = MsgToKill THEN     ' MARK THE RECORD
             LSET CM$ = LEFT$(CM$,5) + "K"
             PUT 9,I
          ELSE 
           IF VAL(HMN$) = MsgToKill THEN     ' MARK THE RECORD
              LSET HMN$ = LEFT$(HMN$,5) + "K"
              LSET CM$ = LEFT$(CM$,5) + "K"
             PUT 9,I
          END IF
       END IF
      NEXT I
      CLOSE (9)
 END SUB      ' THREAD2
'
59672 ' $SUBTITLE: 'THREAD3 - a message was killed - check threaded message file'
' $PAGE
'
'  SUBROUTINE NAME    -- THREAD3
'
'  INPUT PARAMETERS   --    PARAMETER              MEANING
'                           CurMsg        Message's number
'
'  OUTPut PARAMETERS  --     <<NONE>>
'
'  SUBROUTINE PURPOSE -- SUBROUTINE TO ...
'
      SUB THREAD3 (CurMsg,ZConfName$) STATIC
IF ZJustSearching THEN _            'PE 02/05/90
 EXIT SUB                           'PE 01/16/89
CALL BreakFileName (ZMainMsgFile$,Drive$,Prefix$,Ext$,ZTrue) 'Pe 08/02/89
      IF INSTR(ZConfName$," ") = 0 THEN
         ZFileName$ = Drive$ +ZConfName$ + "T"   'pe 08/02/89
       ELSE
         ZFileName$ = Drive$ + LEFT$(ZConfName$,INSTR(ZConfName$," ")-1)+"T" 'Pe 08/02/89
      END IF
       OPEN "R",9,ZFileName$,12 
       FIELD 9, 6 AS CM$, 6 AS HMN$
      AA$ = ""
      ZZ$ = ""
      FOR I = 1 TO INT(LOF(9)/12)
          GET 9,I
         IF RIGHT$(HMN$,1) = "K" THEN 59673
         IF VAL(CM$) = CurMsg AND RIGHT$(HMN$,1) <> "K" THEN 
                AA$ = AA$ + HMN$
         END IF 
          IF VAL(HMN$) = CurMsg AND RIGHT$(CM$,1) = "K" THEN
                ZZ$ = LEFT$(CM$,5) + ZFG1$+"(deleted) "+ZEmphasizeOff$
         END IF
          IF VAL(HMN$) = CurMsg AND RIGHT$(CM$,1) <> "K" THEN 
                ZZ$ = CM$
         END IF
59673 NEXT I
      IF LEN(AA$) > 0 THEN 
CALL QuickTPut(ZFG3$+"   Reply(ies) in message number(s): "+ZFG1$ + AA$+ZEmphasizeOff$,1)
      END IF
      IF LEN(ZZ$) > 0 THEN 
CALL QuickTPut (ZFG4$+"   This message is in reply to message " +ZFG1$+ ZZ$+ZEmphasizeOff$,1)
      END IF
CALL QuickTPut (ZFG2$+ "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"+ZEmphasizeOff$,1)
      CLOSE (9)
 END SUB      ' THREAD3
'
59674 ' $SUBTITLE: 'Thread4 - UPDATE CONFR.DEF FILE FOR MESSAGE RECOVERY'
' $PAGE
'
'  SUBROUTINE NAME    -- THREAD4
'
'  INPUT PARAMETERS   --    PARAMETER            MEANING
'
'                           MsgToRecover   MESSAGE NumBER BEING RECOVERED
'                           FirstMsgRecord NOT USED HERE BUT PASSED IN
'                                                FROM RBBS CALL TO SUB2
'                           ActionFlag          PASSED FROM SUB2 NEEDED TO
'                                                GIVE BACK TO RBBS MAIN CODE
'                           ZConfName$                 CONFERENCE NAME
'
'  OUTPut PARAMETERS  --      <<NONE>>
'
'  SUBROUTINE PURPOSE -- SUBROUTINE - UPDATE CONFR.DEF FILE AFTER MSG RECVRY
'
      SUB Thread4 (MsgToRecover,FirstMsgRecord,ActionFlag,ZConfName$) STATIC
CALL BreakFileName (ZMainMsgFile$,Drive$,Prefix$,EXT$,ZTrue) 'Pe 08/02/89
      IF INSTR(ZConfName$," ") = 0 THEN
         ZFileName$ = Drive$ + ZConfName$ + "T"   'Pe 08/02/89
      ELSE
         ZFileName$ = Drive$ + LEFT$(ZConfName$,INSTR(ZConfName$," ")-1)+"T"  'Pe 08/02/89
      END IF
      OPEN "R",9,ZFileName$,12               'WILL CREATE FILE IF NOT EXIST
      FIELD 9, 6 AS CM$, 6 AS HMN$
      FOR I = 1 TO INT(LOF(9)/12)
          GET 9,I
          IF VAL(CM$) = MsgToRecover THEN
             LSET CM$ = LEFT$(CM$,5) + " "
             PUT 9,I
          ELSE
              IF VAL(HMN$) = MsgToRecover THEN
                 LSET HMN$ = LEFT$(HMN$,5) + " "
                 LSET CM$ = LEFT$(CM$,5) + " "
                 PUT 9,I
              END IF
          END IF
      NEXT I
      CLOSE (9)
END SUB    'THREAD4
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
      PRINT #3,Strng$;
      END SUB
'59750' $SUBTITLE: 'DGSAlias - Subroutine to Create/Update Alias Info file'
' $PAGE
'
'  SUBROUTINE NAME    -- DGSAlias
'
'  INPUT PARAMETERS   --     PARAMETER                    MEANING
'                         ZConfName$                  CONFERENCE NAME
'                         ZOrigUserNameDGS$           USERS - LOG ON NAME
'                         DGSAlias$                   USERS - ALIAS NAME
'                         DGSStl$                     NULL FIRST TIME IN
'                                                     'STILL' IF ALIAS EXISTS
'                                                        OR REAL NAME
'                         DGSFileName$                CONFERENCE ALIAS FILE
'
'  OUTPUT PARAMETERS  --  ZConfName$ ZOrigUserNameDGS$ DGSAlias$ DGSStl$
'                         DGSFileName$
'
'  SUBROUTINE PURPOSE --  TO Read ConfA.DEF and Get Users ALIAS or
'                         Create One
'
'     SUB DGSAlias (ZConfName$,ZOrigUserNameDGS$,DGSAlias$,DGSStl$,DGSFileName$) STATIC
'
'     IF DGSStl$ = "" THEN
'        ConfADefFlag = 0
'        CALL BreakFileName (ZMainUserFile$,Drive$,Prefix$,Ext$,ZTrue)
'        DGSFileName$ = Drive$ + ZConfName$ + "A.DEF"
'        CALL FindIt (DGSFileName$)
'        IF ZOK THEN
'           ConfADefFlag = ZTrue
'        END IF
'        IF ConfADefFlag = ZTrue THEN
'           OPEN "I", 7, DGSFileName$
'           DGSAlias$ = ""
'           WHILE DGSAlias$ = "" AND NOT EOF(7)
'              INPUT #7, DGSUserName$, DGSTempAlias$
'              DGSUnl = LEN(DGSUserName$)
'              IF DGSUserName$ = LEFT$(ZOrigUserNameDGS$,DGSUnl) THEN
'                 DGSAlias$ = DGSTempAlias$
'              END IF
'           WEND
'           CLOSE 7
'        ELSE
'           DGSAlias$ = "NO CONFA.DEF"
'           EXIT SUB
'        END IF
'     END IF
'     CALL GoodAls (ZConfName$,ZOrigUserNameDGS$,DGSAlias$,DGSStl$,DGSFileName$)
'     END SUB
'
'
' $SUBTITLE: 'GoodAls - Subroutine to Make Sure Alias Good'
' $PAGE
'
'  SUBROUTINE NAME    -- GoodAls
'
'  INPUT PARAMETERS   --     PARAMETER                    MEANING
'                         ZConfName$                  CONFERENCE NAME
'                         ZOrigUserNameDGS$           USERS - LOG ON NAME
'                         DGSAlias$                   USERS - ALIAS NAME
'                         DGSStl$                     NULL FIRST TIME IN
'                                                      'STILL' IF ALIAS EXISTS
'                                                         OR REAL NAME
'                         DGSFileName$                CONFERENCE ALIAS FILE
'
'  OUTPUT PARAMETERS  --  ZConfName$ ZOrigUserNameDGS$ DGSAlias$ DGSStl$
'                         DGSFileName$
'
'  SUBROUTINE PURPOSE --  To Read ConfA.DEF and see if Users ALIAS is
'                         Aready in Use or a Real Name
'
'     SUB GoodAls (ZConfName$,ZOrigUserNameDGS$,DGSAlias$,DGSStl$,DGSFileName$) STATIC
'
'     IF DGSAlias$ = "" THEN
'        DGSSfnSln$ = ZSysopFirstName$+" "+ZSysopLastName$
'        ZOutTxt$ = "Do you" +DGSStl$+ " want to use an Alias? (Y,[N])"
'        ZSubParm = 1
'        CALL TGet
'        IF ZYes THEN
'           ABFlg$ = ""
'           ZOutTxt$ = "Enter Alias (31 Char. Max.) "
'           ZSubParm = 1
'           CALL TGet
'           CALL AllCaps (ZUserIn$)
'           IF ZUserIn$ = "" OR INSTR(SPACE$(31),ZUserIn$) > 0 THEN
'              ZUserIn$ = ""
'              ABFlg$ = "Alias Must NOT be Blank"
'           END IF
'           IF LEN(ZUserIn$) > 31 THEN
'              ZUserIn$= ""
'              ABFlg$ = "Length Must NOT Exceed 31 Characters"
'           END IF
'           IF ZUserIn$ = "SYSOP" OR ZUserIn$ = DGSSfnSln$ THEN
'              ZOutTxt$ = CHR$(7)+CHR$(7)
'              ZOutTxt$ = ZOutTxt$ + "Wrong Answer! Alias Request Denied!"
'              ZOutTxt$ = ZOutTxt$ + CHR$(13) + "Contact Sysop for Alias Retry"
'              CALL QuickTPut (ZOutTxt$,2)
'              DGSAlias$ = ZOrigUserNameDGS$+CHR$(250)
'              ZActiveUserName$ = ZOrigUserNameDGS$+CHR$(250)
'              ZFirstName$ = ZOrigUserNameDGS$+CHR$(250)
'           ELSE
'              OPEN "I", 7, DGSFileName$
'              WHILE ABFlg$ = "" AND NOT EOF(7)
'              INPUT #7, DGSUserName$, DGSTempAlias$
'              IF ZUserIn$ = DGSUserName$ THEN
'                 ABFlg$ = " is a Real User"
'              ELSE
'                 IF ZUserIn$ = DGSTempAlias$ THEN
'                    ABFlg$ = " has Already been Used"
'                 END IF
'              END IF
'              WEND
'              CLOSE 7
'              IF ABFlg$="" THEN
'                 DGSAlias$ = ZUserIn$
'                 ZActiveUserName$ = ZUserIn$
'                 ZFirstName$ = ZUserIn$
'              ELSE
'                 ZOutTxt$="Sorry "+ZFirstName$+" but "+ZUserIn$+ABFlg$
'                 CALL QuickTPut (ZOutTxt$,1)
'                 DGSStl$ = " still"
'                 DGSAlias$ = ""
'              END IF
'          END IF
'        ELSE
'           DGSAlias$ = ZOrigUserNameDGS$
'        END IF
'        IF DGSAlias$ <> "" THEN
'           CLOSE 2
'           FOR I = 1 TO LEN(DGSAlias$)
'              IF MID$(DGSAlias$,I,1)=CHR$(34) THEN MID$(DGSAlias$,I,1)=CHR$(39)
'           NEXT I
'           OPEN "A", 2, DGSFileName$
'           WRITE #2, ZOrigUserNameDGS$, DGSAlias$
'           CLOSE 2
'        END IF
'      ELSE
'        ZActiveUserName$ = DGSAlias$
'        ZFirstName$ = DGSAlias$
'      END IF
'      END SUB
59790 ' $SUBTITLE: 'FindFile -- subroutine to find a file'           ' AC012601
' $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                         ' AC012601
      CALL BadFileChar (FilName$,FExists)                            ' AC012601
59791 IF FExists THEN _                                              ' KG012802
         IOErrorCount = 0 : _                                        ' AC012601
         CALL RBBSFind (FilName$,WasZ,WasY,WasM,WasD) : _            ' KG012601
         FExists = (WasZ = 0)                                        ' AC012601
      END SUB                                                        ' AC012601
'
' ** OPEN RBBSCHAT.DEF AS #7
'
'59800 SUB OpenWrk7(ChatFileName$) STATIC
'      ON ERROR GOTO 65000
'      IF ZShareIt THEN
'         OPEN ChatFileName$ FOR RANDOM ACCESS READ WRITE SHARED AS #7 LEN = 128
'       ELSE
'         OPEN ChatFileName$ FOR RANDOM AS #7 LEN = 128
'      END IF
'      END SUB
'
' ** DO ALL THE RBBSCHAT.DEF GET's AND PUT's HERE **
'
'59810 SUB LockIt7(Record, ReadIt) STATIC
'      ON ERROR GOTO 65000
'      IF ReadIt THEN
'         GET 7, Record
'       ELSE
'           IF ZShareIt THEN
'            LOCK 7, Record
'           END IF
'        PUT 7, Record
'           IF ZShareIt THEN
'              UNLOCK 7, Record
'           END IF
'      END IF
'      END SUB

'
' $SUBTITLE: 'ViewTxt - Subroutine to display ASCII file from ARC file'
' $PAGE
'
  SUB Viewtxt STATIC
  ON ERROR GOTO 65000
'
60140 ZSubParm = 1 
ZOutTxt$ ="T)ype to Screen, X)tract, C)ompress, D)ir, H)elp or [RETURN] to Quit"  ' Bh
           ZTurboKey = -ZTurboKeyUser
           CALL TGet      'Pe 02/12/90
     IF ZSubParm = -1 or ZWasQ = 0 THEN _  'Pe 02/04/90
                         EXIT SUB          'Pe 05/24/89                    
        CALL AllCaps (ZUserIn$)
       MplX = INSTR("TXCD?HQ",ZUserIn$)
     ON MplX GOTO 60149,60168,60175,60142,60141,60141,60180
GOTO 60180
'
60141 CALL BufFile (ZHelpPath$ + "ZIP" + ZHelpExtension$,WasX)  'Pe 03/26/89
      GOTO 60140                                             'Pe 03/26/89
60142  CALL QuickTPut ("Creating file list, one moment please....",1)
   EXTRACT$ = "DIR "+ ZArkViewPath$+"*.* >VUZIP"+ZNodeID$+".LST"  'Pe 01/24/90
   SHELL EXTRACT$
CALL BufFile("VUZIP"+ZNodeID$ +".LST",WasX)
GOTO 60140
'
60149 ZSubParm = 1
     ZOutTxt$ = "Which file(s) should I display, R)elist or [RETURN] to quit"         'DMOD1  ' Bh
     CALL TGet
IF ZSubParm = -1 THEN _
 EXIT SUB                              'Pe 05/24/89
      ZWasB = 1                                                            'DMOD1
       IF ZWasQ = 0 THEN _                                                  'DMOD1
        GOTO 60140              'Pe 05/24/89 was Exit Sub
IF ZUserIn$ = "R" or ZUserIn$ = "r" THEN _
   CALL BufFile (ZArcWork$,WasX) : _
GOTO 60149
       LastArc = ZWasQ                                                 'DMOD1
       FirstArc =ZWasB                                                    'DMOD1
'
FOR ArcIndex = FirstArc TO LastArc                            'DMOD1
WasZ$ = ZUserIn$(ArcIndex)                                                'DMOD1
   CALL AllCaps (WasZ$)  
  IF INSTR(WasZ$,"*") OR INSTR(WasZ$,"?") THEN _
    CALL QuickTPut ("Sorry, but Wildcards are NOT allowed !!",1) : _   ' Bh
     GOTO 60149                                           'PEMOD1
 CALL BreakFileName (WasZ$,Drive$,Prefix$,Ext$,ZFalse)                        'DMOD1
 IF Ext$ = "ARC" OR Ext$ = "COM" OR Ext$ = "EXE" OR Ext$ = "BAS" OR _   'DMOD1
         Ext$ = "BIN" OR Ext$ = "LIB" OR Ext$ = "OBJ" OR Ext$ = "PIC" THEN _ 
         CALL QuickTPut ("Sorry, but only text files can be displayed",1) :_      'DMOD1  ' Bh
         GOTO 60149                                                     'DMOD1
      CALL QuickTPut (" Extracting file....",1)    'DMOD1
'
'
' ******* Next 3 lines added for ZIP support    Pe 02/19/89
IF ZLastExt$ = "ZIP" THEN _
 SHOWME$ = ZLibArcPath$+"PKUNZIP -O " + ZFileName$ + " " + WasZ$ + " "+ZArkViewPath$ : _
GOTO 60150 _
ELSE IF ZLastExt$ = "LZH" THEN _
 SHOWME$ = ZLibArcPath$+"VIEWLZH.BAT "+ZArkViewPath$+" "+ZFileName$+" "+WasZ$ : _
  GOTO 60150
'
 IF MID$(ZLibArcProgram$,1,2) ="PK" THEN _
      SHOWME$ = ZLibArcPath$+"PKXARC -R " + ZFileName$ + " " + WasZ$ + " "+ZArkViewPath$
 IF MID$(ZLibArcProgram$,1,2) ="AR" THEN _
      SHOWME$ = ZLibArcPath$+"ARCE " + ZFileName$ + " " + WasZ$ + " "+ZArkViewPath$ + " /R"
 IF MID$(ZLibArcProgram$,1,3) ="PAK" THEN _
 SHOWME$ = ZLibArcPath$+"PAK /E /WA " + ZFileName$ + " "+ ZArkViewPath$+WasZ$
60150 SHOWME$ = "COMMAND.COM /C "+SHOWME$   'Pe 09/20/89
      SHELL SHOWME$                                         'Pe 02/19/89
      WasZ$ = ZArkViewPath$ + WasZ$      'Pe 09/23/89
      Temp$ = WasZ$
CALL FindIt (WasZ$)
        IF NOT ZOK THEN _
         CALL QuickTPut(CHR$(7)+WasZ$+" ISN'T HERE or perhaps you misspelled",1) :_  ' Bh
        GOTO 60149
      CALL BufFile (WasZ$,WasX)                                             'DMOD1
      CALL KillWork(Temp$)   'get rid of the files that were xtracted   PEMOD1
       NEXT ArcIndex
GOTO 60140
'
60168 ZSubParm = 1
      CALL SkipLine (1)
60169  ZOutTxt$ = "Which file(s) to Extract, R)elist or [RETURN] to quit"  ' Bh
    CALL TGet
IF ZSubParm = -1 OR ZWasQ = 0 THEN _      'Pe 02/12/90
   EXIT SUB                              'Pe 02/12/90
IF ZUserIn$ = "R" or ZUserIn$ = "r" THEN _
   CALL BufFile (ZArcWork$,WasX) : _
   GOTO 60168
     ZwasB = 1                                                            'DMOD1
     LastArc = ZwasQ                                                    'DMOD1
     FirstArc = ZwasB                                                   'DMOD1
 FOR ArcIndex = FirstArc TO LastArc                           'DMOD1
 WasZ$ = ZUserIn$(ArcIndex)                                                   'DMOD1
     CALL AllCaps (WasZ$)
     CALL BreakFileName (WasZ$,Drive$,Prefix$,Ext$,ZFalse)                        'DMOD1
     CALL SkipLine (2)
     CALL QuickTPut ("Please stand by, extracting file(s)....",1)    'DMOD1
'
'Next 3 lines for ZIP Support Pe 02/19/89
'
IF ZLastExt$ = "ZIP" THEN _
 SHOWME$ = ZLibArcPath$+"PKUNZIP -O " + ZFileName$ + " " + WasZ$ + " "+ZArkViewPath$ : _
GOTO 60170 _
ELSE IF ZLastExt$ = "LZH" THEN _
 SHOWME$ = ZLibArcPath$+ "VIEWLZH.BAT "+ZArkViewPath$+" "+ZFileName$+" "+WasZ$ : _
 GOTO 60170

'
'
 IF MID$(ZLibArcProgram$,1,2) ="PK" THEN _
      SHOWME$ = ZLibArcPath$+"PKXARC -R " + ZFileName$ + " " + WasZ$ + " " + ZArkViewPath$
 IF MID$(ZLibArcProgram$,1,2) ="AR" THEN _
      SHOWME$ = ZLibArcPath$+"ARCE " + ZFileName$ + " " + WasZ$ + " " + ZArkViewPath$+" /R"
 IF MID$(ZLibArcProgram$,1,3) ="PAK" THEN _
      SHOWME$ = ZLibArcPath$+"PAK /E /WA " + ZFileName$ + " " + ZArkViewPath$ + "\" +WasZ$
'
60170 SHOWME$ = "COMMAND.COM /C "+ SHOWME$
 SHELL SHOWME$     'Added line Number Pe 02/19/89
LOOKFOR$ = ZArkViewPath$ + WasZ$  'Pe 09/23/89
CALL FindIt(LOOKFOR$)
     IF NOT ZOK THEN _
CALL QuickTPut ("Error extracting " + WasZ$ + "...file Skipped...",2) : _
      GOTO 60171
       CALL QuickTPut (WasZ$+" Is now  Extracted ...",2)
60171 NEXT ArcIndex
CALL QuickTPut ("Use the C)ompress command to create a ZIP file of Xtracted files",2)
GOTO 60140
'
' ***  Added choice of Compressing file or taking it as is Pe 03/23/89 ***
'
60175 ZSubparm = 1          'Pe 02/12/90
      ZOutTxt$ = ZCrLf$ +"List files about to be Compressed (Y/[N])"
      ZTurboKey = -ZTurboKeyUser        'Pe 02/12/90
       CALL TGet
       CALL AllCaps (ZUserIn$)        'Pe 02/12/90    
IF ZSubParm = -1 THEN _      'Pe 03/29/88
   EXIT SUB                              'Pe 03/29/88
IF ZWasQ = 0 OR ZUserIn$ ="N" Then _            'Pe 02/12/90
   GOTO 60179                            'pe 04/07/89
IF ZUserIn$ = "Y" THEN _           'Pe 03/29/89
 CALL QuickTPut ("Creating file list, one moment please....",1): _
   EXTRACT$ = "DIR "+ ZArkViewPath$+"*.* >VUZIP"+ZNodeID$+".LST" : _
   SHELL EXTRACT$ : _
CALL BufFile("VUZIP"+ZNodeID$ +".LST",WasX) : _
ZSubParm = 1 : _         'Pe 03/26/89
 ZOutTxt$ = ZCrLf$ +"Continue with file Compression ([Y]/N) " : _
ZTurboKey = -ZTurboKeyUser : _            'Pe 02/12/90
    CALL TGet : _
IF ZSubParm = -1 THEN _      'Pe 03/29/88
   EXIT SUB   : _                              'Pe 03/29/88
IF ZUserIn$ = "N" or ZUserIn$ = "n" THEN _           'Pe 03/29/89
 GOTO 60140 : _
 CALL QuickTPut ("One Moment Compressing file(s)........",1)
'
'********** ZIP all files in the ZArkViewPath$ into VIEW.ZIP **********
'
'60179  ZIPME$ = ZLibArcPath$+"PKZIP -m -ex -z<C:\C3\MPL.CMT " + ZArkViewPath$ + "VIEW.ZIP " + ZArkViewPath$ + "*.*"
60179  ZIPME$ = ZLibArcPath$+"PKZIP -m -ex " + ZArkViewPath$ + "VIEW.ZIP " + ZArkViewPath$ + "*.*"
'
If ZLocalUser THEN _
SHELL ZIPME$ _
ELSE  ZIP$ = "VUZIP"+ZNodeID$+".BAT": _
          CALL OpenOutW (ZIP$) : _
          PRINT #2, "ECHO OFF" : _
          PRINT #2, "CTTY GATE"+RIGHT$(ZComPort$,1) : _
          PRINT #2, ZIPME$ : _
          PRINT #2, "CTTY CON" : _
          PRINT #2, "ECHO ON" : _
          PRINT #2, "EXIT": _
CALL ShellExit (ZIP$)
'SHELL ZIPME$
'
' **** Check to see if Compresion was successfull if NOT then redo *****
ViewFileName$ = ZArkViewPath$ + "VIEW.ZIP"   'Pe 09/23/89 removed
CALL FindIt (ViewFileName$)
IF NOT ZOK THEN _
CALL QuickTPut ( "No files to Compress...you must use the X)tract command first" ,2) : _
CALL DelayTime (2) : _
GOTO 60140
'
'
'********** Tells the caller the name of the file to download **********
'
CALL QuickTPut (" File has been Compressed and named... VIEW.ZIP....",2)
CALL QuickTPut (CHR$(7)+"To Download this file You MUST enter VIEW.ZIP as the file name",2)
CALL DelayTime (3)
GOTO 60140
60180 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 = 20310 AND ERR = 14 THEN _       'Pe 01/03/90
          RESUME NEXT                           'Pe 01/03/90
       IF ERL = 20311 AND ERR = 57 THEN _
          RESUME NEXT
       IF ERL = 20311 AND ERR = 69 THEN _
          ZAbort = ZTrue : _
          ZSubParm = -1 : _
          RESUME NEXT
'
'     FileLock ERROR HANDLER       'Pe 11/20/89
'
      IF ERL => 21995 AND ERL <= 29830 THEN _   'Pe 11/20/89
       RESUME NEXT                              'PE 11/20/89
'
'     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 _                                         ' KG012802
          IF ERR = 57 THEN _                                         ' AC012601
             CALL DelayTime (1) : _                                  ' AC012601
             CALL UpdtCalr ("SLOW I/O ERROR",1) : _                  ' AC012601
             IOErrorCount = IOErrorCount + 1 : _                     ' AC012601
             IF IOErrorCount < 11 THEN _                             ' AC012601
                RESUME                                               ' AC012601
'
'     Chat Door Error handleing
'
'     IF (ERL = 59800 OR ERL = 59810) AND ERR = 70 THEN             'Pe 02/27/90
'          RESUME
'       END IF
'
'      VIEW ARC TXT ERROR HANDLER
'
 IF ERL = 60149 AND ERR = 53 THEN _
         CALL QuickTPut ("ERROR !!! No Such File, EXITING",1):_
         RESUME NEXT
IF ERL = 60149 AND ERR = 63 THEN _
         CALL QuickTPut ("ERROR Occured, Please notify SysOp",1):_
         RESUME NEXT
'
'
'      DLVIEW ARC TXT ERROR HANDLER 
'
 IF ERL = 60170 AND ERR = 53 THEN _
         CALL QuickTPut ("ERROR !!! No Such File, EXITING",1):_
         RESUME NEXT
'
'
'
'     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
       SYSTEM