home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / comm / rbbs3.zip / RBBSSUB1.BAS < prev    next >
BASIC Source File  |  1990-10-28  |  54KB  |  1,666 lines
  1. ' $linesize:132
  2. ' $title: 'RBBS-SUB1.BAS 17.3B, Copyright 1986-90 by D. Thomas Mack' ' DA081003
  3. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB1.BAS
  5. '  First Released .....: February 11, 1990
  6. '  Subsequent Releases.: August 26, 1990; October 28, 1990
  7. '  Copyright ..........: 1986-1990
  8. '  Purpose.............:
  9. '     Subprorams that require error trapping are incorporated
  10. '     within RBBSSUB1.BAS as separately callable subroutines
  11. '     in order to free up as much code as possible within
  12. '     the 64WasK code segment used by RBBS-PC.BAS.
  13. '  Parameters..........: Most parameters are passed via a COMMON statement.
  14. '
  15. ' Subroutine  Line               Function of Subroutine
  16. '   Name     Number
  17. '  ChangeDir   20101   Change subdirectory
  18. '  CheckInt    58360   Check input is valid integer
  19. '  CommPut     59275   Write string to communications port
  20. '  FindFile    59790   Determine whether a file exists without opening it
  21. '  FindFree    51098   Find amount of space on the upload disk drive
  22. '  FindItX     20219   Find if a file exists on a device
  23. '  FindUser    12598   Find a user in the USERS file
  24. '  FlushCom    20308   Read all characters in the communications port
  25. '  GetCom       1418   Read a character from the communications port
  26. '  GetPassword 58280   Read RBBS-PC's "PASSWORD" file
  27. '  GETWRK      58330   Read record from file number 2
  28. '  KillWork    58258   Delete a RBBS-PC "WORK" file
  29. '  NetBIOS     20898   Lock/Unlock NetBIOS semaphore files
  30. '  OpenCom       200   Open communications port (number 3)
  31. '  OpenFMS     58188   Open the upload management system directory
  32. '  OpenOutW    28218   Open RBBS-PC's "WORK" file (number 2) for output
  33. '  OpenRSeq     1479   Open a sequential file (number 2) for random I/O
  34. '  OpenUser     9398   Open the USER file (number 5)
  35. '  OpenWork    57978   Open RBBS-PC's work file (number 2)
  36. '  OpenWorkA   58340   Open RBBS-PC's "WORK" file (number 2) for append
  37. '  Printit     13673   Print line on the local PC printer
  38. '  PrintWork   58320   Print string to file #2 w/o CR/LF
  39. '  PrintWorkA  58350   Print string to file #2 with CR/LF
  40. '  PutCom      59650   Write to the communications port
  41. '  PutWork     59660   Write to work file randomly
  42. '  RBBSPlay    59680   Plays a musical string
  43. '  ReadAny     58310   Read file number 2 into ZOutTxt$
  44. '  ReadDef       112   Read configuration file
  45. '  ReadDir     58290   Read entire lines
  46. '  ReadParms   58300   Read certain number of parameters from file 2
  47. '  Talk        59700   RBBS-PC Voice synthesizer support for sight impaired
  48. '  SetCall       108   Find where next callers record is
  49. '  UpdateC     43048   Update the caller's file with elasped session time
  50. '  UpdtCalr    13661   Update to the caller's file
  51. '
  52. '  $INCLUDE: 'RBBS-VAR.BAS'
  53. '
  54. 108 ' $SUBTITLE: 'SetCall - subroutine to find last callers rec'
  55. ' $PAGE
  56. '
  57. '  NAME    -- SetCall
  58. '
  59. '  INPUTS  --     PARAMETER                    MEANING
  60. '
  61. '  OUTPUTS --  ZCallersFileIndex!
  62. '
  63. '  PURPOSE --  To find where to leave off on callers file
  64. '
  65.     SUB SetCall STATIC
  66.     ON ERROR GOTO 65000
  67.     IF ZPrevCaller$ = ZCallersFile$ OR ZCallersFilePrefix$ = "" THEN _ ' KG052401
  68.        EXIT SUB
  69.     ZPrevCaller$ = ZCallersFile$                                     ' KG052401
  70.     ZCallersFileIndex! = 1
  71.     CLOSE 2
  72.     CLOSE 4
  73.     IF ZShareIt THEN _
  74.        OPEN ZCallersFile$ FOR RANDOM SHARED AS #4 LEN=64 _
  75.     ELSE OPEN "R",4,ZCallersFile$,64
  76.     FIELD 4,64 AS ZCallersRecord$
  77.     IF LOF(4) > 0 THEN _
  78.        ZCallersFileIndex! = LOF(4) / 64
  79.     IF ZCallersFileIndex! < 1 THEN _
  80.        ZCallersFileIndex! = 0
  81.     ZUserIn$ = STRING$(13,0)
  82. 110 GET 4,ZCallersFileIndex!
  83.     IF ZErrCode > 0 THEN _
  84.        ZErrCode = 0 : _
  85.        ZCallersFileIndex! = 0 : _
  86.        EXIT SUB
  87.     IF LEFT$(ZCallersRecord$,13) = ZUserIn$ THEN _
  88.        ZCallersFileIndex! = ZCallersFileIndex! - 1 : _
  89.        GOTO 110
  90.     END SUB
  91. 112 ' $SUBTITLE: 'ReadDef - subroutine to read RBBS-PC.DEF file'
  92. ' $PAGE
  93. '
  94. '  NAME    -- ReadDef
  95. '
  96. '  INPUTS  --     PARAMETER                    MEANING
  97. '                ZConfigFileName$            NAME OF RBBS-PC.DEF FILE
  98. '                ZSubParm = -62              ONLY READ THE .DEF FILE
  99. '
  100. '  OUTPUTS --  ALL THE RBBS-PC.DEF PARAMETERS
  101. '
  102. '  PURPOSE --  TO READ THE PARAMETERS FROM THE RBBS-PC.DEF FILE
  103. '
  104.      SUB ReadDef (ConfigFile$) STATIC
  105.      ON ERROR GOTO 65000
  106. '
  107. ' **** OPEN AND READ RBBS-PC CONFIGURATION DEFINITIONS ***
  108. '
  109. 117 IF ZSubParm <> -62 THEN _
  110.        IF PrevRead$ = ConfigFile$ THEN _
  111.           EXIT SUB _
  112.        ELSE PrevRead$ = ConfigFile$
  113.     CLOSE 2
  114.     ZBulletinSave$ = ZBulletinMenu$
  115.     CALL OpenWork (2,ConfigFile$)
  116.     ZCurDef$ = ConfigFile$
  117.     INPUT #2,ZWasDF$, _
  118.              ZDnldDrives$, _
  119.              ZSysopPswd1$, _
  120.              ZSysopPswd2$, _
  121.              ZSysopFirstName$, _
  122.              ZSysopLastName$, _
  123.              ZRequiredRings, _
  124.              ZStartOfficeHours, _
  125.              ZEndOfficeHours, _
  126.              ZMinsPerSession, _
  127.              ZWasDF, _
  128.              ZWasDF, _
  129.              ZUpldDir$, _
  130.              ZExpertUserDef, _
  131.              ZActiveBulletins, _
  132.              ZPromptBellDef, _
  133.              ZWasDF, _
  134.              ZMenusCanPause, _
  135.              ZMenu$(1), _
  136.              ZMenu$(2), _
  137.              ZMenu$(3), _
  138.              ZMenu$(4), _
  139.              ZMenu$(5), _
  140.              ZMenu$(6), _
  141.              ZConfMenu$, _
  142.              ZWasDF, _
  143.              ZWelcomeInterruptable, _
  144.              ZRemindFileXfers, _
  145.              ZPageLengthDef, _
  146.              ZMaxMsgLinesDef, _
  147.              ZDoorsAvail, _
  148.              ZWasDF$, _
  149.              ZMainMsgFile$, _
  150.              ZMainMsgBackup$
  151.     INPUT #2, WasX$, _
  152.               ZCmntsFile$, _
  153.               ZMainUserFile$, _
  154.               ZWelcomeFile$, _
  155.               ZNewUserFile$, _
  156.               ZMainDirExtension$
  157.     CALL BreakFileName (WasX$,ZWasY$,ZWasDF$,ZWasZ$,ZFalse)
  158.     IF ZWasDF$ <> "" THEN _
  159.        ZCallersFile$ = WasX$
  160.     INPUT #2, ZWasDF$
  161.     IF ZComPort$ <> "COM0" THEN _
  162.        IF NOT ZConfMode THEN _
  163.           ZComPort$ = ZWasDF$
  164.     INPUT #2, ZBulletinsOptional, _
  165.               ZModemInitCmd$, _
  166.               ZRTS$, _
  167.               ZWasDF, _
  168.               ZFG, _
  169.               ZBG, _
  170.               ZBorder
  171.     IF ZConfMode THEN _
  172.        INPUT #2, ZWasDF$, _
  173.                  ZWasDF$ _
  174.     ELSE INPUT #2, ZRBBSBat$ , _
  175.                    ZRCTTYBat$
  176.     INPUT #2,ZOmitMainDir$, _
  177.              ZFirstNamePrompt$, _
  178.              ZHelp$(3), _
  179.              ZHelp$(4), _
  180.              ZHelp$(7), _
  181.              ZHelp$(9), _
  182.              ZBulletinMenu$, _
  183.              ZBulletinPrefix$, _
  184.              ZWasDF$, _
  185.              ZMsgReminder, _
  186.              ZRequireNonASCII, _
  187.              ZAskExtendedDesc, _
  188.              ZMaxNodes, _
  189.              ZNetworkType
  190.     IF ZConfMode THEN _
  191.          INPUT #2, ZwasDF _
  192.     ELSE INPUT #2, ZRecycleToDos
  193.     INPUT #2,ZWasDF, _
  194.              ZWasDF, _
  195.              ZTrashcanFile$
  196.     INPUT #2,ZMinLogonSec, _
  197.              ZDefaultSecLevel, _
  198.              ZSysopSecLevel, _
  199.              ZFileSecFile$, _
  200.              ZSysopMenuSecLevel, _
  201.              ZConfMailList$, _
  202.              ZMaxViolations, _
  203.              ZOptSec(50), _   ' SECURITY FOR ZSysop COMMANDS 1
  204.              ZOptSec(51), _
  205.              ZOptSec(52), _
  206.              ZOptSec(53), _
  207.              ZOptSec(54), _
  208.              ZOptSec(55), _
  209.              ZOptSec(56), _   ' ZSysop 7
  210.              ZPswdFile$, _
  211.              ZMaxPswdChanges, _
  212.              ZMinSecForTempPswd, _
  213.              ZOverWriteSecLevel, _
  214.              ZDoorsTermType, _
  215.              ZMaxPerDay
  216.     INPUT #2,ZOptSec(1), _   ' SECURITY FOR MAIN MENU COMMANDS 1
  217.              ZOptSec(2), _
  218.              ZOptSec(3), _
  219.              ZOptSec(4), _
  220.              ZOptSec(5), _
  221.              ZOptSec(6), _
  222.              ZOptSec(7), _
  223.              ZOptSec(8), _
  224.              ZOptSec(9), _
  225.              ZOptSec(10), _
  226.              ZOptSec(11), _
  227.              ZOptSec(12), _
  228.              ZOptSec(13), _
  229.              ZOptSec(14), _
  230.              ZOptSec(15), _
  231.              ZOptSec(16), _
  232.              ZOptSec(17), _
  233.              ZOptSec(18), _   ' MAIN COMMAND 18
  234.              ZMinNewCallerBaud, _
  235.              ZWaitBeforeDisconnect
  236.     INPUT #2,ZOptSec(19), _      ' Security for FILE COMMANDS 1
  237.              ZOptSec(20), _
  238.              ZOptSec(21), _
  239.              ZOptSec(22), _
  240.              ZOptSec(23), _
  241.              ZOptSec(24), _
  242.              ZOptSec(25), _
  243.              ZOptSec(26), _      ' FILE COMMAND 8
  244.              ZOptSec(27), _      ' SECURITY FOR UTILITY COMMANDS 1
  245.              ZOptSec(28), _
  246.              ZOptSec(29), _
  247.              ZOptSec(30), _
  248.              ZOptSec(31), _
  249.              ZOptSec(32), _
  250.              ZOptSec(33), _
  251.              ZOptSec(34), _
  252.              ZOptSec(35), _
  253.              ZOptSec(36), _
  254.              ZOptSec(37), _
  255.              ZOptSec(38), _   ' UTIL COMMAND 12
  256.              ZOptSec(46), _   ' SECURITY FOR GLOBAL COMMANDS 1
  257.              ZOptSec(47), _
  258.              ZOptSec(48), _
  259.              ZOptSec(49), _
  260.              ZUpldTimeFactor!, _
  261.              ZComputerType, _
  262.              ZRemindProfile, _
  263.              ZRBBSName$, _
  264.              ZCmdsBetweenRings, _
  265.              ZMNPSupport, _
  266.              ZPagingPtrSupport$
  267.     IF ZConfMode THEN _
  268.          INPUT #2, ZwasDF _
  269.     ELSE INPUT #2, ZModemInitBaud$
  270.              IF ZErrCode > 0 THEN _
  271.                 EXIT SUB
  272. 118 INPUT #2, ZTurnPrinterOff,_    ' Turn printer off each recycle
  273.               ZDirPath$, _    ' Where dir files are stored
  274.               ZMinSecToView, _
  275.               ZLimitSearchToFMS, _
  276.               ZDefaultCatCode$, _
  277.               ZDirCatFile$, _
  278.               ZNewFilesCheck, _
  279.               ZMaxDescLen, _
  280.               ZShowSection, _
  281.               ZCmndsInPrompt, _
  282.               ZNewUserSetsDefaults, _
  283.               ZHelpPath$, _
  284.               ZHelpExtension$, _
  285.               ZMainCmds$, _
  286.               ZFileCmd$, _
  287.               ZUtilCmds$, _
  288.               ZGlobalCmnds$, _
  289.               ZSysopCmds$
  290.     INPUT #2, ZRecycleWait, _
  291.               ZOptSec(39), _       ' SECURITY FOR Library COMMANDS 1
  292.               ZOptSec(40), _
  293.               ZOptSec(41), _
  294.               ZOptSec(42), _
  295.               ZOptSec(43), _
  296.               ZOptSec(44), _
  297.               ZOptSec(45), _       ' Library COMMANDS 7
  298.               ZLibDrive$, _
  299.               ZLibDirPath$, _
  300.               ZLibDirExtension$, _
  301.               ZLibWorkDiskPath$, _
  302.               ZLibMaxDisk, _
  303.               ZLibMaxDir, _
  304.               ZLibMaxSubdir, _
  305.               ZLibSubdirPrefix$, _
  306.               ZLibArcPath$, _
  307.               ZLibArcProgram$, _
  308.               ZLibCmds$
  309. '
  310. ' *****  ESTABLISH COMMUNICATION PORT REGISTERS AND COMMANDS   ***
  311. ' *****     GET DOS SUB-DIRECTORY RBBS-PC OPTIONS              ***
  312. '
  313.     INPUT #2, ZUpldPath$, _              ' Where upl dir goes
  314.               ZMainFMSDir$, _       ' Shared dir in FMS
  315.               ZAnsMenu$, _
  316.               ZReqQues$,_
  317.               ZRememberNewUsers,_
  318.               ZSurviveNoUserRoom,_
  319.               ZPromptHash$,_
  320.               ZStartHash,_
  321.               ZLenHash,_
  322.               ZPromptIndiv$,_
  323.               ZStartIndiv,_
  324.               ZLenIndiv
  325.     INPUT #2, ZBypassMsgs, _
  326.               ZMusic, _
  327.               ZRestrictByDate, _
  328.               ZDaysToWarn, _
  329.               ZDaysInRegPeriod, _
  330.               ZVoiceType, _
  331.               ZRestrictValidCmds, _
  332.               ZNewUserDefaultMode, _
  333.               ZNewUserLineFeeds, _
  334.               ZNewUserNulls, _
  335.               ZFastFileList$, _
  336.               ZFastFileLocator$, _
  337.               ZMsgsCanGrow, _
  338.               ZWrapCallersFile$, _
  339.               ZRedirectIOMethod, _
  340.               ZAutoUpgradeSec, _
  341.               ZHaltOnError, _
  342.               ZNewPublicMsgsSec, _
  343.               ZNewPrivateMsgsSec, _
  344.               SecNeededToChangeMsgs, _
  345.               ZSLCategorizeUplds, _
  346.               ZBaudot, _
  347.               ZHourMinToDropToDos, _
  348.               ZExpiredSec, _
  349.               ZDTRDropDelay, _
  350.               ZAskID, _
  351.               ZMaxRegSec, _
  352.               ZBufferSize, _
  353.               ZMLCom, _
  354.               ZNoDoorProtect, _
  355.               ZDefaultExtension$, _
  356.               ZNewUserDefaultProtocol$, _
  357.               ZNewUserGraphics$, _
  358.               ZNetMail$, _
  359.               ZMasterDirName$, _
  360.               ZProtoDef$, _
  361.               ZUpcatHelp$, _
  362.               ZAllwaysStrewTo$, _
  363.               ZLastNamePrompt$
  364. 119 INPUT #2, ZPersonalDrvPath$, _
  365.               ZPersonalDir$, _
  366.               ZPersonalBegin, _
  367.               ZPersonalLen, _
  368.               ZPersonalProtocol$, _
  369.               ZPersonalConcat , _
  370.               ZPrivateReadSec, _
  371.               ZPublicReadSec, _
  372.               ZSecChangeMsg
  373.     IF ZConfMode THEN _
  374.          INPUT #2, ZwasDF _
  375.     ELSE INPUT #2, ZKeepInitBaud
  376.     INPUT #2, ZMainPUI$
  377.     IF ZConfMode THEN _
  378.        INPUT #2, ZWasDF$,ZWasDF$,ZWasDF$ _
  379.     ELSE INPUT #2, ZDefaultEchoer$, _
  380.                    ZHostEchoOn$, _
  381.                    ZHostEchoOff$
  382.     INPUT #2, ZSwitchBack, _
  383.               ZDefaultLineACK$, _
  384.               ZAltdirExtension$, _
  385.               ZDirPrefix$
  386.     IF ZConfMode THEN _
  387.        INPUT #2, ZWasDF, _
  388.                  ZWasDF, _
  389.                  ZWasDF _
  390.     ELSE INPUT #2, ZWasDF,_
  391.                    ZModemInitWaitTime, _
  392.                    ZModemCmdDelayTime
  393.     INPUT #2, ZTurboRBBS, _
  394.               ZSubDirCount, _
  395.               ZWasDF, _
  396.               ZUpldToSubdir, _
  397.               ZWasDF, _
  398.               ZUpldSubdir$, _
  399.               ZMinOldCallerBaud, _
  400.               ZMaxWorkVar, _
  401.               ZDiskFullGoOffline, _
  402.               ZExtendedLogging
  403.      IF ZConfMode THEN _
  404.         INPUT #2, ZWasDF$, _
  405.                   ZWasDF$, _
  406.                   ZWasDF$, _
  407.                   ZWasDF$ _
  408.      ELSE INPUT #2, ZModemResetCmd$, _
  409.                     ZModemCountRingsCmd$, _
  410.                     ZModemAnswerCmd$, _
  411.                     ZModemGoOffHookCmd$
  412.      INPUT #2,ZDiskForDos$, _
  413.               ZDumbModem, _
  414.               ZCmntsAsMsgs
  415.      IF ZConfMode THEN _
  416.         INPUT #2, ZWasDF, _
  417.                   ZWasDF, _
  418.                   ZWasDF, _
  419.                   ZWasDF, _
  420.                   ZWasDF, _
  421.                   ZWasDF _
  422.      ELSE INPUT #2, ZLSB,_
  423.                     ZMSB,_
  424.                     ZLineCntlReg,_
  425.                     ZModemCntlReg,_
  426.                     ZLineStatusReg,_
  427.                     ZModemStatusReg
  428.      INPUT #2,ZKeepTimeCredits, _
  429.               ZXOnXOff, _
  430.               ZAllowCallerTurbo, _
  431.               ZUseDeviceDriver$, _
  432.               ZPreLog$, _
  433.               ZNewUserQuestionnaire$, _
  434.               ZEpilog$, _
  435.               ZRegProgram$, _
  436.               ZQuesPath$, _
  437.               ZUserLocation$, _
  438.               ZWasDF$, _
  439.               ZWasDF$, _
  440.               ZWasDF$, _
  441.               ZEnforceRatios, _
  442.               ZSizeOfStack, _
  443.               ZSecExemptFromEpilog, _
  444.               ZUseBASICWrites, _
  445.               ZDosANSI, _
  446.               ZEscapeInsecure, _
  447.               ZUseDirOrder, _
  448.               ZAddDirSecurity, _
  449.               ZMaxExtendedLines, _
  450.               ZOrigCommands$
  451.      INPUT #2,ZLogonMailLevel$, _
  452.               ZMacroDrvPath$, _
  453.               ZMacroExtension$, _
  454.               ZEmphasizeOnDef$, _
  455.               ZEmphasizeOffDef$, _
  456.               ZFG1Def$, _
  457.               ZFG2Def$, _
  458.               ZFG3Def$, _
  459.               ZFG4Def$, _
  460.               ZSecVioHelp$
  461.      IF ZConfMode THEN _
  462.         INPUT #2,ZWasDF _
  463.      ELSE INPUT #2,ZFossil
  464.      INPUT #2,ZMaxCarrierWait, _
  465.               ZWasDF, _
  466.               ZSmartTextCode, _
  467.               ZTimeLock, _
  468.               ZWriteBufDef, _
  469.               ZSecKillAny, _
  470.               ZDoorsDef$, _
  471.               ZScreenOutMsg$, _
  472.               ZAutoPageDef$
  473.      IF ZErrCode > 0 THEN _
  474.         EXIT SUB
  475.      ZConfigFileName$ = ConfigFile$
  476.      CALL EditDef
  477.      END SUB
  478. 200 ' $SUBTITLE: 'OpenCom - subroutine to open the communications port'
  479. ' $PAGE
  480. '
  481. '  NAME    -- OpenCom
  482. '
  483. '  INPUTS  --     PARAMETER                    MEANING
  484. '                BaudRate$                  BAUD TO OPEN MODEM
  485. '                Parity$                    PARITY TO OPEN MODEM
  486. '
  487. '  OUTPUTS -- BaudTest!                     BAUD RATE TO SET RS232 AT
  488. '
  489. '  PURPOSE -- To open the communications port.
  490. '
  491.     SUB OpenCom (BaudRate$,Parity$) STATIC
  492.     ON ERROR GOTO 65000
  493.     IF ZFossil THEN _
  494.        IF ZRTS$ = "YES" THEN _
  495.           ZFlowControl = ZTrue : _
  496.           Flow = &H00F2 : _
  497.           CALL FosFlowCtl(ZComPort,Flow)
  498.     IF INSTR(Parity$,"N") THEN _
  499.        Parity = 2 : _                                     ' No PARITY
  500.        DataBits = 3 : _                                   ' 8 DATA BITS
  501.        StopBits = 0 _                                     ' 1 STOP BIT
  502.     ELSE Parity = 3 : _                                   ' EVEN PARITY
  503.          DataBits = 2 : _                                 ' 7 DATA BITS
  504.          StopBits = 0                                     ' 1 STOP BIT
  505.     IF NOT ZFossil THEN _
  506.        GOTO 202
  507.     IF Baudrate$ = "38400" THEN _
  508.        ComSpeed = &H9600 _
  509.     ELSE ComSpeed = VAL(BaudRate$)
  510.     CALL FosSpeed(ZComPort,ComSpeed,Parity,DataBits,StopBits)
  511.     EXIT SUB
  512. 202 CLOSE 3
  513.     IF ZRTS$ = "YES" THEN _
  514.        ZFlowControl = ZTrue : _
  515.        WasX$ = ",CS26600,CD,DS" _
  516.     ELSE WasX$ = ",RS,CD,DS"
  517.     WasX = (VAL(BaudRate$) > 19200)
  518.     IF WasX THEN _
  519.        ZWasY$ = "19200" _
  520.     ELSE ZWasY$ = BaudRate$
  521.     OPEN ZComPort$ + ":" + ZWasY$ + Parity$ + WasX$ AS #3
  522. '
  523. ' ****************************************************************************
  524. ' *  RAISE THE RTS SIGNAL IF THE MODEM USES RTS FOR MODEM FLOW CONTROL (ONCE
  525. ' *  IT IS RAISED, IT WILL STAY UP UNTIL THE REGISTER IS CLEARED OUT).
  526. ' ****************************************************************************
  527. '
  528.     END SUB
  529. 1418 ' $SUBTITLE: 'GetCom -- subroutine reads a char. from  comm. port'
  530. ' $PAGE
  531. '
  532. '  NAME    -- GetCom
  533. '
  534. '  INPUTS  --   PARAMETER     MEANING
  535. '                 Strng$       STRING TO READ A CHARACTER INTO FROM
  536. '                              THE COMMUNICATIONS PORT (FILE #3)
  537. '
  538. '  OUTPUTS --   Strng$
  539. '
  540. '  PURPOSE -- Reads a character from the communications port.
  541. '
  542.      SUB GetCom (Strng$) STATIC
  543.      ON ERROR GOTO 65000
  544. 1420 IF ZFOSSIL THEN _
  545.         CALL FOSRXChar(ZComPort,Char) : _
  546.         Strng$ = CHR$(Char) _
  547.      ELSE Strng$ = INPUT$(1,3)
  548. 1421 IF ZErrCode = 57 THEN _
  549.         LineStatus = INP(ZLineStatusReg) : _
  550.         ZErrCode = 0 : _
  551.         GOTO 1420
  552.      END SUB
  553. 1479 ' $SUBTITLE: 'OpenRSeq  - open sequential file randomly'
  554. ' $PAGE
  555. '
  556. '  NAME    -- OpenRSeq
  557. '
  558. '  INPUTS  -- PARAMETER             MEANING
  559. '             FilName$      NAME OF SEQUENTIAL FILE TO OPEN AS #2
  560. '
  561. '  OUTPUTS -- NumRecs      NUMBER OF 128-BYTE RECORDS IN THE FILE
  562. '             LenLastRec   NUMBER OF BYTES IN THE LAST RECORD (IT
  563. '                          MAY BE LESS THAN OR EQUAL TO 128).
  564. '
  565. '  PURPOSE -- Open a sequential file as file #2 and read it randomly
  566. '
  567.      SUB OpenRSeq (FilName$,NumRecs,LenLastRec,RecLen) STATIC
  568.      ON ERROR GOTO 65000
  569.      CLOSE 2
  570. 1480 ZErrCode = 0
  571. 1481 IF ZShareIt THEN _
  572.         OPEN FilName$ FOR RANDOM SHARED AS #2 LEN=RecLen _
  573.      ELSE OPEN "R",2,FilName$,RecLen
  574.      IF ZErrCode = 52 THEN _
  575.         GOTO 1480
  576.      FIELD #2, RecLen AS ZDnldRecord$
  577.      WasI# = LOF(2)
  578.      NumRecs = FIX(WasI#/RecLen)
  579.      LenLastRec = WasI# - CDBL(NumRecs) * RecLen
  580.      IF LenLastRec > 0 THEN _
  581.         NumRecs = NumRecs + 1 _
  582.      ELSE LenLastRec = RecLen
  583.      END SUB
  584. 9398 ' $SUBTITLE: 'OpenUser - subroutine to open users file as #5'
  585. ' $PAGE
  586. '
  587. '  NAME    -- OpenUser
  588. '
  589. '  INPUTS  --     PARAMETER                    MEANING
  590. '                 ZShareIt
  591. '
  592. '  OUTPUTS -- ZActiveUserFile$
  593. '             ZCityState$
  594. '             ZElapsedTime$
  595. '             ZLastDateTimeOn$
  596. '             LastRec                # OF Last RECORD IN USERS FILE
  597. '             ZListNewDate$
  598. '             ZPswd$
  599. '             ZSecLevel$
  600. '             ZUserDnlds$
  601. '             ZUserName$
  602. '             ZUserOption$
  603. '             ZUserRecord$
  604. '             ZUserUplds$
  605. '
  606. '  PURPOSE -- Open the user file as file #5
  607. '
  608.       SUB OpenUser (LastRec) STATIC
  609.       ON ERROR GOTO 65000
  610. '
  611. ' ****  OPEN AND DEFINE USER FILE RECORD VARIABLES  ****
  612. '
  613. 9400 CLOSE 5
  614.      IF ZShareIt THEN _
  615.         OPEN ZActiveUserFile$ FOR RANDOM SHARED AS #5 LEN=128 _
  616.      ELSE OPEN "R",5,ZActiveUserFile$,128
  617.      WasI# = LOF(5)
  618.      LastRec = FIX(WasI#/128)
  619.      FIELD 5,31 AS ZUserName$, _
  620.              15 AS ZPswd$, _
  621.               2 AS ZSecLevel$, _
  622.              14 AS ZUserOption$,  _
  623.              24 AS ZCityState$, _
  624.               3 AS MachineType$, _
  625.               4 AS ZTodayDl$, _
  626.               4 AS ZTodayBytes$, _
  627.               4 AS ZDlBytes$, _
  628.               4 AS ZULBytes$, _
  629.              14 AS ZLastDateTimeOn$, _
  630.               3 AS ZListNewDate$, _
  631.               2 AS ZUserDnlds$, _
  632.               2 AS ZUserUplds$, _
  633.               2 AS ZElapsedTime$
  634.      FIELD 5,128 AS ZUserRecord$
  635.      END SUB
  636. 12598 ' $SUBTITLE: 'FindUser - subroutine to search users file for a name'
  637. ' $PAGE
  638. '
  639. '  NAME    -- FindUser
  640. '
  641. '  INPUTS  --     PARAMETER                    MEANING
  642. '             HashToLookFor$        STRING TO SEARCH FOR IN USERS
  643. '             IndivToLookFor$       STRING TO USE TO INDIVIDUATE
  644. '                                   USERS WITH SAME HASH
  645. '             StartHashPos          WHERE HASH FIELD STARTS IN THE
  646. '                                  "USERS" FILE
  647. '             LenHashField          LENGTH OF THE HASH FIELD
  648. '             StartIndivPos         WHERE THE FIELD TO DISTINGUISH
  649. '                                   AMONG USERS (I.E. WITH THE SAME
  650. '                                   NAME) STARTS IN THE "USERS" FILE
  651. '                                   (SET TO 0 IF NONE TO BE USED)
  652. '             LenIndivField         LENGTH OF FIELD TO DISTINGUISH
  653. '                                   AMONG USERS
  654. '             MaxPosition           HIGHEST RECORD TO SEARCH OR USE
  655. '
  656. '  NOTE: THIS SUBROUTINE ASSUMES THE "USERS" FILE IS OPEN AS FILE 2.
  657. '
  658. '  OUTPUTS -- WhetherFound          SET TO "TRUE" IF USER WAS Found
  659. '                                   OTHERWISE IT IS "FALSE"
  660. '             PosToUse              NUMBER OF THE "USERS" RECORD THAT
  661. '                                   BELONGS TO THE USER (IF Found) OR
  662. '                                   TO USE FOR THE USER (IF THE USER
  663. '                                   WASN'T Found)
  664. '             PosToReclaim          SET TO 0 IF THE RECORD NUMBER
  665. '                                   SELECTED FOR THIS USER HAS NEVER
  666. '                                   BEEN USED.
  667. '
  668. '  PURPOSE -- To search the "USERS" file and determine the record
  669. '             number to use for the caller in the "USERS" file.
  670. '
  671.       SUB FindUser (HashToLookFor$,IndivToLookFor$,StartHashPos,_
  672.                     LenHashField,StartIndivPos,LenIndivField,_
  673.                     MaxPosition,WhetherFound,_
  674.                     PosToUse,PosToReclaim) STATIC
  675.       ON ERROR GOTO 65000
  676.       ZErrCode = 0
  677.       WhetherFound = 0
  678.       IF HashToLookFor$ = SPACE$(LEN(HashToLookFor$)) THEN _
  679.          EXIT SUB
  680.       EmptyRec$ = SPACE$(LenHashField)
  681.       EmptyIndiv$ = SPACE$(LenIndivField)
  682.       NewUser$ = LEFT$("NEWUSER  ",LenHashField + 2)
  683.       FIELD 5, 128 AS Filler$
  684.       WasX$ = HashToLookFor$ + SPACE$(LenHashField - LEN(HashToLookFor$))
  685.       CALL HashRBBS (HashToLookFor$,MaxPosition,PosToUse,ZWasDF)
  686. 12600 ZWasY$ = IndivToLookFor$ + SPACE$(LenIndivField - LEN(IndivToLookFor$))
  687.       PosToReclaim = 0
  688.       ZErrCode = 0                                                   ' KG061001
  689. 12610 GET 5,PosToUse
  690.       IF ZErrCode > 0 THEN _
  691.          IF ZErrCode = 63 THEN _
  692.             ZErrCode = 0 : _
  693.             GOTO 12621 _
  694.          ELSE ZErrCode = 0 : _
  695.               GOTO 12620                                             ' KG061001
  696.       HashValue$ = MID$(Filler$,StartHashPos,LenHashField)
  697.       IF WasX$ = HashValue$ THEN _
  698.          IF StartIndivPos < 1 THEN _
  699.             WhetherFound = ZTrue : _                                 ' KG061001
  700.             GOTO 12622 _                                             ' KG061001
  701.          ELSE IndivValue$ = MID$(Filler$,StartIndivPos,LenIndivField) : _
  702.               IF ZWasY$ = IndivValue$ OR IndivValue$ = EmptyIndiv$ THEN _
  703.                  WhetherFound = ZTrue : _
  704.                  GOTO 12622
  705.       IF HashValue$ = EmptyRec$ THEN _
  706.          PosToUse = PosToReclaim - (PosToReclaim = 0) * PosToUse : _
  707.          WhetherFound = ZFalse : _
  708.          GOTO 12622
  709.       IF ASC(HashValue$) = 0 OR INSTR(HashValue$,NewUser$) = 1 THEN _
  710.          IF PosToReclaim = 0 THEN _
  711.             PosToReclaim = PosToUse
  712. 12620 PosToUse = PosToUse + ZWasDF
  713.       IF PosToUse > MaxPosition - 1 THEN _
  714.          PosToUse = PosToUse - MaxPosition
  715.       GOTO 12610
  716. 12621 IF PosToReclaim = 0 THEN _
  717.          PosToReclaim = PosToUse
  718.       GOTO 12620
  719. 12622 END SUB
  720. 13661 ' $SUBTITLE: 'UpdtCalr - subroutine to write to CALLERS file'
  721. ' $PAGE
  722. '
  723. '  NAME    -- UpdtCalr
  724. '
  725. '  INPUTS  --     PARAMETER                    MEANING
  726. '                 ErrMsg$                   MESSAGE TO GO IN CALLER LOG
  727. '                 EXTLog               = 1  CHECK FOR EXTENDED LOGGING
  728. '                                           BEFORE UPDATING.
  729. '                                      = 2  UPDATE CALLER LOG WITH ZWasZ$
  730. '
  731. '  OUTPUTS -- ZCurDate$           CURRENT DATE (MM-DD-YY)
  732. '             ZTime$                    CURRENT TIME (I.E. 1:13 PM)
  733. '             TIME.LOGGEND.ON$        TIME USER LOGGED ON (HH:MM:SS)
  734. '
  735. '  PURPOSE -- To update the caller's file and/or print on the
  736. '             local printer if it is enabled
  737. '
  738.       SUB UpdtCalr (ErrMsg$,EXTLog) STATIC
  739.       ON ERROR GOTO 65000
  740.       IF ZCallersFilePrefix$ = "" OR (ZLocalUser AND ZSysop) THEN _
  741.          EXIT SUB
  742.       WasX$ = "     " + ErrMsg$
  743. 13663 ZErrCode = 0
  744.       FIELD 4, 64 AS ZCallersRecord$
  745.       IF ZErrCode > 0 THEN _
  746.          CALL QuickTPut1 ("Caller's file:  error"+STR$(ZErrCode)) : _
  747.          ZErrCode = 0 : _
  748.          EXIT SUB
  749.       ON EXTLog GOTO 13665,13670
  750. '
  751. ' ****  EXTENDED LOGGING ENTRY  ***
  752. '
  753. 13665 IF NOT ZExtendedLogging THEN _
  754.          EXIT SUB
  755.       CALL AMorPM
  756.       WasX$ = WasX$ + " at " + ZTime$
  757. '
  758. ' ****  UPDATE CALLERS FILE WITH USER ACTIVITY  ****
  759. '
  760. 13670 LSET ZCallersRecord$ = WasX$
  761.       CALL Printit (ZCallersRecord$)                                 ' KG052702
  762.       ZCallersFileIndex! = ZCallersFileIndex! + 1
  763. 13672 PUT 4,ZCallersFileIndex!
  764.       END SUB
  765. 13673 ' $SUBTITLE: 'Printit - subroutine to print on the local printer'
  766. ' $PAGE
  767. '
  768. '  NAME    -- Printit
  769. '
  770. '  INPUTS  --     PARAMETER                    MEANING
  771. '                 Strng$              STRING TO WRITE TO THE Printer
  772. '
  773. '  OUTPUTS -- NONE
  774. '
  775. '  PURPOSE -- To write to the printer attached to the pc running
  776. '             RBBS-PC and toggle the printer switch off whenever
  777. '             the printer is/becomes unavailable
  778. '
  779.       SUB Printit (Strng$) STATIC
  780.       ON ERROR GOTO 65000
  781. 13674 IF ZPrinter THEN _
  782.          LPRINT Strng$
  783.       END SUB
  784. 20101 ' $SUBTITLE: 'ChangeDir - subroutine to change subdirectories'
  785. ' $PAGE
  786. '
  787. '  NAME    -- ChangeDir
  788. '
  789. '  INPUTS  -- PARAMETER                    MEANING
  790. '             NewDir$                      NAME OF SUBDIRECTORY
  791. '
  792. '  OUTPUTS -- ZOK                           TRUE IF CHDIR SUCCESSFUL
  793. '             ZErrCode                      ERROR CODE
  794. '
  795. '  PURPOSE -- Change subdirectory
  796. '
  797.       SUB ChangeDir (NewDir$) STATIC
  798.       ON ERROR GOTO 65000
  799.       ZErrCode = 0
  800.       ZOK = ZTrue
  801. 20103 CHDIR NewDir$
  802.       END SUB
  803. 20219 ' $SUBTITLE: 'FINDITX - subroutine to find if a file exists'
  804. ' $PAGE
  805. '
  806. '  NAME    -- FINDITX
  807. '
  808. '  INPUTS  -- PARAMETER                    MEANING
  809. '             FilName$                 NAME OF FILE TO FIND
  810. '             FileNum                  # TO OPEN FILE AS
  811. '
  812. '  OUTPUTS -- ZOK                      TRUE IF FILE EXISTS
  813. '             ZErrCode                 ERROR CODE
  814. '
  815. '  PURPOSE -- Determine whether a file exists
  816. '
  817.       SUB FindItX (FilName$,FileNum) STATIC
  818.       ON ERROR GOTO 65000
  819.       ZErrCode = 0
  820.       ZOK = ZFalse
  821.       IF LEN(FilName$) < 1 THEN _
  822.          EXIT SUB
  823.       IF ZTurboRBBS THEN _
  824.          CALL FindFile (FilName$,ZOK) : _
  825.          IF ZOK THEN _
  826.             GOTO 20222 _
  827.          ELSE EXIT SUB
  828. 20221 CALL BadFileChar (FilName$,ZOK)
  829.       IF NOT ZOK THEN _
  830.          EXIT SUB
  831.       ZOK = ZFalse
  832.       NAME FilName$ AS FilName$
  833.       IF ZErrCode = 53 THEN _
  834.          ZErrCode = 0 : _
  835.          EXIT SUB
  836. 20222 CLOSE FileNum
  837. 20223 CALL OpenWork (FileNum,FilName$)
  838.       IF ZErrCode = 64 OR ZErrCode = 76 THEN _
  839.          ZOK = ZFalse : _
  840.          EXIT SUB
  841.       ZOK = ZTrue
  842.       END SUB
  843. 20308 ' $SUBTITLE: 'FlushCom -- subroutine reads all char. from  comm. port'
  844. ' $PAGE
  845. '
  846. '  NAME -- FlushCom
  847. '
  848. '  INPUTS --   PARAMETER     MEANING
  849. '              STrng$       STRING TO READ CHARACTERS INTO FROM
  850. '                           THE COMMUNICATIONS PORT (FILE #3)
  851. '
  852. '  OUTPUTS --   Strng$
  853. '
  854. '  PURPOSE -- Reads all characters from the communications port.
  855. '
  856.       SUB FlushCom (Strng$) STATIC
  857.       ON ERROR GOTO 65000
  858.       IF ZLocalUser THEN _
  859.          EXIT SUB
  860.       Strng$ = ""
  861.       IF NOT ZFossil THEN _
  862.          GOTO 20311
  863. 20310 CALL FosReadAhead(ZComPort,Char)
  864.       IF Char <> -1 THEN _
  865.          CALL FOSRXChar(ZComPort,Char) : _
  866.          Strng$ = Strng$ + CHR$(Char) : _
  867.          GOTO 20310
  868.       EXIT SUB
  869. 20311 Strng$ = INPUT$(LOC(3),3)                     ' FLUSH THE COMM BUFFER
  870. 20312 IF ZErrCode = 57 THEN _
  871.          LineStatus = INP(ZLineStatusReg) : _
  872.          ZErrCode = 0 : _
  873.          GOTO 20311
  874.       END SUB
  875. 20898 ' $SUBTITLE: 'NetBIOS - subroutine to lock/unlock using NetBIOS'
  876. ' $PAGE
  877. '
  878. '  NAME    -- NetBIOS   (WRITTEN BY DOUG AZZARITO)
  879. '
  880. '  INPUTS  -- IBMLockCmd       = 1-LOCK, 0-UNLOCK
  881. '             IBMFileLock      = 5 USERS FILE
  882. '                              = 6 SEMAPHORE FILE
  883. '             IBMRecLock       = RECORD NUMBER TO LOCK
  884. '
  885. '  OUTPUTS -- NONE
  886. '
  887. '  PURPOSE -- Lock and unlock files using NetBIOS commands.
  888. '             If lock fails, this routine tries forever.
  889. '
  890.       SUB NetBIOS (IBMLockCmd,IBMFileLock,IBMRecLock) STATIC
  891.       STATIC IBMCount
  892.       ON ERROR GOTO 65000
  893. 29900 ON IBMLockCmd + 1 GOTO 29920, 29910
  894.       EXIT SUB
  895. '
  896. ' *****  LOCK LOOP   ****
  897. '
  898. 29910 ZErrCode = 0
  899.       IF IBMFileLock = 6 AND IBMRecLock = 3 THEN _
  900.          IBMCount = IBMCount + 1 : _
  901.          IF IBMCount > 1 THEN _
  902.             EXIT SUB
  903.       LOCK IBMFileLock, IBMRecLock TO IBMRecLock
  904.       IF ZErrCode <> 0 THEN _
  905.          GOTO 29910
  906.       EXIT SUB
  907. 29920 ZErrCode = 0
  908.       IF IBMFileLock = 6 AND IBMRecLock = 3 THEN _
  909.          IBMCount = IBMCount - 1 : _
  910.          IF IBMCount > 0 THEN _
  911.             EXIT SUB _
  912.          ELSE IBMCount = 0
  913.       UNLOCK IBMFileLock, IBMRecLock TO IBMRecLock
  914.       IF ZErrCode = 70 THEN _                                        ' ML041401
  915.          EXIT SUB                                                    ' ML041401
  916.       IF ZErrCode <> 0 THEN _
  917.          GOTO 29920
  918.       END SUB
  919. 43048 ' $SUBTITLE: 'UpdateC - update of callers log on exiting'
  920. ' $PAGE
  921. '
  922. '  NAME    -- UpdateC
  923. '
  924. '  INPUTS  --     PARAMETER                    MEANING
  925. '             ZCallersFileIndex!
  926. '             ZFirstName$
  927. '             ZWasHHH
  928. '             ZLastName$
  929. '             ZWasMMM
  930. '             ZWasNG$
  931. '             ZWasSSS
  932. '             ZSysopFirstName$
  933. '             ZSysopLastName$
  934. '
  935. '  OUTPUTS -- ZCallersRecord$
  936. '             ZCallersFileIndex!
  937. '             ZSysop
  938. '
  939. '  PURPOSE -- Update the callers file at logoff so that the number
  940. '             of hours, minutes, and seconds for the session are
  941. '             recorded as the last 9 characters of the 64-character
  942. '             callers file record
  943. '
  944.       SUB UpdateC STATIC
  945.       ON ERROR GOTO 65000
  946.       IF ZCallersFilePrefix$ = "" THEN _
  947.          EXIT SUB
  948. '
  949. ' ****  UPDATE CALLERS FILE AT LOGOFF  ***
  950. '
  951. 43050 FIELD 4,55 AS ZCallersRecord$,3 AS Hours$,3 AS Minutes$,3 AS Seconds$
  952.       LSET ZCallersRecord$ = MID$(ZWasNG$,65,55)
  953.       LSET Hours$ = STR$(ZSessionHour)
  954.       LSET Minutes$ = STR$(ZSessionMin)
  955.       LSET Seconds$ = STR$(ZSessionSec)
  956.       ZCallersFileIndex! = ZCallersFileIndex! + 1
  957.       PUT 4,ZCallersFileIndex!
  958.       FIELD 4,64 AS ZCallersRecord$
  959.       LSET ZCallersRecord$ = LEFT$(ZWasNG$,64)
  960.       ZCallersFileIndex! = ZCallersFileIndex! + 1
  961.       PUT 4,ZCallersFileIndex!
  962. 43060 LSET ZCallersRecord$ = STRING$(64,CHR$(0))
  963.       ZCallersFileIndex! = ZCallersFileIndex! + 1
  964.       PUT 4,ZCallersFileIndex!
  965.       ZCallersFileIndex! = ZCallersFileIndex! + 1
  966.       PUT 4,ZCallersFileIndex!
  967.       IF ZOrigCallers$ <> ZCallersFile$ THEN _
  968.          ZCallersFile$ = ZOrigCallers$ : _
  969.          CALL SetCall : _
  970.          GOTO 43050
  971.       END SUB
  972. 51098 ' $SUBTITLE: 'FindFree - subroutine to find space on a device'
  973. ' $PAGE
  974. '
  975. '  NAME    -- FindFree
  976. '
  977. '  INPUTS  --     PARAMETER                    MEANING
  978. '                 ZWasZ$                       NAME OF FILE TO FIND
  979. '
  980. '  OUTPUTS -- ZFreeSpace$                      NUMBER OF BYTES FREE
  981. '
  982. '  PURPOSE -- To determine amount of free space on a device
  983. '
  984.       SUB FindFree STATIC
  985.       ON ERROR GOTO 65000
  986.       ZErrCode = 0
  987. 52000 IF ZTurboRBBS THEN _
  988.          GOTO 52003
  989.       ZFreeSpace$ = ""
  990.       CLS
  991.       ZErrCode = 0
  992. 52001 FILES ZWasZ$
  993.       IF ZErrCode = 53 AND (ZWasZ$ = ZCmntsFile$ OR ZWasZ$ = ZUpldDriveFile$ ) THEN _
  994.          CALL OpenOutW (ZWasZ$) : _
  995.          GOTO 52000
  996.       IF ZErrCode = 53 AND ZWasZ$ = ZUpldDir$ THEN _
  997.          ZOutTxt$ = "Upload directory missing.  Tell SYSOP" : _
  998.          ZSubParm = 6 : _
  999.          CALL TPut : _
  1000.          GOTO 52002
  1001.       FOR WasX = 1 TO 25
  1002.          ZFreeSpace$ = ZFreeSpace$ + CHR$(SCREEN (3,WasX))
  1003.       NEXT
  1004. 52002 ZSubParm = 1
  1005.       CALL Line25
  1006.       EXIT SUB
  1007. 52003 WasAX = 0
  1008.       WasBX = 0
  1009.       WasCX = 0
  1010.       WasDX = 0
  1011.       IF MID$(ZWasZ$,2,1) = ":" THEN _
  1012.          WasAX = ASC(ZWasZ$) - ASC("A") + 1
  1013.       CALL RBBSFree (WasAX,WasBX,WasCX,WasDX)
  1014.       WasI# = CDBL(WasAX) * (WasBX + 65536! * (-(WasBX < 0)))
  1015.       WasI# = WasI# * WasCX
  1016.       ZFreeSpace$ = STR$(WasI#) + _
  1017.                     " bytes free"
  1018.       END SUB
  1019. 57978 ' $SUBTITLE: 'OpenWork - subroutine to open RBBS-PC's work file (2)'
  1020. ' $PAGE
  1021. '
  1022. '  NAME   -- OpenWork
  1023. '
  1024. '  INPUTS --     PARAMETER                    MEANING
  1025. '                FileNum                    # OF FILE TO OPEN AS
  1026. '                FilName$                   NAME OF FILE TO FIND
  1027. '                ZShareIt                   USE DOS' "SHARE" FACILITIES
  1028. '
  1029. '  OUTPUTS -- ZErrCode                        ERROR CODE
  1030. '
  1031. '  PURPOSE -- To open RBBS-PC's "work" file (number 2)
  1032. '
  1033.       SUB OpenWork (FileNum,FilName$) STATIC
  1034.       ON ERROR GOTO 65000
  1035. 58000 CLOSE FileNum
  1036. 58010 ZErrCode = 0
  1037. 58020 IF ZShareIt THEN _
  1038.          OPEN FilName$ FOR INPUT SHARED AS #FileNum _
  1039.       ELSE OPEN "I",FileNum,FilName$
  1040.       IF ZErrCode = 52 THEN _
  1041.          GOTO 58010
  1042. 58030 END SUB
  1043. 58190 ' $SUBTITLE: 'OpenFMS - subroutine to open the FMS directory'
  1044. ' $PAGE
  1045. '
  1046. '  NAME    -- OpenFMS
  1047. '
  1048. '  INPUTS  -- PARAMETER                      MEANING
  1049. '             ZShareIt                DOS SHARING FLAG
  1050. '             ZFMSDirectory$          NAME OF FMS DIRECTORY
  1051. '
  1052. '  OUTPUTS -- LastRec                NUMBER OF THE Last
  1053. '                                    RECORD IN THE FILE
  1054. '
  1055. '  PURPOSE -- To open the upload directory as a random file and find
  1056. '             the number of the last record in the file.
  1057. '
  1058.       SUB OpenFMS (LastRec) STATIC
  1059.       ON ERROR GOTO 65000
  1060.       FileLength = 38 + ZMaxDescLen
  1061.       CLOSE 2
  1062.       IF ZActiveFMSDir$ = "" THEN _
  1063.          IF ZMenuIndex = 6 THEN _
  1064.             ZActiveFMSDir$ = ZLibDir$ _
  1065.          ELSE ZActiveFMSDir$ = ZFMSDirectory$
  1066.       IF ZShareIt THEN _
  1067.          OPEN ZActiveFMSDir$ FOR RANDOM SHARED AS #2 LEN=FileLength _
  1068.       ELSE OPEN "R",2,ZActiveFMSDir$,FileLength
  1069.       IF ZErrCode > 0 THEN _
  1070.          CALL QuickTPut1 ("Drive/path does not exist or bad name for FMS dir " + _
  1071.                      ZActiveFMSDir$) : _
  1072.          END
  1073.       LastRec = LOF(2)/FileLength
  1074.       IF ZActiveFMSDir$ = PrevFMS$ THEN _
  1075.          EXIT SUB
  1076.       PrevFMS$ = ZActiveFMSDir$
  1077.       FIELD 2, FileLength AS FMSRec$
  1078.       GET #2,1
  1079.       ZWasA = (LEFT$(FMSRec$,4) <> "\FMS")
  1080.       ZUpInc = 2*(INSTR(FMSRec$," TOP ") = 0 OR ZWasA) + 1
  1081.       ZDateOrderedFMS = ZWasA OR (INSTR(FMSRec$," NOSORT") = 0)
  1082.       ZWasDF = INSTR(FMSRec$,"CH(")
  1083.       ZChainedDir$ = ""
  1084.       IF ZWasDF > 0 AND (NOT ZWasA) THEN _
  1085.          WasX = INSTR(ZWasDF,FMSRec$,")") : _
  1086.          IF WasX > 0 THEN _
  1087.             ZChainedDir$ = MID$(FMSRec$,ZWasDF+3,WasX-ZWasDF-3) : _
  1088.             CALL FindFile (ZChainedDir$,ZOK) : _
  1089.             IF NOT ZOK THEN _
  1090.                ZChainedDir$ = ""
  1091.       END SUB
  1092. 58220 ' $SUBTITLE: 'OpenOutW - sub to open output work file (2)'
  1093. ' $PAGE
  1094. '
  1095. '  NAME    -- OpenOutW
  1096. '
  1097. '  INPUTS  --     PARAMETER                 MEANING
  1098. '                 ZFileName$            NAME OF FILE TO FIND
  1099. '                 ZShareIt              USE DOS' "SHARE" FACILITIES
  1100. '
  1101. '  OUTPUTS -- ZErrCode                        ERROR CODE
  1102. '
  1103. '  PURPOSE -- To open RBBS-PC's "work" file (number 2) for output
  1104. '
  1105.       SUB OpenOutW (FilName$) STATIC
  1106.       ON ERROR GOTO 65000
  1107.       CLOSE 2
  1108. 58225 ZErrCode = 0
  1109. 58230 IF ZShareIt THEN _
  1110.          OPEN FilName$ FOR OUTPUT SHARED AS #2 _
  1111.       ELSE OPEN "O",2,FilName$
  1112. 58235 END SUB
  1113. 58260 ' $SUBTITLE: 'KillWork - subroutine to delete a "work" file'
  1114. ' $PAGE
  1115. '
  1116. '  NAME    -- KillWork
  1117. '
  1118. '  INPUTS  --     PARAMETER                    MEANING
  1119. '                 FilName$                  NAME OF FILE TO DELETE
  1120. '
  1121. '  OUTPUTS -- ZErrCode                        ERROR CODE
  1122. '
  1123. '  SUBROUTINE PURPOSE -- To delete a RBBS-PC "work" file
  1124. '
  1125.       SUB KillWork (FilName$) STATIC
  1126.       ON ERROR GOTO 65000
  1127.       CLOSE 2
  1128.       ZErrCode = 0
  1129. 58270 KILL FilName$
  1130. 58275 END SUB
  1131. 58280 ' $SUBTITLE: 'GetPassword - sub to read the "passwords" file'
  1132. ' $PAGE
  1133. '
  1134. '  NAME    -- GetPassword
  1135. '
  1136. '                          PARAMETER             MEANING
  1137. '  INPUTS  -- FILE # 2 OPENED
  1138. '
  1139. '  OUTPUTS -- ZTempPassword$
  1140. '             ZTempSecLevel
  1141. '             ZTempTimeAllowed
  1142. '             ZTempRegPeriod
  1143. '             ZTempMaxPerDay
  1144. '
  1145. '  PURPOSE -- To read the RBBS-PC "PASSWORDS" file
  1146. '
  1147.       SUB GetPassword STATIC
  1148.       ON ERROR GOTO 65000
  1149.       ZErrCode = 0
  1150.       INPUT #2,ZTempPassword$,     ZTempSecLevel, _
  1151.                ZTempTimeAllowed,  ZTempMaxPerDay, _
  1152.                ZTempRegPeriod,    ZStartTime, _
  1153.                ZEndTime,           ZByteMethod, _
  1154.                ZRatioRestrict#, ZInitialCredit#, _
  1155.                ZTempTimeLock
  1156. 58285 END SUB
  1157. 58290 ' $SUBTITLE: 'ReadDir - subroutine to read the "DIR" files'
  1158. ' $PAGE
  1159. '
  1160. '  NAME    -- ReadDir
  1161. '
  1162. '             PARAMETER                MEANING
  1163. '  INPUTS  -- FileNum                  WHICH # FILE TO READ
  1164. '             WhichLine                HOW MANY LINES TO ADVANCE
  1165. '
  1166. '  OUTPUTS -- ZOutTxt$
  1167. '
  1168. '  PURPOSE -- To read possible "DIR" files
  1169. '
  1170.       SUB ReadDir (FileNum,WhichLine) STATIC
  1171.       ON ERROR GOTO 65000
  1172.       ZErrCode = 0
  1173.       FOR WasI = 1 TO WhichLine
  1174.          LINE INPUT #FileNum,ZOutTxt$
  1175.       NEXT
  1176. 58295 END SUB
  1177. 58300 ' $SUBTITLE: 'ReadParms - subroutine to read parameter values'
  1178. ' $PAGE
  1179. '
  1180. '  NAME    -- ReadParms
  1181. '
  1182. '               PARAMETER             MEANING
  1183. '  INPUTS  -- FILE # 2 OPENED
  1184. '             NumParms               # parameters to read
  1185. '             WhichLine              Which set of parms to return
  1186. '  OUTPUTS -- ARA.TO.USER$           Array of string values
  1187. '             FILE.SECURITY
  1188. '             FilePswd$
  1189. '
  1190. '  PURPOSE -- To read different values, where values are
  1191. '             separated by a comma or carriage-return-line-feed.
  1192. '
  1193.       SUB ReadParms (AraToUse$(1),NumParms,WhichLine) STATIC
  1194.       ON ERROR GOTO 65000
  1195.       ZErrCode = 0
  1196.       FOR WasJ = 1 TO WhichLine
  1197.          FOR WasI = 1 TO NumParms
  1198.             INPUT #2,AraToUse$(WasI)
  1199.          NEXT
  1200.       NEXT
  1201. 58305 END SUB
  1202. 58310 ' $SUBTITLE: 'ReadAny - subroutine to read file 2 into ZOutTxt$'
  1203. ' $PAGE
  1204. '
  1205. '  NAME    -- ReadAny
  1206. '
  1207. '               PARAMETER             MEANING
  1208. '  INPUTS  -- FILE # 2 OPENED
  1209. '
  1210. '  OUTPUTS -- ZOutTxt$
  1211. '
  1212. '  PURPOSE -- To read file #2 into ZOutTxt$
  1213. '
  1214.       SUB ReadAny STATIC
  1215.       ON ERROR GOTO 65000
  1216.       ZErrCode = 0
  1217.       INPUT #2,ZOutTxt$
  1218. 58315 END SUB
  1219. 58320 ' $SUBTITLE: 'PrintWork - subroutine to print to file 2'
  1220. ' $PAGE
  1221. '
  1222. '  NAME    -- PrintWork
  1223. '
  1224. '               PARAMETER             MEANING
  1225. '  INPUTS  -- FILE # 2 OPENED
  1226. '             STRING TO WRITE OUT
  1227. '
  1228. '  OUTPUTS -- NONE
  1229. '
  1230. '  PURPOSE -- To print a string to file #2
  1231. '
  1232.       SUB PrintWork (Strng$) STATIC
  1233.       ON ERROR GOTO 65000
  1234.       ZErrCode = 0
  1235.       PRINT #2,Strng$;
  1236. 58325 END SUB
  1237. 58330 ' $SUBTITLE: 'GetWork - subroutine to read file 2'
  1238. ' $PAGE
  1239. '
  1240. '  NAME    -- GetWork
  1241. '
  1242. '               PARAMETER             MEANING
  1243. '  INPUTS  -- RecLen            Length of record
  1244. '
  1245. '  OUTPUTS -- NONE
  1246. '
  1247. '  PURPOSE -- To read a record from file #2
  1248. '
  1249.       SUB GetWork (RecLen) STATIC
  1250.       ON ERROR GOTO 65000
  1251.       ZErrCode = 0
  1252.       FIELD 2, RecLen AS ZDnldRecord$
  1253.       GET 2,(LOC(2)+1)
  1254. 58335 END SUB
  1255. 58340 ' $SUBTITLE: 'OpenWorkA - subroutine to open output work file (2)'
  1256. ' $PAGE
  1257. '
  1258. '  NAME    -- OpenWorkA
  1259. '
  1260. '  INPUTS  --     PARAMETER                    MEANING
  1261. '              FilName$                  NAME OF FILE TO FIND
  1262. '              ZShareIt                  USE DOS' "SHARE" FACILITIES
  1263. '
  1264. '  OUTPUTS -- ZErrCode                        ERROR CODE
  1265. '
  1266. '  PURPOSE -- To open RBBS-PC's "work" file (number 2) for appended output
  1267. '
  1268.       SUB OpenWorkA (FilName$) STATIC
  1269.       ON ERROR GOTO 65000
  1270.       CLOSE 2
  1271.       ZErrCode = 0
  1272.       IF ZShareIt THEN _
  1273.          OPEN FilName$ FOR APPEND SHARED AS #2 _
  1274.       ELSE OPEN "A",2,FilName$
  1275. 58345 END SUB
  1276. 58350 ' $SUBTITLE: 'PrintWorkA - subroutine to print to file 2 with CR'
  1277. ' $PAGE
  1278. '
  1279. '  NAME    -- PrintWorkA
  1280. '
  1281. '                          PARAMETER             MEANING
  1282. '  INPUTS  --            FILE # 2 OPENED
  1283. '                        STRING TO WRITE OUT
  1284. '
  1285. '  OUTPUTS -- NONE
  1286. '
  1287. '  PURPOSE -- To print a string to file #2 followed by a carriage return
  1288. '
  1289.       SUB PrintWorkA (Strng$) STATIC
  1290.       ON ERROR GOTO 65000
  1291.       ZErrCode = 0
  1292.       PRINT #2,Strng$
  1293. 58355 END SUB
  1294. 58360 ' $SUBTITLE: 'CheckInt - subroutine to check input is an integer'
  1295. ' $PAGE
  1296. '
  1297. '  NAME    -- CheckInt
  1298. '
  1299. '             PARAMETER             MEANING
  1300. '  INPUTS  -- Strng$         STRING TO VERIFY CAN BE AN INTEGER
  1301. '
  1302. '  OUTPUTS -- ZErrCode             = 0 MEANS IT IS AN INTEGER VALUE
  1303. '                                 <> 0 MEANS IT IS NOT AN INTEGER VALUE
  1304. '             ZTestedIntValue  Integer value of expression
  1305. '
  1306. '  PURPOSE -- To validate that a string represents an integer
  1307. '
  1308.       SUB CheckInt (Strng$) STATIC
  1309.       ON ERROR GOTO 65000
  1310.       ZErrCode = 0
  1311.       WasX$ = Strng$
  1312.       CALL Trim (WasX$)
  1313.       ZTestedIntValue = VAL(LEFT$(WasX$,INSTR(WasX$+" "," ")-1))
  1314. 58365 END SUB
  1315. 59650 ' $SUBTITLE: 'PutCom -- subroutine to write to communications port'
  1316. ' $PAGE
  1317. '
  1318. '  NAME    --  PutCom
  1319. '
  1320. '  INPUTS  --   PARAMETER     MEANING
  1321. '                STNG$       STRING TO PRINT TO COMM PORT
  1322. '              ZFlowControl  WHETHER USING CLEAR TO SEND FOR FLOW
  1323. '                            CONTROL BETWEEN THE PC AND THE MODEM
  1324. '
  1325. '  OUTPUTS --
  1326. '
  1327. '  PURPOSE -- Checks for carrier drop and flow control (xon/xoff)
  1328. '             before writing to the communications port.
  1329. '
  1330.       SUB PutCom (Strng$) STATIC
  1331.       ON ERROR GOTO 65000
  1332.       IF ZLocalUser THEN _
  1333.          EXIT SUB
  1334.       CALL CheckCarrier
  1335.       IF ZSubParm = -1 THEN _
  1336.          EXIT SUB
  1337.       IF NOT ZXOffEd THEN _
  1338.          GOTO 59652
  1339.       ZSubParm = 1
  1340.       CALL Line25
  1341.       ZWasY$ = ZXOff$
  1342.       XOffTimeout! = TIMER + ZWaitBeforeDisconnect
  1343.       WHILE ZWasY$ = ZXOff$ AND ZSubParm <> -1
  1344.          Char = -1
  1345.          WHILE Char = -1 AND ZSubParm <> -1
  1346.             GOSUB 59654
  1347.          WEND
  1348.          IF Char <> -1 THEN _
  1349.             CALL GetCom(ZWasY$) : _
  1350.             IF ZXOnXOff AND ZWasY$ <> ZXOn$ THEN _
  1351.                ZWasY$ = ZXOff$
  1352.       WEND
  1353.       ZXOffEd = ZFalse
  1354.       ZSubParm = 1
  1355.       CALL Line25
  1356. 59652 ZNotCTS = ZFalse
  1357.       IF NOT ZFossil THEN _
  1358.          PRINT #3,Strng$; : _
  1359.          EXIT SUB
  1360.       IF Strng$ = "" THEN _
  1361.          EXIT SUB
  1362.       FOR WasN = 1 TO LEN(Strng$)
  1363.           Char = ASC(MID$(Strng$,WasN,1))
  1364. 59653     CALL FosTXCharNW(ZComPort,Char,Result)                     ' MD090501
  1365.           IF Result = 0 THEN _
  1366.              CALL GoIdle : _                                         ' MD090501
  1367.              GOTO 59653
  1368.       NEXT
  1369.       EXIT SUB
  1370. 59654 CALL EofComm (Char)
  1371.       CALL GoIdle
  1372.       CALL CheckCarrier
  1373.       CALL CheckTime(XOffTimeout!, TempElapsed!,1)
  1374.       IF ZSubParm = 2 THEN _
  1375.          ZSubParm = -1
  1376.       RETURN
  1377.       END SUB
  1378. 59660 ' $SUBTITLE: 'PutWork -- subroutine to write to upload files'
  1379. ' $PAGE
  1380. '
  1381. '  NAME    -- PutWork
  1382. '
  1383. '  INPUTS  --   PARAMETER     MEANING
  1384. '                STNG$       STRING TO WRITE TO FILE
  1385. '                RecNum      RECORD NUMBER TO WRITE
  1386. '                RecLen      LENGTH OF RECORD TO WRITE
  1387. '
  1388. '  OUTPUTS --
  1389. '
  1390. '  PURPOSE -- Writes uploaded file records to work file
  1391. '
  1392.       SUB PutWork (Strng$,RecNum,RecLen) STATIC
  1393.       ON ERROR GOTO 65000
  1394.       FIELD #2,RecLen AS ZUpldRec$
  1395.       LSET ZUpldRec$ = Strng$
  1396.       RecNum = RecNum + 1
  1397.       PUT #2,RecNum
  1398.       END SUB
  1399. 59680 ' $SUBTITLE: 'RBBSPlay -- subroutine to play music'
  1400. ' $PAGE
  1401. '
  1402. '  NAME    -- RBBSPlay
  1403. '
  1404. '  INPUTS  --   PARAMETER     MEANING
  1405. '               Strng$      STRING TO PLAY
  1406. '
  1407. '  OUTPUTS --
  1408. '
  1409. '  PURPOSE -- Play music.  Skip if get an error.
  1410. '
  1411.       SUB RBBSPlay (StringToPlay$) STATIC
  1412.       PLAY StringToPlay$
  1413.       ZErrCode = 0
  1414.       END SUB
  1415. 59700 ' $SUBTITLE: 'Talk -- subroutine for voice response'
  1416. ' $PAGE
  1417. '
  1418. '  NAME    -- Talk
  1419. '
  1420. '  INPUTS  --   PARAMETER     MEANING
  1421. '               ZVoiceType    TYPE OF VOICE SYNTHESIZER
  1422. '               VoiceRecord   RECORD NUMBER TO RETRIEVE
  1423. '
  1424. '  OUTPUTS --
  1425. '
  1426. '  PURPOSE -- Retrieve voice record and send to voice synthesizer
  1427. '
  1428.       SUB Talk (VoiceRecord,StringWork$) STATIC
  1429.       IF ZVoiceType = 0 THEN _
  1430.          EXIT SUB
  1431.       IF VoiceRecord > 0 THEN _
  1432.          GOTO 59720
  1433.       CLOSE 7,8
  1434.       IF ZVoiceType = 1 THEN _
  1435.          OPEN "COM2:2400,E,7,1,CS65535" AS #7 : _
  1436.          LPRINT "OPENED COM PORT"
  1437.       IF ZShareIt THEN _
  1438.          OPEN "RBBSTALK.DEF" FOR RANDOM SHARED AS #8 LEN=32 _
  1439.       ELSE OPEN "R",8,"RBBSTALK.DEF",32
  1440.       FIELD 8,30 AS TalkRecord$,2 AS Dummy$
  1441.       EXIT SUB
  1442. 59720 IF NOT ZSnoop THEN _
  1443.          EXIT SUB
  1444.       IF VoiceRecord < 65 THEN _
  1445.          GET 8,VoiceRecord : _
  1446.          StringWork$ = TalkRecord$ : _
  1447.          CALL Trim (StringWork$)
  1448. 59721 IF ZSmartTextCode THEN _
  1449.          CALL SmartText (StringWork$, CRFound,ZFalse)
  1450. 59722 IF ZVoiceType = 1 THEN _
  1451.          PRINT #7,StringWork$
  1452. 59723 IF ZVoiceType = 2 THEN _
  1453.          CALL RBBSHS (CHR$(LEN(StringWork$)+1)+StringWork$+CHR$(13))
  1454.       END SUB
  1455. 59725 ' $SUBTITLE: 'CommPut -- Writes to communications port'
  1456. ' $PAGE
  1457. '
  1458. '  NAME    -- CommPut
  1459. '
  1460. '  INPUTS  --   PARAMETER     MEANING
  1461. '               Strng$        String to write
  1462. '               ZFossil       Whether using Fossil driver
  1463. '
  1464. '  OUTPUTS --
  1465. '
  1466. '  PURPOSE -- Send string to comm port.  Recovers from errors.
  1467. '
  1468.       SUB CommPut (Strng$) STATIC
  1469.       ON ERROR GOTO 65000
  1470.       IF ZFossil THEN _
  1471.          Bytes = LEN(Strng$) : _
  1472.          CALL FosWrite(ZComPort,Bytes,Strng$) _
  1473.       ELSE PRINT #3,Strng$;
  1474.       END SUB
  1475. 59790 ' $SUBTITLE: 'FindFile -- subroutine to find a file'
  1476. ' $PAGE
  1477. '
  1478. '  NAME    --  FindFile
  1479. '
  1480. '  INPUTS  --  PARAMETER         MENANING
  1481. '               FilName$         NAME OF FILE TO LOOK FOR
  1482. '               FExists          WHETHER FILE EXISTS
  1483. '
  1484. '  OUTPUTS --  RETURNED.VALUE    VALUE RETURNED
  1485. '                                TRUE  = FILE EXISTS
  1486. '                                TRUE = FILE DOES NOT EXIST
  1487. '
  1488. '  PURPOSE --  Determine whether passed file FilName$ exists
  1489. '              Unlike, FindIt, this routine does not open any
  1490. '              file and, hence, does not create one in determining
  1491. '              whether a file exists.
  1492. '
  1493.       SUB FindFile (FilName$,FExists) STATIC
  1494.       CALL BadFileChar (FilName$,FExists)
  1495. 59791 IF FExists THEN _
  1496.          IOErrorCount = 0 : _
  1497.          CALL RBBSFind (FilName$,WasZ,WasY,WasM,WasD) : _
  1498.          FExists = (WasZ = 0)
  1499.       END SUB
  1500. '  $SUBTITLE: 'Error Handling for separately compiled subroutines'
  1501. '  $PAGE
  1502. '
  1503. '
  1504. ' Error handling for the separately compiled subroutines of RBBS-PC
  1505. '
  1506. '
  1507. 65000 IF ZDebug THEN _
  1508.          ZOutTxt$ = "RBBSSUB1 DEBUG Error Trap Entry ERL=" + _
  1509.               STR$(ERL) + _
  1510.               " ERR=" + _
  1511.               STR$(ERR) : _
  1512.          IF ZPrinter THEN _
  1513.             CALL Printit(ZOutTxt$) _
  1514.          ELSE CALL LPrnt(ZOutTxt$,1)
  1515.       ZErrCode = ERR
  1516. '
  1517. '     SetCall
  1518. '
  1519.       IF ERL = 108 THEN _
  1520.          CALL PScrn ("Unable to create callers log " + ZCallersFile$) : _ ' KG081602
  1521.          SYSTEM                                                      ' KG081602
  1522.       IF ERL = 110 THEN _
  1523.           RESUME NEXT
  1524. '
  1525. '     OPEN CONFIG FILE
  1526. '
  1527.        IF ERL => 117 AND ERL <= 119 THEN _
  1528.           RESUME NEXT
  1529. '
  1530. '     OPEN COM PORT ERROR HANDLING
  1531. '
  1532.       IF ERL = 200 THEN _
  1533.          CLS : _
  1534.          CALL PScrn (ZComPort$ + " does not exist/not responding- Error" + STR$(ERR)) : _
  1535.          STOP
  1536. '
  1537. '     GetCom ERROR HANDLING
  1538. '
  1539.        IF ERL = 1420 AND ERR = 57 THEN _
  1540.           RESUME NEXT
  1541.        IF ERL = 1420 AND ERR = 69 THEN _
  1542.           ZSubParm = -1 :_
  1543.           RESUME NEXT
  1544. '
  1545. '      OPENRESEQ ERROR HANDLING
  1546. '
  1547.        IF ERL = 1481 THEN _
  1548.            ZErrCode = ERR : _
  1549.            RESUME NEXT
  1550. '
  1551. '      OpenUser ERROR HANDLING
  1552. '
  1553.        IF ERL = 9400 AND ERR = 75 AND ZShareIt THEN _
  1554.           CALL DelayTime (30) : _
  1555.           RESUME
  1556. '
  1557. '      FindUser ERROR HANDLING
  1558. '
  1559.        IF ERL = 12610 OR ERL = 12600 THEN _                          ' KG061001
  1560.           RESUME NEXT
  1561. '
  1562. '     UpdtCalr ERROR HANDLING
  1563. '
  1564.        IF ERL = 13663 THEN _
  1565.           RESUME NEXT
  1566.        IF ERL = 13672 AND ERR = 61 THEN _
  1567.           CALL QuickTPut1 ("Disk Full") : _
  1568.           IF ZDiskFullGoOffline THEN _
  1569.              GOTO 65010 _
  1570.           ELSE RESUME NEXT
  1571.        IF ERL = 13672 THEN _
  1572.           ZCallersFileIndex! = ZCallersFileIndex! - 1 : _
  1573.           RESUME NEXT
  1574. '
  1575. '     ZPrinter ERROR HANDLING
  1576. '
  1577.        IF ERL = 13674 THEN _
  1578.           ZPrinter = ZFalse : _
  1579.           RESUME
  1580. '
  1581. '      ChangeDir ERROR HANDLING
  1582. '
  1583.        IF ERL = 20103 THEN _
  1584.           ZOK = ZFalse : _
  1585.           RESUME NEXT
  1586. '
  1587. '     FindIt ERROR HANDLING
  1588. '
  1589.        IF ERL = 20221 THEN _
  1590.           RESUME NEXT
  1591.        IF ERL = 20223 AND ZErrCode = 58 THEN _
  1592.           ZErrCode = 64 : _
  1593.           ZOK = ZFalse : _
  1594.           RESUME NEXT
  1595.        IF ERL = 20223 AND ZErrCode = 76 THEN _
  1596.           CALL LPrnt("Bad path.  File name is " + FilName$,1) : _
  1597.           ZErrCode = 76 : _
  1598.           ZOK = ZFalse : _
  1599.           RESUME NEXT
  1600.        IF ERL => 20221 AND ERL <= 20223 AND ZErrCode = 70 _
  1601.           AND ZNetworkType = 6 THEN _
  1602.              ZErrCode = 0 : _
  1603.              RESUME NEXT
  1604.        IF ERL => 20221 AND ERL <= 20223 THEN _
  1605.           RESUME
  1606. '
  1607. '     FlushCom ERROR HANDLING
  1608. '
  1609.        IF ERL = 20311 AND ERR = 57 THEN _
  1610.           RESUME NEXT
  1611.        IF ERL = 20311 AND ERR = 69 THEN _
  1612.           ZAbort = ZTrue : _
  1613.           ZSubParm = -1 : _
  1614.           RESUME NEXT
  1615. '
  1616. '     NetBIOS ERROR HANDLING
  1617. '
  1618.        IF ERL => 29900 AND ERL <= 29920 THEN _
  1619.           RESUME NEXT
  1620. '
  1621. '     UpdateC ERROR HANDLING
  1622. '
  1623.       IF ERL => 43050 AND ERL <= 43060 AND ERR = 61 THEN _
  1624.          ZOutTxt$ = "* Disk full - terminating *" : _
  1625.          ZSubParm =2 : _
  1626.          CALL TPut : _
  1627.          IF ZDiskFullGoOffline THEN _
  1628.            GOTO 65010 _
  1629.          ELSE SYSTEM
  1630. '
  1631. '     CheckInt ERROR HANDLING
  1632. '
  1633.        IF (ERL = 59652 OR ERL = 59727) AND ERR = 24 THEN _
  1634.           ZNotCTS = ZTrue : _
  1635.           CALL Line25 : _
  1636.           ZErrCode = 0 : _
  1637.           RESUME
  1638.        IF ERL => 52000 AND ERL <= 59725 THEN _
  1639.           RESUME NEXT
  1640. '
  1641. '     FindFile ERROR HANDLING
  1642. '
  1643.        IF ERL = 59791 THEN _
  1644.           IF ERR = 57 THEN _
  1645.              CALL DelayTime (1) : _
  1646.              CALL UpdtCalr ("SLOW I/O ERROR",1) : _
  1647.              IOErrorCount = IOErrorCount + 1 : _
  1648.              IF IOErrorCount < 11 THEN _
  1649.                 RESUME
  1650. '
  1651. '     CATCH ALL OTHER ERRORS
  1652. '
  1653.        ZOutTxt$ = "RBBS-SUB1 Untrapped Error" + _
  1654.             STR$(ERR) + _
  1655.             " in line" + _
  1656.             STR$(ERL)
  1657.        CALL QuickTPut1 (ZOutTxt$)
  1658.        CALL UpdtCalr (ZOutTxt$,2)
  1659.        RESUME NEXT
  1660. '     SHARED ROUTINE FOR GOING OFF LINE WHEN DISK FULL
  1661. 65010  CALL OpenCom(ZModemInitBaud$,",N,8,1")
  1662.        CALL TakeOffHook
  1663.        IF ZFossil THEN _
  1664.           CALL FOSExit(ZComPort)
  1665.        SYSTEM
  1666.