home *** CD-ROM | disk | FTP | other *** search
/ Shareware 1 2 the Maxx / sw_1.zip / sw_1 / BBS / RB174BAS.ZIP / RBBSSUB1.BAS < prev    next >
BASIC Source File  |  1992-06-20  |  56KB  |  1,713 lines
  1. ' $linesize:132
  2. ' $title: 'RBBS-SUB1.BAS 17.4, Copyright 1986-92 by D. Thomas Mack'
  3. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB1.BAS
  5. '  First Released .....: June 21, 1992
  6. '  Subsequent Releases.: 
  7. '  Copyright ..........: 1986-1992
  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. '  ReadParmsX  58300   Read certain number of parameters from specified file
  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 _
  68.        EXIT SUB
  69.     ZPrevCaller$ = ZCallersFile$
  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.              ZTestANSITime, _
  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.               ZCallersLst$, _
  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 SYSOP COMMANDS 1
  204.              ZOptSec(51), _
  205.              ZOptSec(52), _
  206.              ZOptSec(53), _
  207.              ZOptSec(54), _
  208.              ZOptSec(55), _
  209.              ZOptSec(56), _   ' SYSOP 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.              ZCopyrightSecs, _
  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.               ZMinSecPersUpld, _
  333.               ZDistriHelp$, _
  334.               ZDistriPath$, _
  335.               ZFastFileList$, _
  336.               ZFastFileLocator$, _
  337.               ZMsgsCanGrow, _
  338.               ZWrapCallersFile$, _
  339.               ZRedirectIOMethod, _
  340.               ZAutoUpgradeSec, _
  341.               ZHaltOnError, _
  342.               ZNewPublicMsgsSec, _
  343.               ZNewPrivateMsgsSec, _
  344.               SecNeededToChangeMsgs, _
  345.               ZSLCategorizeUplds, _
  346.               ZNoQuoting, _
  347.               ZHourMinToDropToDos, _
  348.               ZExpiredSec, _
  349.               ZDTRDropDelay, _
  350.               ZAskID, _
  351.               ZMaxRegSec, _
  352.               ZBufferSize, _
  353.               ZMLCom, _
  354.               ZNoDoorProtect, _
  355.               ZDefaultExtension$, _
  356.               ZEnableCC, _
  357.               ZMaxBank, _
  358.               ZNetMail$, _
  359.               ZMasterDirName$, _
  360.               ZWasDF$, _
  361.               ZUpcatHelp$, _
  362.               ZAllwaysStrewTo$, _
  363.               ZLastNamePrompt$
  364.     IF ZWasDF$ <> "" THEN _
  365.        ZProtoDef$ = ZWasDF$
  366. 119 INPUT #2, ZPersonalDrvPath$, _
  367.               ZPersonalDir$, _
  368.               ZPersonalBegin, _
  369.               ZPersonalLen, _
  370.               ZPersonalProtocol$, _
  371.               ZPersonalConcat , _
  372.               ZPrivateReadSec, _
  373.               ZPublicReadSec, _
  374.               ZSecChangeMsg
  375.     IF ZConfMode THEN _
  376.          INPUT #2, ZwasDF _
  377.     ELSE INPUT #2, ZKeepInitBaud
  378.     INPUT #2, ZMainPUI$
  379.     IF ZConfMode THEN _
  380.        INPUT #2, ZWasDF$,ZWasDF$,ZWasDF$ _
  381.     ELSE INPUT #2, ZDefaultEchoer$, _
  382.                    ZHostEchoOn$, _
  383.                    ZHostEchoOff$
  384.     INPUT #2, ZSwitchBack, _
  385.               ZDefaultLineACK$, _
  386.               ZAltdirExtension$, _
  387.               ZDirPrefix$
  388.     IF ZConfMode THEN _
  389.        INPUT #2, ZWasDF, _
  390.                  ZWasDF, _
  391.                  ZWasDF _
  392.     ELSE INPUT #2, ZWasDF,_
  393.                    ZModemInitWaitTime, _
  394.                    ZModemCmdDelayTime
  395.     INPUT #2, ZTurboRBBS, _
  396.               ZSubDirCount, _
  397.               ZWasDF, _
  398.               ZUpldToSubdir, _
  399.               ZWasDF, _
  400.               ZUpldSubdir$, _
  401.               ZMinOldCallerBaud, _
  402.               ZMaxWorkVar, _
  403.               ZDiskFullGoOffline, _
  404.               ZExtendedLogging
  405.      IF ZConfMode THEN _
  406.         INPUT #2, ZWasDF$, _
  407.                   ZWasDF$, _
  408.                   ZWasDF$, _
  409.                   ZWasDF$ _
  410.      ELSE INPUT #2, ZModemResetCmd$, _
  411.                     ZModemCountRingsCmd$, _
  412.                     ZModemAnswerCmd$, _
  413.                     ZModemGoOffHookCmd$
  414.      INPUT #2,ZDiskForDos$, _
  415.               ZDumbModem, _
  416.               ZCmntsAsMsgs
  417.      IF ZConfMode THEN _
  418.         INPUT #2, ZWasDF, _
  419.                   ZWasDF, _
  420.                   ZWasDF, _
  421.                   ZWasDF, _
  422.                   ZWasDF, _
  423.                   ZWasDF _
  424.      ELSE INPUT #2, ZLSB,_
  425.                     ZMSB,_
  426.                     ZLineCntlReg,_
  427.                     ZModemCntlReg,_
  428.                     ZLineStatusReg,_
  429.                     ZModemStatusReg
  430.      INPUT #2,ZKeepTimeCredits, _
  431.               ZXOnXOff, _
  432.               ZAllowCallerTurbo, _
  433.               ZUseDeviceDriver$, _
  434.               ZPreLog$, _
  435.               ZNewUserQuestionnaire$, _
  436.               ZEpilog$, _
  437.               ZRegProgram$, _
  438.               ZQuesPath$, _
  439.               ZUserLocation$, _
  440.               ZWasDF$, _
  441.               ZWasDF$, _
  442.               ZWasDF$, _
  443.               ZEnforceRatios, _
  444.               ZSizeOfStack, _
  445.               ZSecExemptFromEpilog, _
  446.               ZUseBASICWrites, _
  447.               ZDosANSI, _
  448.               ZEscapeInsecure, _
  449.               ZUseDirOrder, _
  450.               ZAddDirSecurity, _
  451.               ZMaxExtendedLines, _
  452.               ZOrigCommands$
  453.      INPUT #2,ZLogonMailLevel$, _
  454.               ZMacroDrvPath$, _
  455.               ZMacroExtension$, _
  456.               ZEmphasizeOnDef$, _
  457.               ZEmphasizeOffDef$, _
  458.               ZFG1Def$, _
  459.               ZFG2Def$, _
  460.               ZFG3Def$, _
  461.               ZFG4Def$, _
  462.               ZSecVioHelp$
  463.      IF ZConfMode THEN _
  464.         INPUT #2,ZWasDF _
  465.      ELSE INPUT #2,ZFossil
  466.      INPUT #2,ZMaxCarrierWait, _
  467.               ZWasDF, _
  468.               ZSmartTextCode, _
  469.               ZTimeLock, _
  470.               ZWriteBufDef, _
  471.               ZSecKillAny, _
  472.               ZDoorsDef$, _
  473.               ZScreenOutMsg$, _
  474.               ZAutoPageDef$
  475.      IF ZErrCode > 0 THEN _
  476.         EXIT SUB
  477.      ZConfigFileName$ = ConfigFile$
  478.      CALL EditDef
  479.      END SUB
  480. 200 ' $SUBTITLE: 'OpenCom - subroutine to open the communications port'
  481. ' $PAGE
  482. '
  483. '  NAME    -- OpenCom
  484. '
  485. '  INPUTS  --     PARAMETER                    MEANING
  486. '                BaudRate$                  BAUD TO OPEN MODEM
  487. '                Parity$                    PARITY TO OPEN MODEM
  488. '
  489. '  OUTPUTS -- BaudTest!                     BAUD RATE TO SET RS232 AT
  490. '
  491. '  PURPOSE -- To open the communications port.
  492. '
  493.     SUB OpenCom (BaudRate$,Parity$) STATIC
  494.     ON ERROR GOTO 65000
  495.     IF ZFossil THEN _
  496.        IF ZRTS$ = "YES" THEN _
  497.           ZFlowControl = ZTrue : _
  498.           Flow = &H00F2 : _
  499.           CALL FosFlowCtl(ZComPort,Flow)
  500.     IF INSTR(Parity$,"N") THEN _
  501.        Parity = 2 : _                                     ' No PARITY
  502.        DataBits = 3 : _                                   ' 8 DATA BITS
  503.        StopBits = 0 _                                     ' 1 STOP BIT
  504.     ELSE Parity = 3 : _                                   ' EVEN PARITY
  505.          DataBits = 2 : _                                 ' 7 DATA BITS
  506.          StopBits = 0                                     ' 1 STOP BIT
  507.     IF NOT ZFossil THEN _
  508.        GOTO 202
  509.     IF Baudrate$ = "38400" THEN _
  510.        ComSpeed = &H9600 _
  511.     ELSE ComSpeed = VAL(BaudRate$)
  512.     CALL FosSpeed(ZComPort,ComSpeed,Parity,DataBits,StopBits)
  513.     EXIT SUB
  514. 202 CLOSE 3
  515.     IF ZRTS$ = "YES" THEN _
  516.        ZFlowControl = ZTrue : _
  517.        WasX$ = ",CS26600,CD,DS" _
  518.     ELSE WasX$ = ",RS,CD,DS"
  519.     WasX = (VAL(BaudRate$) > 19200)
  520.     IF WasX THEN _
  521.        ZWasY$ = "19200" _
  522.     ELSE ZWasY$ = BaudRate$
  523.     OPEN ZComPort$ + ":" + ZWasY$ + Parity$ + WasX$ AS #3
  524. '
  525. ' ****************************************************************************
  526. ' *  RAISE THE RTS SIGNAL IF THE MODEM USES RTS FOR MODEM FLOW CONTROL (ONCE
  527. ' *  IT IS RAISED, IT WILL STAY UP UNTIL THE REGISTER IS CLEARED OUT).
  528. ' ****************************************************************************
  529. '
  530.     END SUB
  531. 1418 ' $SUBTITLE: 'GetCom -- subroutine reads a char. from  comm. port'
  532. ' $PAGE
  533. '
  534. '  NAME    -- GetCom
  535. '
  536. '  INPUTS  --   PARAMETER     MEANING
  537. '                 Strng$       STRING TO READ A CHARACTER INTO FROM
  538. '                              THE COMMUNICATIONS PORT (FILE #3)
  539. '
  540. '  OUTPUTS --   Strng$
  541. '
  542. '  PURPOSE -- Reads a character from the communications port.
  543. '
  544.      SUB GetCom (Strng$) STATIC
  545.      ON ERROR GOTO 65000
  546. 1420 IF ZFOSSIL THEN _
  547.         CALL FOSRXChar(ZComPort,Char) : _
  548.         Strng$ = CHR$(Char) _
  549.      ELSE Strng$ = INPUT$(1,3)
  550. 1421 IF ZErrCode = 57 THEN _
  551.         LineStatus = INP(ZLineStatusReg) : _
  552.         ZErrCode = 0 : _
  553.         GOTO 1420
  554.      END SUB
  555. 1479 ' $SUBTITLE: 'OpenRSeq  - open sequential file randomly'
  556. ' $PAGE
  557. '
  558. '  NAME    -- OpenRSeq
  559. '
  560. '  INPUTS  -- PARAMETER             MEANING
  561. '             FilName$      NAME OF SEQUENTIAL FILE TO OPEN AS #2
  562. '             RecLen        Length of a record
  563. '
  564. '  OUTPUTS -- NumRecs      NUMBER OF RECORDS IN THE FILE based on RecLen
  565. '             LenLastRec   NUMBER OF BYTES IN THE LAST RECORD
  566. '                          MAY BE LESS THAN OR EQUAL TO RecLen).
  567. '
  568. '  PURPOSE -- Open a sequential file as file #2 and read it randomly
  569. '
  570.      SUB OpenRSeq (FilName$,NumRecs,LenLastRec,RecLen) STATIC
  571.      ON ERROR GOTO 65000
  572.      CALL OpenRand2 (FilName$,RecLen)
  573.      IF ZErrCode > 0 THEN _
  574.         EXIT SUB
  575.      FIELD #2, RecLen AS ZDnldRecord$
  576.      WasI# = LOF(2)
  577.      NumRecs = FIX(WasI#/RecLen)
  578.      LenLastRec = WasI# - CDBL(NumRecs) * RecLen
  579.      IF LenLastRec > 0 THEN _
  580.         NumRecs = NumRecs + 1 _
  581.      ELSE LenLastRec = RecLen
  582.      END SUB
  583. 1486 SUB OpenRand2 (FileToOpen$, FileLen) STATIC
  584.      ON ERROR GOTO 65000
  585.      CLOSE 2
  586. 1487 ZErrCode = 0
  587.      IF ZShareIt THEN _
  588.         OPEN FileToOpen$ FOR RANDOM SHARED AS #2 LEN=FileLen _
  589.      ELSE OPEN "R",2,FileToOpen$,FileLen
  590.      END SUB
  591. 9398 ' $SUBTITLE: 'OpenUser - subroutine to open users file as #5'
  592. ' $PAGE
  593. '
  594. '  NAME    -- OpenUser
  595. '
  596. '  INPUTS  --     PARAMETER                    MEANING
  597. '                 ZShareIt
  598. '
  599. '  OUTPUTS -- ZActiveUserFile$
  600. '             ZCityState$
  601. '             ZElapsedTime$
  602. '             ZLastDateTimeOn$
  603. '             LastRec                # OF Last RECORD IN USERS FILE
  604. '             ZListNewDate$
  605. '             ZPswd$
  606. '             ZSecLevel$
  607. '             ZUserDnlds$
  608. '             ZUserName$
  609. '             ZUserOption$
  610. '             ZUserRecord$
  611. '             ZUserUplds$
  612. '
  613. '  PURPOSE -- Open the user file as file #5
  614. '
  615.       SUB OpenUser (LastRec) STATIC
  616.       ON ERROR GOTO 65000
  617. '
  618. ' ****  OPEN AND DEFINE USER FILE RECORD VARIABLES  ****
  619. '
  620. 9400 CLOSE 5
  621.      IF ZShareIt THEN _
  622.         OPEN ZActiveUserFile$ FOR RANDOM SHARED AS #5 LEN=128 _
  623.      ELSE OPEN "R",5,ZActiveUserFile$,128
  624.      WasI# = LOF(5)
  625.      LastRec = FIX(WasI#/128)
  626.      FIELD 5,31 AS ZUserName$, _
  627.              15 AS ZPswd$, _
  628.               2 AS ZSecLevel$, _
  629.              14 AS ZUserOption$,  _
  630.              24 AS ZCityState$, _
  631.               2 AS MachineType$, _
  632.               1 AS ZBankTime$,_
  633.               4 AS ZTodayDl$, _
  634.               4 AS ZTodayBytes$, _
  635.               4 AS ZDlBytes$, _
  636.               4 AS ZULBytes$, _
  637.              14 AS ZLastDateTimeOn$, _
  638.               3 AS ZListNewDate$, _
  639.               2 AS ZUserDnlds$, _
  640.               2 AS ZUserUplds$, _
  641.               2 AS ZElapsedTime$
  642.      FIELD 5,128 AS ZUserRecord$
  643.      END SUB
  644. 12598 ' $SUBTITLE: 'FindUser - subroutine to search users file for a name'
  645. ' $PAGE
  646. '
  647. '  NAME    -- FindUser
  648. '
  649. '  INPUTS  --     PARAMETER                    MEANING
  650. '             HashToLookFor$        STRING TO SEARCH FOR IN USERS
  651. '             IndivToLookFor$       STRING TO USE TO INDIVIDUATE
  652. '                                   USERS WITH SAME HASH
  653. '             StartHashPos          WHERE HASH FIELD STARTS IN THE
  654. '                                  "USERS" FILE
  655. '             LenHashField          LENGTH OF THE HASH FIELD
  656. '             StartIndivPos         WHERE THE FIELD TO DISTINGUISH
  657. '                                   AMONG USERS (I.E. WITH THE SAME
  658. '                                   NAME) STARTS IN THE "USERS" FILE
  659. '                                   (SET TO 0 IF NONE TO BE USED)
  660. '             LenIndivField         LENGTH OF FIELD TO DISTINGUISH
  661. '                                   AMONG USERS
  662. '             MaxPosition           HIGHEST RECORD TO SEARCH OR USE
  663. '
  664. '  NOTE: THIS SUBROUTINE ASSUMES THE "USERS" FILE IS OPEN AS FILE 2.
  665. '
  666. '  OUTPUTS -- WhetherFound          SET TO "TRUE" IF USER WAS Found
  667. '                                   OTHERWISE IT IS "FALSE"
  668. '             PosToUse              NUMBER OF THE "USERS" RECORD THAT
  669. '                                   BELONGS TO THE USER (IF Found) OR
  670. '                                   TO USE FOR THE USER (IF THE USER
  671. '                                   WASN'T Found)
  672. '             PosToReclaim          SET TO 0 IF THE RECORD NUMBER
  673. '                                   SELECTED FOR THIS USER HAS NEVER
  674. '                                   BEEN USED.
  675. '
  676. '  PURPOSE -- To search the "USERS" file and determine the record
  677. '             number to use for the caller in the "USERS" file.
  678. '
  679.       SUB FindUser (HashToLookFor$,IndivToLookFor$,StartHashPos,_
  680.                     LenHashField,StartIndivPos,LenIndivField,_
  681.                     MaxPosition,WhetherFound,_
  682.                     PosToUse,PosToReclaim) STATIC
  683.       ON ERROR GOTO 65000
  684.       ZErrCode = 0
  685.       WhetherFound = 0
  686.       IF HashToLookFor$ = SPACE$(LEN(HashToLookFor$)) THEN _
  687.          EXIT SUB
  688.       EmptyRec$ = SPACE$(LenHashField)
  689.       EmptyIndiv$ = SPACE$(LenIndivField)
  690.       NewUser$ = LEFT$("NEWUSER  ",LenHashField + 2)
  691.       FIELD 5, 128 AS Filler$
  692.       WasX$ = HashToLookFor$ + SPACE$(LenHashField - LEN(HashToLookFor$))
  693.       CALL HashRBBS (HashToLookFor$,MaxPosition,PosToUse,ZWasDF)
  694. 12600 ZWasY$ = IndivToLookFor$ + SPACE$(LenIndivField - LEN(IndivToLookFor$))
  695.       PosToReclaim = 0
  696.       ZErrCode = 0
  697. 12610 GET 5,PosToUse
  698.       IF ZErrCode > 0 THEN _
  699.          IF ZErrCode = 63 THEN _
  700.             ZErrCode = 0 : _
  701.             GOTO 12621 _
  702.          ELSE ZErrCode = 0 : _
  703.               GOTO 12620
  704.       HashValue$ = MID$(Filler$,StartHashPos,LenHashField)
  705.       IF WasX$ = HashValue$ THEN _
  706.          IF StartIndivPos < 1 OR LenIndivField < 1 THEN _
  707.             WhetherFound = ZTrue : _
  708.             GOTO 12622 _
  709.          ELSE IndivValue$ = MID$(Filler$,StartIndivPos,LenIndivField) : _
  710.               IF ZWasY$ = IndivValue$ OR IndivValue$ = EmptyIndiv$ THEN _
  711.                  WhetherFound = ZTrue : _
  712.                  GOTO 12622
  713.       IF HashValue$ = EmptyRec$ THEN _
  714.          PosToUse = PosToReclaim - (PosToReclaim = 0) * PosToUse : _
  715.          WhetherFound = ZFalse : _
  716.          GOTO 12622
  717.       IF ASC(HashValue$) = 0 OR INSTR(HashValue$,NewUser$) = 1 THEN _
  718.          IF PosToReclaim = 0 THEN _
  719.             PosToReclaim = PosToUse
  720. 12620 PosToUse = PosToUse + ZWasDF
  721.       IF PosToUse > MaxPosition - 1 THEN _
  722.          PosToUse = PosToUse - MaxPosition
  723.       GOTO 12610
  724. 12621 IF PosToReclaim = 0 THEN _
  725.          PosToReclaim = PosToUse
  726.       GOTO 12620
  727. 12622 END SUB
  728. 13661 ' $SUBTITLE: 'UpdtCalr - subroutine to write to CALLERS file'
  729. ' $PAGE
  730. '
  731. '  NAME    -- UpdtCalr
  732. '
  733. '  INPUTS  --     PARAMETER                    MEANING
  734. '                 ErrMsg$                   MESSAGE TO GO IN CALLER LOG
  735. '                 EXTLog               = 1  CHECK FOR EXTENDED LOGGING
  736. '                                           BEFORE UPDATING.
  737. '                                      = 2  UPDATE CALLER LOG WITH ZWasZ$
  738. '                                      = 3  Time stamp before logging
  739. '
  740. '  OUTPUTS -- ZCurDate$           CURRENT DATE (MM-DD-YY)
  741. '             ZTime$                    CURRENT TIME (I.E. 1:13 PM)
  742. '             TIME.LOGGEND.ON$        TIME USER LOGGED ON (HH:MM:SS)
  743. '
  744. '  PURPOSE -- To update the caller's file and/or print on the
  745. '             local printer if it is enabled
  746. '
  747.       SUB UpdtCalr (ErrMsg$,EXTLog) STATIC
  748.       ON ERROR GOTO 65000
  749.       IF ZCallersFilePrefix$ = "" OR (ZLocalUser AND ZSysop) THEN _
  750.          EXIT SUB
  751.       WasX$ = "     " + ErrMsg$
  752. 13663 ZErrCode = 0
  753.       FIELD 4, 64 AS ZCallersRecord$
  754.       IF ZErrCode > 0 THEN _
  755.          CALL QuickTPut1 ("Caller's file:  error"+STR$(ZErrCode)) : _
  756.          ZErrCode = 0 : _
  757.          EXIT SUB
  758.       ON EXTLog GOTO 13665,13670,13667
  759. '
  760. ' ****  EXTENDED LOGGING ENTRY  ***
  761. '
  762. 13665 IF NOT ZExtendedLogging THEN _
  763.          EXIT SUB
  764. 13667 CALL AMorPM
  765.       WasX$ = WasX$ + " at " + ZTime$
  766. '
  767. ' ****  UPDATE CALLERS FILE WITH USER ACTIVITY  ****
  768. '
  769. 13670 LSET ZCallersRecord$ = WasX$
  770.       CALL Printit (ZCallersRecord$)
  771.       ZCallersFileIndex! = ZCallersFileIndex! + 1
  772. 13672 PUT 4,ZCallersFileIndex!
  773.       END SUB
  774. 13673 ' $SUBTITLE: 'Printit - subroutine to print on the local printer'
  775. ' $PAGE
  776. '
  777. '  NAME    -- Printit
  778. '
  779. '  INPUTS  --     PARAMETER                    MEANING
  780. '                 Strng$              STRING TO WRITE TO THE Printer
  781. '
  782. '  OUTPUTS -- NONE
  783. '
  784. '  PURPOSE -- To write to the printer attached to the pc running
  785. '             RBBS-PC and toggle the printer switch off whenever
  786. '             the printer is/becomes unavailable
  787. '
  788.       SUB Printit (Strng$) STATIC
  789.       ON ERROR GOTO 65000
  790. 13674 IF ZPrinter THEN _
  791.          LPRINT Strng$
  792.       END SUB
  793. 20101 ' $SUBTITLE: 'ChangeDir - subroutine to change subdirectories'
  794. ' $PAGE
  795. '
  796. '  NAME    -- ChangeDir
  797. '
  798. '  INPUTS  -- PARAMETER                    MEANING
  799. '             NewDir$                      NAME OF SUBDIRECTORY
  800. '
  801. '  OUTPUTS -- ZOK                           TRUE IF CHDIR SUCCESSFUL
  802. '             ZErrCode                      ERROR CODE
  803. '
  804. '  PURPOSE -- Change subdirectory
  805. '
  806.       SUB ChangeDir (NewDir$) STATIC
  807.       ON ERROR GOTO 65000
  808.       ZErrCode = 0
  809.       ZOK = ZTrue
  810. 20103 CHDIR NewDir$
  811.       END SUB
  812. 20219 ' $SUBTITLE: 'FINDITX - subroutine to find if a file exists'
  813. ' $PAGE
  814. '
  815. '  NAME    -- FINDITX
  816. '
  817. '  INPUTS  -- PARAMETER                    MEANING
  818. '             FilName$                 NAME OF FILE TO FIND
  819. '             FileNum                  # TO OPEN FILE AS
  820. '
  821. '  OUTPUTS -- ZOK                      TRUE IF FILE EXISTS
  822. '             ZErrCode                 ERROR CODE
  823. '
  824. '  PURPOSE -- Determine whether a file exists
  825. '
  826.       SUB FindItX (FilName$,FileNum) STATIC
  827.       ON ERROR GOTO 65000
  828.       ZErrCode = 0
  829.       ZOK = ZFalse
  830.       IF LEN(FilName$) < 1 THEN _
  831.          EXIT SUB
  832.       IF ZTurboRBBS THEN _
  833.          CALL FindFile (FilName$,ZOK) : _
  834.          IF ZOK THEN _
  835.             GOTO 20222 _
  836.          ELSE EXIT SUB
  837. 20221 CALL BadFileChar (FilName$,ZOK)
  838.       IF NOT ZOK THEN _
  839.          EXIT SUB
  840.       ZOK = ZFalse
  841.       NAME FilName$ AS FilName$
  842.       IF ZErrCode = 53 THEN _
  843.          ZErrCode = 0 : _
  844.          EXIT SUB
  845. 20222 CLOSE FileNum
  846. 20223 CALL OpenWork (FileNum,FilName$)
  847.       IF ZErrCode = 64 OR ZErrCode = 76 THEN _
  848.          ZOK = ZFalse : _
  849.          EXIT SUB
  850.       ZOK = ZTrue
  851.       END SUB
  852. 20308 ' $SUBTITLE: 'FlushCom -- subroutine reads all char. from  comm. port'
  853. ' $PAGE
  854. '
  855. '  NAME -- FlushCom
  856. '
  857. '  INPUTS --   PARAMETER     MEANING
  858. '              STrng$       STRING TO READ CHARACTERS INTO FROM
  859. '                           THE COMMUNICATIONS PORT (FILE #3)
  860. '
  861. '  OUTPUTS --   Strng$
  862. '
  863. '  PURPOSE -- Reads all characters from the communications port.
  864. '
  865.       SUB FlushCom (Strng$) STATIC
  866.       ON ERROR GOTO 65000
  867.       IF ZLocalUser THEN _
  868.          EXIT SUB
  869.       Strng$ = ""
  870.       IF NOT ZFossil THEN _
  871.          GOTO 20311
  872. 20310 CALL FosReadAhead(ZComPort,Char)
  873.       IF Char <> -1 THEN _
  874.          CALL FOSRXChar(ZComPort,Char) : _
  875.          Strng$ = Strng$ + CHR$(Char) : _
  876.          GOTO 20310
  877.       EXIT SUB
  878. 20311 Strng$ = INPUT$(LOC(3),3)                     ' FLUSH THE COMM BUFFER
  879. 20312 IF ZErrCode = 57 THEN _
  880.          LineStatus = INP(ZLineStatusReg) : _
  881.          ZErrCode = 0 : _
  882.          GOTO 20311
  883.       END SUB
  884. 20898 ' $SUBTITLE: 'NetBIOS - subroutine to lock/unlock using NetBIOS'
  885. ' $PAGE
  886. '
  887. '  NAME    -- NetBIOS   (WRITTEN BY DOUG AZZARITO)
  888. '
  889. '  INPUTS  -- IBMLockCmd       = 1-LOCK, 0-UNLOCK
  890. '             IBMFileLock      = 5 USERS FILE
  891. '                              = 6 SEMAPHORE FILE
  892. '             IBMRecLock       = RECORD NUMBER TO LOCK
  893. '
  894. '  OUTPUTS -- NONE
  895. '
  896. '  PURPOSE -- Lock and unlock files using NetBIOS commands.
  897. '             If lock fails, this routine tries forever.
  898. '
  899.       SUB NetBIOS (IBMLockCmd,IBMFileLock,IBMRecLock) STATIC
  900.       STATIC IBMCount
  901.       ON ERROR GOTO 65000
  902. 29900 ON IBMLockCmd + 1 GOTO 29920, 29910
  903.       EXIT SUB
  904. '
  905. ' *****  LOCK LOOP   ****
  906. '
  907. 29910 ZErrCode = 0
  908.       IF IBMFileLock = 6 AND IBMRecLock = 3 THEN _
  909.          IBMCount = IBMCount + 1 : _
  910.          IF IBMCount > 1 THEN _
  911.             EXIT SUB
  912.       LOCK IBMFileLock, IBMRecLock TO IBMRecLock
  913.       IF ZErrCode <> 0 THEN _
  914.          GOTO 29910
  915.       EXIT SUB
  916. 29920 ZErrCode = 0
  917.       IF IBMFileLock = 6 AND IBMRecLock = 3 THEN _
  918.          IBMCount = IBMCount - 1 : _
  919.          IF IBMCount > 0 THEN _
  920.             EXIT SUB _
  921.          ELSE IBMCount = 0
  922.       UNLOCK IBMFileLock, IBMRecLock TO IBMRecLock
  923.       IF ZErrCode = 70 THEN _
  924.          EXIT SUB
  925.       IF ZErrCode <> 0 THEN _
  926.          GOTO 29920
  927.       END SUB
  928. 43048 ' $SUBTITLE: 'UpdateC - update of callers log on exiting'
  929. ' $PAGE
  930. '
  931. '  NAME    -- UpdateC
  932. '
  933. '  INPUTS  --     PARAMETER                    MEANING
  934. '             ZCallersFileIndex!
  935. '             ZFirstName$
  936. '             ZWasHHH
  937. '             ZLastName$
  938. '             ZWasMMM
  939. '             ZWasNG$
  940. '             ZWasSSS
  941. '             ZSysopFirstName$
  942. '             ZSysopLastName$
  943. '
  944. '  OUTPUTS -- ZCallersRecord$
  945. '             ZCallersFileIndex!
  946. '             ZSysop
  947. '
  948. '  PURPOSE -- Update the callers file at logoff so that the number
  949. '             of hours, minutes, and seconds for the session are
  950. '             recorded as the last 9 characters of the 64-character
  951. '             callers file record
  952. '
  953.       SUB UpdateC STATIC
  954.       ON ERROR GOTO 65000
  955.       IF ZCallersFilePrefix$ = "" THEN _
  956.          EXIT SUB
  957. '
  958. ' ****  UPDATE CALLERS FILE AT LOGOFF  ***
  959. '
  960. 43050 FIELD 4,55 AS ZCallersRecord$,3 AS Hours$,3 AS Minutes$,3 AS Seconds$
  961.       LSET ZCallersRecord$ = MID$(ZWasNG$,65,55)
  962.       LSET Hours$ = STR$(ZSessionHour)
  963.       LSET Minutes$ = STR$(ZSessionMin)
  964.       LSET Seconds$ = STR$(ZSessionSec)
  965.       ZCallersFileIndex! = ZCallersFileIndex! + 1
  966.       PUT 4,ZCallersFileIndex!
  967.       FIELD 4,64 AS ZCallersRecord$
  968.       LSET ZCallersRecord$ = LEFT$(ZWasNG$,64)
  969.       ZCallersFileIndex! = ZCallersFileIndex! + 1
  970.       PUT 4,ZCallersFileIndex!
  971. 43060 LSET ZCallersRecord$ = STRING$(64,CHR$(0))
  972.       ZCallersFileIndex! = ZCallersFileIndex! + 1
  973.       PUT 4,ZCallersFileIndex!
  974.       ZCallersFileIndex! = ZCallersFileIndex! + 1
  975.       PUT 4,ZCallersFileIndex!
  976.       IF ZOrigCallers$ <> ZCallersFile$ THEN _
  977.          ZCallersFile$ = ZOrigCallers$ : _
  978.          CALL SetCall : _
  979.          GOTO 43050
  980.       END SUB
  981. 51098 ' $SUBTITLE: 'FindFree - subroutine to find space on a device'
  982. ' $PAGE
  983. '
  984. '  NAME    -- FindFree
  985. '
  986. '  INPUTS  --     PARAMETER                    MEANING
  987. '                 ZWasZ$                       NAME OF FILE TO FIND
  988. '
  989. '  OUTPUTS -- ZFreeSpace$                      NUMBER OF BYTES FREE
  990. '
  991. '  PURPOSE -- To determine amount of free space on a device
  992. '
  993.       SUB FindFree STATIC
  994.       ON ERROR GOTO 65000
  995.       ZErrCode = 0
  996. 52000 IF ZTurboRBBS THEN _
  997.          GOTO 52003
  998.       ZFreeSpace$ = ""
  999.       CLS
  1000.       ZErrCode = 0
  1001. 52001 FILES ZWasZ$
  1002.       IF ZErrCode = 53 AND (ZWasZ$ = ZCmntsFile$ OR ZWasZ$ = ZUpldDriveFile$ ) THEN _
  1003.          CALL OpenOutW (ZWasZ$) : _
  1004.          GOTO 52000
  1005.       IF ZErrCode = 53 AND ZWasZ$ = ZUpldDir$ THEN _
  1006.          ZOutTxt$ = "Upload directory missing.  Tell SysOp" : _
  1007.          ZSubParm = 6 : _
  1008.          CALL TPut : _
  1009.          GOTO 52002
  1010.       FOR WasX = 1 TO 25
  1011.          ZFreeSpace$ = ZFreeSpace$ + CHR$(SCREEN (3,WasX))
  1012.       NEXT
  1013. 52002 ZSubParm = 1
  1014.       CALL Line25
  1015.       EXIT SUB
  1016. 52003 WasAX = 0
  1017.       WasBX = 0
  1018.       WasCX = 0
  1019.       WasDX = 0
  1020.       IF MID$(ZWasZ$,2,1) = ":" THEN _
  1021.          WasAX = ASC(ZWasZ$) - ASC("A") + 1
  1022.       CALL RBBSFree (WasAX,WasBX,WasCX,WasDX)
  1023.       WasI# = CDBL(WasAX) * (WasBX + 65536! * (-(WasBX < 0)))
  1024.       WasI# = WasI# * WasCX
  1025.       ZFreeSpace$ = STR$(WasI#) + _
  1026.                     " bytes free"
  1027.       END SUB
  1028. 57978 ' $SUBTITLE: 'OpenWork - subroutine to open RBBS-PC's work file (2)'
  1029. ' $PAGE
  1030. '
  1031. '  NAME   -- OpenWork
  1032. '
  1033. '  INPUTS --     PARAMETER                    MEANING
  1034. '                FileNum                    # OF FILE TO OPEN AS
  1035. '                FilName$                   NAME OF FILE TO FIND
  1036. '                ZShareIt                   USE DOS' "SHARE" FACILITIES
  1037. '
  1038. '  OUTPUTS -- ZErrCode                        ERROR CODE
  1039. '
  1040. '  PURPOSE -- To open RBBS-PC's "work" file (number 2)
  1041. '
  1042.       SUB OpenWork (FileNum,FilName$) STATIC
  1043.       ON ERROR GOTO 65000
  1044. 58000 CLOSE FileNum
  1045. 58010 ZErrCode = 0
  1046. 58020 IF ZShareIt THEN _
  1047.          OPEN FilName$ FOR INPUT SHARED AS #FileNum _
  1048.       ELSE OPEN "I",FileNum,FilName$
  1049.       IF ZErrCode = 52 THEN _
  1050.          GOTO 58010
  1051. 58030 END SUB
  1052. 58190 ' $SUBTITLE: 'OpenFMS - subroutine to open the FMS directory'
  1053. ' $PAGE
  1054. '
  1055. '  NAME    -- OpenFMS
  1056. '
  1057. '  INPUTS  -- PARAMETER                      MEANING
  1058. '             ZShareIt                DOS SHARING FLAG
  1059. '             ZFMSDirectory$          NAME OF FMS DIRECTORY
  1060. '
  1061. '  OUTPUTS -- LastRec                NUMBER OF THE Last
  1062. '                                    RECORD IN THE FILE
  1063. '             CatLen                 Length of the category code
  1064. '
  1065. '  PURPOSE -- To open the upload directory as a random file and find
  1066. '             the number of the last record in the file.
  1067. '
  1068.       SUB OpenFMS (LastRec,CatLen) STATIC
  1069.       ON ERROR GOTO 65000
  1070.       CLOSE 2
  1071.       IF ZActiveFMSDir$ = "" THEN _
  1072.          IF ZMenuIndex = 6 THEN _
  1073.             ZActiveFMSDir$ = ZLibDir$ _
  1074.          ELSE ZActiveFMSDir$ = ZFMSDirectory$
  1075.       OldFile = (ZActiveFMSDir$ = PrevFMS$)
  1076.       IF OldFile THEN _
  1077.          GOTO 58192
  1078.       CALL OpenWork (2,ZActiveFMSDir$)
  1079.       CALL ReadDir (2,1)
  1080.       IF ZErrCode > 0 THEN _
  1081.          IF ZActiveFMSDir$ = ZPersonalDir$ THEN _
  1082.             ZFMSFileLength = 36 + ZMaxDescLen + ZPersonalLen _
  1083.          ELSE ZFMSFileLength = 38 + ZMaxDescLen _
  1084.       ELSE ZFMSFileLength = LEN(ZOutTxt$) + 2
  1085.       CalcCatLen = ZFMSFileLength - 35 - ZMaxDescLen + (ZFMSFileLength > 85)
  1086.       CLOSE 2
  1087. 58192 ZErrCode = 0
  1088.       IF ZShareIt THEN _
  1089.          OPEN ZActiveFMSDir$ FOR RANDOM SHARED AS #2 LEN=ZFMSFileLength _
  1090.       ELSE OPEN "R",2,ZActiveFMSDir$,ZFMSFileLength
  1091.       IF ZErrCode > 0 THEN _
  1092.          CALL QuickTPut1 ("Drive/path does not exist or bad name for FMS dir " + _
  1093.                      ZActiveFMSDir$) : _
  1094.          END
  1095.       LastRec = LOF(2)/ZFMSFileLength
  1096.       CatLen = CalcCatLen
  1097.       IF OldFile THEN _
  1098.          EXIT SUB
  1099.       PrevFMS$ = ZActiveFMSDir$
  1100.       FIELD 2, ZFMSFileLength AS FMSRec$
  1101.       GET #2,1
  1102.       ZWasA = (LEFT$(FMSRec$,4) <> "\FMS")
  1103.       ZUpInc = 2*(INSTR(FMSRec$," TOP ") = 0 OR ZWasA) + 1
  1104.       ZDateOrderedFMS = ZWasA OR (INSTR(FMSRec$," NOSORT") = 0)
  1105.       ZWasDF = INSTR(FMSRec$,"CH(")
  1106.       ZChainedDir$ = ""
  1107.       IF ZWasDF > 0 AND (NOT ZWasA) THEN _
  1108.          WasX = INSTR(ZWasDF,FMSRec$,")") : _
  1109.          IF WasX > 0 THEN _
  1110.             ZChainedDir$ = MID$(FMSRec$,ZWasDF+3,WasX-ZWasDF-3) : _
  1111.             CALL FindFile (ZChainedDir$,ZOK) : _
  1112.             IF NOT ZOK THEN _
  1113.                ZChainedDir$ = ""
  1114.       IF ZActiveFMSDir$ = ZPersonalDir$ THEN _
  1115.          ZFileWaiting = ZFalse
  1116.       ZPersonalDnld = ((ZActiveFMSDir$ = ZPersonalDir$) OR _
  1117.                        (INSTR(FMSRec$," PERS") > 0 AND NOT ZWasA))
  1118.       ZFreeDnld = ZPersonalDnld
  1119.       IF NOT ZWasA THEN _
  1120.          IF INSTR(FMSRec$," NOFREE") > 0 THEN _
  1121.             ZFreeDnld = ZFalse _
  1122.          ELSE IF INSTR(FMSRec$," FREE") > 0 THEN _
  1123.             ZFreeDnld = ZTrue
  1124.       ZListOnly = ZPersonalDnld
  1125.       IF NOT ZWasA THEN _
  1126.          IF INSTR(FMSRec$," LISTONLY ") > 0 THEN _
  1127.             ZListOnly = ZTrue
  1128.       ZExtraDnldTime = -60 * ZPersonalDnld
  1129.       IF NOT ZWasA THEN _
  1130.          WasX = INSTR(FMSRec$," TIMEEXTRA ")
  1131.          IF WasX > 0 THEN _
  1132.             CALL CheckInt (MID$(FMSRec$,WasX+10)) : _
  1133.             ZExtraDnldTime = ZTestedIntValue
  1134.       END SUB
  1135. 58220 ' $SUBTITLE: 'OpenOutW - sub to open output work file (2)'
  1136. ' $PAGE
  1137. '
  1138. '  NAME    -- OpenOutW
  1139. '
  1140. '  INPUTS  --     PARAMETER                 MEANING
  1141. '                 ZFileName$            NAME OF FILE TO FIND
  1142. '                 ZShareIt              USE DOS' "SHARE" FACILITIES
  1143. '
  1144. '  OUTPUTS -- ZErrCode                        ERROR CODE
  1145. '
  1146. '  PURPOSE -- To open RBBS-PC's "work" file (number 2) for output
  1147. '
  1148.       SUB OpenOutW (FilName$) STATIC
  1149.       ON ERROR GOTO 65000
  1150.       CLOSE 2
  1151. 58225 ZErrCode = 0
  1152. 58230 IF ZShareIt THEN _
  1153.          OPEN FilName$ FOR OUTPUT SHARED AS #2 _
  1154.       ELSE OPEN "O",2,FilName$
  1155. 58235 END SUB
  1156. 58260 ' $SUBTITLE: 'KillWork - subroutine to delete a "work" file'
  1157. ' $PAGE
  1158. '
  1159. '  NAME    -- KillWork
  1160. '
  1161. '  INPUTS  --     PARAMETER                    MEANING
  1162. '                 FilName$                  NAME OF FILE TO DELETE
  1163. '
  1164. '  OUTPUTS -- ZErrCode                        ERROR CODE
  1165. '
  1166. '  SUBROUTINE PURPOSE -- To delete a RBBS-PC "work" file
  1167. '
  1168.       SUB KillWork (FilName$) STATIC
  1169.       ON ERROR GOTO 65000
  1170.       CLOSE 2
  1171.       ZErrCode = 0
  1172. 58270 KILL FilName$
  1173. 58275 END SUB
  1174. 58280 ' $SUBTITLE: 'GetPassword - sub to read the "passwords" file'
  1175. ' $PAGE
  1176. '
  1177. '  NAME    -- GetPassword
  1178. '
  1179. '                          PARAMETER             MEANING
  1180. '  INPUTS  -- FILE # 2 OPENED
  1181. '
  1182. '  OUTPUTS -- ZTempPassword$
  1183. '             ZTempSecLevel
  1184. '             ZTempTimeAllowed
  1185. '             ZTempRegPeriod
  1186. '             ZTempMaxPerDay
  1187. '
  1188. '  PURPOSE -- To read the RBBS-PC "PASSWORDS" file
  1189. '
  1190.       SUB GetPassword STATIC
  1191.       ON ERROR GOTO 65000
  1192.       ZErrCode = 0
  1193.       INPUT #2,ZTempPassword$,    ZTempSecLevel, _
  1194.                ZTempTimeAllowed,  ZTempMaxPerDay, _
  1195.                ZTempRegPeriod,    ZTempExpiredSec, _
  1196.                ZStartTime,        ZEndTime, _
  1197.                ZByteMethod,       ZRatioRestrict#, _
  1198.                ZInitialCredit#,   ZTempTimeLock, _
  1199.                ZTempMaxBank
  1200. 58285 END SUB
  1201. 58290 ' $SUBTITLE: 'ReadDir - subroutine to read the "DIR" files'
  1202. ' $PAGE
  1203. '
  1204. '  NAME    -- ReadDir
  1205. '
  1206. '             PARAMETER                MEANING
  1207. '  INPUTS  -- FileNum                  WHICH # FILE TO READ
  1208. '             WhichLine                HOW MANY LINES TO ADVANCE
  1209. '
  1210. '  OUTPUTS -- ZOutTxt$
  1211. '
  1212. '  PURPOSE -- To read possible "DIR" files
  1213. '
  1214.       SUB ReadDir (FileNum,WhichLine) STATIC
  1215.       ON ERROR GOTO 65000
  1216.       ZErrCode = 0
  1217.       FOR WasI = 1 TO WhichLine
  1218.          LINE INPUT #FileNum,ZOutTxt$
  1219.       NEXT
  1220. 58295 END SUB
  1221. 58300 ' $SUBTITLE: 'ReadParmsX - subroutine to read parameter values'
  1222. ' $PAGE
  1223. '
  1224. '  NAME    -- ReadParmsX
  1225. '
  1226. '               PARAMETER             MEANING
  1227. '  INPUTS  -- FILE # 2 OPENED
  1228. '             NumParms               # parameters to read
  1229. '             WhichLine              Which set of parms to return
  1230. '  OUTPUTS -- ARA.TO.USER$           Array of string values
  1231. '             FILE.SECURITY
  1232. '             FilePswd$
  1233. '
  1234. '  PURPOSE -- To read different values, where values are
  1235. '             separated by a comma or carriage-return-line-feed.
  1236. '
  1237.       SUB ReadParmsX (FilNum,AraToUse$(1),NumParms,WhichLine) STATIC
  1238.       ON ERROR GOTO 65000
  1239.       ZErrCode = 0
  1240.       FOR WasJ = 1 TO WhichLine
  1241.          FOR WasI = 1 TO NumParms
  1242.             INPUT #FilNum,AraToUse$(WasI)
  1243.          NEXT
  1244.       NEXT
  1245. 58305 END SUB
  1246. 58310 ' $SUBTITLE: 'ReadAny - subroutine to read file 2 into ZOutTxt$'
  1247. ' $PAGE
  1248. '
  1249. '  NAME    -- ReadAny
  1250. '
  1251. '               PARAMETER             MEANING
  1252. '  INPUTS  -- FILE # 2 OPENED
  1253. '
  1254. '  OUTPUTS -- ZOutTxt$
  1255. '
  1256. '  PURPOSE -- To read file #2 into ZOutTxt$
  1257. '
  1258.       SUB ReadAny STATIC
  1259.       ON ERROR GOTO 65000
  1260.       ZErrCode = 0
  1261.       INPUT #2,ZOutTxt$
  1262. 58315 END SUB
  1263. 58320 ' $SUBTITLE: 'PrintWork - subroutine to print to file 2'
  1264. ' $PAGE
  1265. '
  1266. '  NAME    -- PrintWork
  1267. '
  1268. '               PARAMETER             MEANING
  1269. '  INPUTS  -- FILE # 2 OPENED
  1270. '             STRING TO WRITE OUT
  1271. '
  1272. '  OUTPUTS -- NONE
  1273. '
  1274. '  PURPOSE -- To print a string to file #2
  1275. '
  1276.       SUB PrintWork (Strng$) STATIC
  1277.       ON ERROR GOTO 65000
  1278.       ZErrCode = 0
  1279.       PRINT #2,Strng$;
  1280. 58325 END SUB
  1281. 58330 ' $SUBTITLE: 'GetWork - subroutine to read file 2'
  1282. ' $PAGE
  1283. '
  1284. '  NAME    -- GetWork
  1285. '
  1286. '               PARAMETER             MEANING
  1287. '  INPUTS  -- RecLen            Length of record
  1288. '
  1289. '  OUTPUTS -- NONE
  1290. '
  1291. '  PURPOSE -- To read a record from file #2
  1292. '
  1293.       SUB GetWork (RecLen) STATIC
  1294.       ON ERROR GOTO 65000
  1295.       ZErrCode = 0
  1296.       FIELD 2, RecLen AS ZDnldRecord$
  1297.       GET 2,(LOC(2)+1)
  1298. 58335 END SUB
  1299. 58340 ' $SUBTITLE: 'OpenWorkA - subroutine to open output work file (2)'
  1300. ' $PAGE
  1301. '
  1302. '  NAME    -- OpenWorkA
  1303. '
  1304. '  INPUTS  --     PARAMETER                    MEANING
  1305. '              FilName$                  NAME OF FILE TO FIND
  1306. '              ZShareIt                  USE DOS' "SHARE" FACILITIES
  1307. '
  1308. '  OUTPUTS -- ZErrCode                        ERROR CODE
  1309. '
  1310. '  PURPOSE -- To open RBBS-PC's "work" file (number 2) for appended output
  1311. '
  1312.       SUB OpenWorkA (FilName$) STATIC
  1313.       ON ERROR GOTO 65000
  1314.       CLOSE 2
  1315.       ZErrCode = 0
  1316.       IF ZShareIt THEN _
  1317.          OPEN FilName$ FOR APPEND SHARED AS #2 _
  1318.       ELSE OPEN "A",2,FilName$
  1319. 58345 END SUB
  1320. 58350 ' $SUBTITLE: 'PrintWorkA - subroutine to print to file 2 with CR'
  1321. ' $PAGE
  1322. '
  1323. '  NAME    -- PrintWorkA
  1324. '
  1325. '                          PARAMETER             MEANING
  1326. '  INPUTS  --            FILE # 2 OPENED
  1327. '                        STRING TO WRITE OUT
  1328. '
  1329. '  OUTPUTS -- NONE
  1330. '
  1331. '  PURPOSE -- To print a string to file #2 followed by a carriage return
  1332. '
  1333.       SUB PrintWorkA (Strng$) STATIC
  1334.       ON ERROR GOTO 65000
  1335.       ZErrCode = 0
  1336.       PRINT #2,Strng$
  1337. 58355 END SUB
  1338. 58360 ' $SUBTITLE: 'CheckInt - subroutine to check input is an integer'
  1339. ' $PAGE
  1340. '
  1341. '  NAME    -- CheckInt
  1342. '
  1343. '             PARAMETER             MEANING
  1344. '  INPUTS  -- Strng$         STRING TO VERIFY CAN BE AN INTEGER
  1345. '
  1346. '  OUTPUTS -- ZErrCode             = 0 MEANS IT IS AN INTEGER VALUE
  1347. '                                 <> 0 MEANS IT IS NOT AN INTEGER VALUE
  1348. '             ZTestedIntValue  Integer value of expression
  1349. '
  1350. '  PURPOSE -- To validate that a string represents an integer
  1351. '
  1352.       SUB CheckInt (Strng$) STATIC
  1353.       ON ERROR GOTO 65000
  1354.       ZErrCode = 0
  1355.       WasX$ = Strng$
  1356.       CALL Trim (WasX$)
  1357.       ZTestedIntValue = VAL(LEFT$(WasX$,INSTR(WasX$+" "," ")-1))
  1358. 58365 END SUB
  1359. 59650 ' $SUBTITLE: 'PutCom -- subroutine to write to communications port'
  1360. ' $PAGE
  1361. '
  1362. '  NAME    --  PutCom
  1363. '
  1364. '  INPUTS  --   PARAMETER     MEANING
  1365. '                STRNG$      STRING TO PRINT TO COMM PORT
  1366. '              ZFlowControl  WHETHER USING CLEAR TO SEND FOR FLOW
  1367. '                            CONTROL BETWEEN THE PC AND THE MODEM
  1368. '
  1369. '  OUTPUTS --
  1370. '
  1371. '  PURPOSE -- Checks for carrier drop and flow control (xon/xoff)
  1372. '             before writing to the communications port.
  1373. '
  1374.       SUB PutCom (Strng$) STATIC
  1375.       ON ERROR GOTO 65000
  1376.       IF ZLocalUser THEN _
  1377.          EXIT SUB
  1378.       CALL CheckCarrier
  1379.       IF ZSubParm = -1 THEN _
  1380.          EXIT SUB
  1381.       IF NOT ZXOffEd THEN _
  1382.          GOTO 59652
  1383.       ZSubParm = 1
  1384.       CALL Line25
  1385.       ZWasY$ = ZXOff$
  1386.       XOffTimeout! = TIMER + 30
  1387.       WHILE ZWasY$ = ZXOff$ AND ZSubParm <> -1
  1388.          Char = -1
  1389.          WHILE Char = -1 AND ZSubParm <> -1
  1390.             GOSUB 59654
  1391.          WEND
  1392.          IF Char <> -1 THEN _
  1393.             CALL GetCom(ZWasY$) : _
  1394.             IF ZXOnXOff AND ZWasY$ <> ZXOn$ THEN _
  1395.                ZWasY$ = ZXOff$
  1396.       WEND
  1397.       ZXOffEd = ZFalse
  1398.       ZSubParm = 1
  1399.       CALL Line25
  1400. 59652 ZNotCTS = ZFalse
  1401.       IF NOT ZFossil THEN _
  1402.          PRINT #3,Strng$; : _
  1403.          EXIT SUB
  1404.       IF Strng$ = "" THEN _
  1405.          EXIT SUB
  1406.       FOR WasN = 1 TO LEN(Strng$)
  1407.           Char = ASC(MID$(Strng$,WasN,1))
  1408. 59653     CALL FosTXCharNW(ZComPort,Char,Result)
  1409.           IF Result = 0 THEN _
  1410.              CALL GoIdle : _
  1411.              GOTO 59653
  1412.       NEXT
  1413.       EXIT SUB
  1414. 59654 CALL EofComm (Char)
  1415.       CALL GoIdle
  1416.       CALL CheckCarrier
  1417.       IF ZSubParm <> -1 THEN _
  1418.          CALL CheckTime(XOffTimeout!, TempElapsed!,1) : _
  1419.          IF ZSubParm = 2 THEN _
  1420.             ZSubParm = -1
  1421.       RETURN
  1422.       END SUB
  1423. 59660 ' $SUBTITLE: 'PutWork -- subroutine to write to upload files'
  1424. ' $PAGE
  1425. '
  1426. '  NAME    -- PutWork
  1427. '
  1428. '  INPUTS  --   PARAMETER     MEANING
  1429. '                STNG$       STRING TO WRITE TO FILE
  1430. '                RecNum      RECORD NUMBER TO WRITE
  1431. '                RecLen      LENGTH OF RECORD TO WRITE
  1432. '
  1433. '  OUTPUTS --
  1434. '
  1435. '  PURPOSE -- Writes uploaded file records to work file
  1436. '
  1437.       SUB PutWork (Strng$,RecNum,RecLen) STATIC
  1438.       ON ERROR GOTO 65000
  1439.       FIELD #2,RecLen AS ZUpldRec$
  1440.       LSET ZUpldRec$ = Strng$
  1441.       RecNum = RecNum + 1
  1442.       PUT #2,RecNum
  1443.       END SUB
  1444. 59680 ' $SUBTITLE: 'RBBSPlay -- subroutine to play music'
  1445. ' $PAGE
  1446. '
  1447. '  NAME    -- RBBSPlay
  1448. '
  1449. '  INPUTS  --   PARAMETER     MEANING
  1450. '               Strng$      STRING TO PLAY
  1451. '
  1452. '  OUTPUTS --
  1453. '
  1454. '  PURPOSE -- Play music.  Skip if get an error.
  1455. '
  1456.       SUB RBBSPlay (StringToPlay$) STATIC
  1457.       PLAY StringToPlay$
  1458.       ZErrCode = 0
  1459.       END SUB
  1460. 59700 ' $SUBTITLE: 'Talk -- subroutine for voice response'
  1461. ' $PAGE
  1462. '
  1463. '  NAME    -- Talk
  1464. '
  1465. '  INPUTS  --   PARAMETER     MEANING
  1466. '               ZVoiceType    TYPE OF VOICE SYNTHESIZER
  1467. '               VoiceRecord   RECORD NUMBER TO RETRIEVE
  1468. '
  1469. '  OUTPUTS --
  1470. '
  1471. '  PURPOSE -- Retrieve voice record and send to voice synthesizer
  1472. '
  1473.       SUB Talk (VoiceRecord,StringWork$) STATIC
  1474.       IF ZVoiceType = 0 THEN _
  1475.          EXIT SUB
  1476.       IF VoiceRecord > 0 THEN _
  1477.          GOTO 59720
  1478.       CLOSE 9,8
  1479.       IF ZVoiceType = 1 THEN _
  1480.          OPEN "COM2:2400,E,7,1,CS65535" AS #9 : _
  1481.          LPRINT "OPENED COM PORT"
  1482.       IF ZShareIt THEN _
  1483.          OPEN "RBBSTALK.DEF" FOR RANDOM SHARED AS #8 LEN=32 _
  1484.       ELSE OPEN "R",8,"RBBSTALK.DEF",32
  1485.       FIELD 8,30 AS TalkRecord$,2 AS Dummy$
  1486.       EXIT SUB
  1487. 59720 IF NOT ZSnoop THEN _
  1488.          EXIT SUB
  1489.       IF VoiceRecord < 65 THEN _
  1490.          GET 8,VoiceRecord : _
  1491.          StringWork$ = TalkRecord$ : _
  1492.          CALL Trim (StringWork$)
  1493. 59721 IF ZSmartTextCode THEN _
  1494.          CALL SmartText (StringWork$, CRFound,ZFalse)
  1495. 59722 IF ZVoiceType = 1 THEN _
  1496.          PRINT #9,StringWork$
  1497. 59723 IF ZVoiceType = 2 THEN _
  1498.          CALL RBBSHS (CHR$(LEN(StringWork$)+1)+StringWork$+CHR$(13))
  1499.       END SUB
  1500. 59725 ' $SUBTITLE: 'CommPut -- Writes to communications port'
  1501. ' $PAGE
  1502. '
  1503. '  NAME    -- CommPut
  1504. '
  1505. '  INPUTS  --   PARAMETER     MEANING
  1506. '               Strng$        String to write
  1507. '               ZFossil       Whether using Fossil driver
  1508. '
  1509. '  OUTPUTS --
  1510. '
  1511. '  PURPOSE -- Send string to comm port.  Recovers from errors.
  1512. '
  1513.       SUB CommPut (Strng$) STATIC
  1514.       ON ERROR GOTO 65000
  1515.       IF ZFossil THEN _
  1516.          Bytes = LEN(Strng$) : _
  1517.          CALL FosWrite(ZComPort,Bytes,Strng$) _
  1518.       ELSE PRINT #3,Strng$;
  1519.       END SUB
  1520. 59790 ' $SUBTITLE: 'FindFile -- subroutine to find a file'
  1521. ' $PAGE
  1522. '
  1523. '  NAME    --  FindFile
  1524. '
  1525. '  INPUTS  --  PARAMETER         MENANING
  1526. '               FilName$         NAME OF FILE TO LOOK FOR
  1527. '               FExists          WHETHER FILE EXISTS
  1528. '
  1529. '  OUTPUTS --  RETURNED.VALUE    VALUE RETURNED
  1530. '                                TRUE  = FILE EXISTS
  1531. '                                TRUE = FILE DOES NOT EXIST
  1532. '
  1533. '  PURPOSE --  Determine whether passed file FilName$ exists
  1534. '              Unlike, FindIt, this routine does not open any
  1535. '              file and, hence, does not create one in determining
  1536. '              whether a file exists.
  1537. '
  1538.       SUB FindFile (FilName$,FExists) STATIC
  1539.       CALL BadFileChar (FilName$,FExists)
  1540. 59791 IF FExists THEN _
  1541.          IOErrorCount = 0 : _
  1542.          CALL RBBSFind (FilName$,WasZ,WasY,WasM,WasD) : _
  1543.          FExists = (WasZ = 0)
  1544.       END SUB
  1545. '  $SUBTITLE: 'Error Handling for separately compiled subroutines'
  1546. '  $PAGE
  1547. '
  1548. '
  1549. ' Error handling for the separately compiled subroutines of RBBS-PC
  1550. '
  1551. '
  1552. 65000 IF ZDebug THEN _
  1553.          ZOutTxt$ = "RBBSSUB1 DEBUG Error Trap Entry ERL=" + _
  1554.               STR$(ERL) + _
  1555.               " ERR=" + _
  1556.               STR$(ERR) : _
  1557.          IF ZPrinter THEN _
  1558.             CALL Printit(ZOutTxt$) _
  1559.          ELSE CALL LPrnt(ZOutTxt$,1)
  1560.       ZErrCode = ERR
  1561. '
  1562. '     SetCall
  1563. '
  1564.       IF ERL = 108 THEN _
  1565.          CALL PScrn ("Unable to create callers log " + ZCallersFile$) : _
  1566.          SYSTEM
  1567.       IF ERL = 110 THEN _
  1568.           RESUME NEXT
  1569. '
  1570. '     OPEN CONFIG FILE
  1571. '
  1572.        IF ERL => 117 AND ERL <= 119 THEN _
  1573.           RESUME NEXT
  1574. '
  1575. '     OPEN COM PORT ERROR HANDLING
  1576. '
  1577.       IF ERL = 200 THEN _
  1578.          CLS : _
  1579.          CALL PScrn (ZComPort$ + " does not exist/not responding- Error" + STR$(ERR)) : _
  1580.          STOP
  1581. '
  1582. '     GetCom ERROR HANDLING
  1583. '
  1584.        IF ERL = 1420 AND ERR = 57 THEN _
  1585.           RESUME NEXT
  1586.        IF ERL = 1420 AND ERR = 69 THEN _
  1587.           ZSubParm = -1 :_
  1588.           RESUME NEXT
  1589. '
  1590. '      OPENRESEQ ERROR HANDLING
  1591. '
  1592.        IF ERL = 1480 OR ERL = 1487 THEN _
  1593.            ZErrCode = ERR : _
  1594.            RESUME NEXT
  1595. '
  1596. '      OpenUser ERROR HANDLING
  1597. '
  1598.        IF ERL = 9400 AND ERR = 75 AND ZShareIt THEN _
  1599.           CALL DelayTime (30) : _
  1600.           RESUME
  1601. '
  1602. '      FindUser ERROR HANDLING
  1603. '
  1604.        IF ERL = 12610 OR ERL = 12600 THEN _
  1605.           RESUME NEXT
  1606. '
  1607. '     UpdtCalr ERROR HANDLING
  1608. '
  1609.        IF ERL = 13663 THEN _
  1610.           RESUME NEXT
  1611.        IF ERL = 13672 AND ERR = 61 THEN _
  1612.           CALL QuickTPut1 ("Disk Full") : _
  1613.           IF ZDiskFullGoOffline THEN _
  1614.              GOTO 65010 _
  1615.           ELSE RESUME NEXT
  1616.        IF ERL = 13672 THEN _
  1617.           ZCallersFileIndex! = ZCallersFileIndex! - 1 : _
  1618.           RESUME NEXT
  1619. '
  1620. '     ZPrinter ERROR HANDLING
  1621. '
  1622.        IF ERL = 13674 THEN _
  1623.           ZPrinter = ZFalse : _
  1624.           RESUME
  1625. '
  1626. '      ChangeDir ERROR HANDLING
  1627. '
  1628.        IF ERL = 20103 THEN _
  1629.           ZOK = ZFalse : _
  1630.           RESUME NEXT
  1631. '
  1632. '     FindIt ERROR HANDLING
  1633. '
  1634.        IF ERL = 20221 THEN _
  1635.           RESUME NEXT
  1636.        IF ERL = 20223 AND ZErrCode = 58 THEN _
  1637.           ZErrCode = 64 : _
  1638.           ZOK = ZFalse : _
  1639.           RESUME NEXT
  1640.        IF ERL = 20223 AND ZErrCode = 76 THEN _
  1641.           CALL LPrnt("Bad path.  File name is " + FilName$,1) : _
  1642.           ZErrCode = 76 : _
  1643.           ZOK = ZFalse : _
  1644.           RESUME NEXT
  1645.        IF ERL => 20221 AND ERL <= 20223 AND ZErrCode = 70 _
  1646.           AND ZNetworkType = 6 THEN _
  1647.              ZErrCode = 0 : _
  1648.              RESUME NEXT
  1649.        IF ERL => 20221 AND ERL <= 20223 THEN _
  1650.           RESUME
  1651. '
  1652. '     FlushCom ERROR HANDLING
  1653. '
  1654.        IF ERL = 20311 AND ERR = 57 THEN _
  1655.           RESUME NEXT
  1656.        IF ERL = 20311 AND ERR = 69 THEN _
  1657.           ZAbort = ZTrue : _
  1658.           ZSubParm = -1 : _
  1659.           RESUME NEXT
  1660. '
  1661. '     NetBIOS ERROR HANDLING
  1662. '
  1663.        IF ERL => 29900 AND ERL <= 29920 THEN _
  1664.           RESUME NEXT
  1665. '
  1666. '     UpdateC ERROR HANDLING
  1667. '
  1668.       IF ERL => 43050 AND ERL <= 43060 AND ERR = 61 THEN _
  1669.          ZOutTxt$ = "* Disk full - terminating *" : _
  1670.          ZSubParm =2 : _
  1671.          CALL TPut : _
  1672.          IF ZDiskFullGoOffline THEN _
  1673.            GOTO 65010 _
  1674.          ELSE SYSTEM
  1675. '
  1676. '     CheckInt ERROR HANDLING
  1677. '
  1678.        IF (ERL = 59652 OR ERL = 59727) AND ERR = 24 THEN _
  1679.           ZNotCTS = ZTrue : _
  1680.           CALL Line25 : _
  1681.           ZErrCode = 0 : _
  1682.           RESUME
  1683.        IF ERL => 52000 AND ERL <= 59725 THEN _
  1684.           RESUME NEXT
  1685. '
  1686. '     FindFile ERROR HANDLING
  1687. '
  1688.        IF ERL = 59791 THEN _
  1689.           IF ERR <> 57 THEN _
  1690.              RESUME NEXT _
  1691.           ELSE IF ERR = 57 THEN _
  1692.              CALL DelayTime (1) : _
  1693.              CALL UpdtCalr ("SLOW I/O ERROR",1) : _
  1694.              IOErrorCount = IOErrorCount + 1 : _
  1695.              IF IOErrorCount < 11 THEN _
  1696.                 RESUME
  1697. '
  1698. '     CATCH ALL OTHER ERRORS
  1699. '
  1700.        ZOutTxt$ = "RBBS-SUB1 Untrapped Error" + _
  1701.             STR$(ERR) + _
  1702.             " in line" + _
  1703.             STR$(ERL)
  1704.        CALL QuickTPut1 (ZOutTxt$)
  1705.        CALL UpdtCalr (ZOutTxt$,2)
  1706.        RESUME NEXT
  1707. '     SHARED ROUTINE FOR GOING OFF LINE WHEN DISK FULL
  1708. 65010  CALL OpenCom(ZModemInitBaud$,",N,8,1")
  1709.        CALL TakeOffHook
  1710.        IF ZFossil THEN _
  1711.           CALL FOSExit(ZComPort)
  1712.        SYSTEM
  1713.