home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / CDOR0811.ZIP / CDORMRGS.ZIP / RSB1CDOR.MRG < prev    next >
Encoding:
Text File  |  1993-08-11  |  53.1 KB  |  1,311 lines
  1. * ------------[ BLED merge (c) Ken Goosens ]-------------
  2. * Merge this against RBBSSUB1.BAS to produce RBBSSUB1.NEW
  3. * RBBSSUB1.BAS:  Date 6-20-92  Size 55569 bytes
  4. * ------------[ Created 08-11-1993 19:34:20 ]------------
  5. * REPLACING old line(s) by new
  6. * ------[ first line different ]------
  7. ' $segment
  8. ' $linesize:132
  9. ' $title: 'RBBS-SUB1.BAS 17.4, Copyright 1986-92 by D. Thomas Mack'
  10. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  11. '  Name ...............: RBBSSUB1.BAS
  12. '  First Released .....: June 21, 1992
  13. '  Subsequent Releases.: 
  14. '  Copyright ..........: 1986-1992
  15. '  Purpose.............:
  16. '     Subprorams that require error trapping are incorporated
  17. '     within RBBSSUB1.BAS as separately callable subroutines
  18. '     in order to free up as much code as possible within
  19. '     the 64WasK code segment used by RBBS-PC.BAS.
  20. '  Parameters..........: Most parameters are passed via a COMMON statement.
  21. '
  22. ' Subroutine  Line               Function of Subroutine
  23. '   Name     Number
  24. '  ChangeDir   20101   Change subdirectory
  25. '  CheckInt    58360   Check input is valid integer
  26. '  CommPut     59275   Write string to communications port
  27. '  FindFile    59790   Determine whether a file exists without opening it
  28. '  FindFree    51098   Find amount of space on the upload disk drive
  29. '  FindItX     20219   Find if a file exists on a device
  30. '  FindUser    12598   Find a user in the USERS file
  31. '  FlushCom    20308   Read all characters in the communications port
  32. '  GetCom       1418   Read a character from the communications port
  33. '  GetPassword 58280   Read RBBS-PC's "PASSWORD" file
  34. '  GETWRK      58330   Read record from file number 2
  35. '  KillWork    58258   Delete a RBBS-PC "WORK" file
  36. '  NetBIOS     20898   Lock/Unlock NetBIOS semaphore files
  37. '  OpenCom       200   Open communications port (number 3)
  38. '  OpenFMS     58188   Open the upload management system directory
  39. '  OpenOutW    28218   Open RBBS-PC's "WORK" file (number 2) for output
  40. '  OpenRSeq     1479   Open a sequential file (number 2) for random I/O
  41. '  OpenUser     9398   Open the USER file (number 5)
  42. '  OpenWork    57978   Open RBBS-PC's work file (number 2)
  43. '  OpenWorkA   58340   Open RBBS-PC's "WORK" file (number 2) for append
  44. '  Printit     13673   Print line on the local PC printer
  45. '  PrintWork   58320   Print string to file #2 w/o CR/LF
  46. '  PrintWorkA  58350   Print string to file #2 with CR/LF
  47. '  PutCom      59650   Write to the communications port
  48. '  PutWork     59660   Write to work file randomly
  49. '  RBBSPlay    59680   Plays a musical string
  50. '  ReadAny     58310   Read file number 2 into ZOutTxt$
  51. '  ReadDef       112   Read configuration file
  52. '  ReadDir     58290   Read entire lines
  53. '  ReadParmsX  58300   Read certain number of parameters from specified file
  54. '  Talk        59700   RBBS-PC Voice synthesizer support for sight impaired
  55. '  SetCall       108   Find where next callers record is
  56. '  UpdateC     43048   Update the caller's file with elasped session time
  57. '  UpdtCalr    13661   Update to the caller's file                   ' Mpl090202
  58. '
  59. '  $INCLUDE: 'RBBS-VAR.BAS'
  60. '
  61. * REPLACING old line(s) by new
  62. 108 ' $SUBTITLE: 'SetCall - subroutine to find last callers rec'
  63. ' $PAGE
  64. '
  65. '  NAME    -- SetCall
  66. '
  67. '  INPUTS  --     PARAMETER                    MEANING
  68. '
  69. '  OUTPUTS --  ZCallersFileIndex!
  70. '
  71. '  PURPOSE --  To find where to leave off on callers file
  72. '
  73.     SUB SetCall STATIC
  74.     ON ERROR GOTO 65000
  75.     IF ZPrevCaller$ = ZCallersFile$ OR ZCallersFilePrefix$ = "" THEN _
  76.        EXIT SUB
  77.     ZPrevCaller$ = ZCallersFile$
  78.     ZCallersFileIndex! = 1
  79.     CLOSE 2
  80.     CLOSE 4
  81. * ------[ first line different ]------
  82.     CLOSE 16                                                         ' DD050701
  83.     IF ZWriteCallersTxt THEN                                         ' DD050701
  84.        CALL BreakFileName (ZCallersFile$,Drive$,Body$,Ext$,ZTrue)    ' DD050701
  85.        CALL OpenWorkA (16,Drive$ + Body$ + ".TXT")                   ' DD050701
  86.     END IF                                                           ' DD050701
  87.     IF ZShareIt THEN _
  88.        OPEN ZCallersFile$ FOR RANDOM SHARED AS #4 LEN=64 _
  89.     ELSE OPEN "R",4,ZCallersFile$,64
  90.     FIELD 4,64 AS ZCallersRecord$
  91.     IF LOF(4) > 0 THEN _
  92.        ZCallersFileIndex! = LOF(4) / 64
  93.     IF ZCallersFileIndex! < 1 THEN _
  94.        ZCallersFileIndex! = 0
  95.     ZUserIn$ = STRING$(13,0)
  96. * REPLACING old line(s) by new
  97. 117 IF ZSubParm <> -62 THEN _
  98.        IF PrevRead$ = ConfigFile$ THEN _
  99.           EXIT SUB _
  100.        ELSE PrevRead$ = ConfigFile$
  101.     CLOSE 2
  102.     ZBulletinSave$ = ZBulletinMenu$
  103.     CALL OpenWork (2,ConfigFile$)
  104.     ZCurDef$ = ConfigFile$
  105.     INPUT #2,ZWasDF$, _
  106.              ZDnldDrives$, _
  107.              ZSysopPswd1$, _
  108.              ZSysopPswd2$, _
  109.              ZSysopFirstName$, _
  110.              ZSysopLastName$, _
  111.              ZRequiredRings, _
  112.              ZStartOfficeHours, _
  113.              ZEndOfficeHours, _
  114.              ZMinsPerSession, _
  115.              ZWasDF, _
  116.              ZWasDF, _
  117.              ZUpldDir$, _
  118. * ------[ first line different ]------
  119.              ZSkipMailCheck, _                                       ' Mpl122301
  120.              ZActiveBulletins, _
  121.              ZPromptBellDef                                          ' DD021903/VGA
  122.     IF ZConfMode OR ZSubBoard THEN                                   ' DD021903/VGA
  123.        INPUT #2, ZWasDF                                              ' DD021903/VGA
  124.     ELSE
  125.        INPUT #2, ZLocalPageLength                                    ' DD021903/VGA
  126.        IF ZLocalPageLength < 25 THEN                                 ' DD021903/VGA
  127.           ZLocalPageLength = 25                                      ' DD021903/VGA
  128.        END IF
  129.     END IF
  130.     INPUT #2, ZMenusCanPause, _                                      ' DD021903/VGA
  131.              ZMenu$(1), _
  132.              ZMenu$(2), _
  133.              ZMenu$(3), _
  134.              ZMenu$(4), _
  135.              ZMenu$(5), _
  136.              ZMenu$(6), _
  137.              ZConfMenu$, _
  138.              ZTestANSITime, _
  139.              ZWelcomeInterruptable, _
  140.              ZShowAllWhosOn, _        'was ZRemindFileXfers          ' DD052001
  141.              ZPageLengthDef, _
  142.              ZMaxMsgLinesDef, _
  143.              ZDoorsAvail, _
  144.              ZWasDF$, _
  145.              ZMainMsgFile$, _
  146.              ZMainMsgBackup$
  147.     INPUT #2, WasX$, _
  148.               ZCmntsFile$, _
  149.               ZMainUserFile$, _
  150.               ZWelcomeFile$, _
  151.               ZNewUserFile$, _
  152.               ZMainDirExtension$
  153.     CALL BreakFileName (WasX$,ZWasY$,ZWasDF$,ZWasZ$,ZFalse)
  154.     IF ZWasDF$ <> "" THEN _
  155.        ZCallersFile$ = WasX$
  156.     CALL BreakFileName (ZOrigCallers$,OrigDrive$,OrigBody$,OrigExt$,ZTrue) ' DD042001
  157.     CALL BreakFileName (ZCallersFile$,CallersDrive$,CallersBody$,CallersExt$,ZTrue) ' DD042001
  158.     IF OrigDrive$ <> CallersDrive$ AND ZOrigCallers$ <> "" THEN      ' DD042001
  159.        ZCallersFile$ = OrigDrive$ + CallersBody$ + CallersExt$       ' DD042001
  160.     END IF                                                           ' DD042001
  161.     INPUT #2, ZWasDF$
  162.     IF ZComPort$ <> "COM0" THEN _
  163.        IF NOT ZConfMode THEN _
  164.           ZComPort$ = ZWasDF$
  165.     INPUT #2, ZBulletinsOptional, _
  166.               ZModemInitCmd$, _
  167.               ZRTS$, _
  168.               ZCallersLst$, _
  169.               ZFG, _
  170.               ZBG, _
  171.               ZBorder
  172.     IF ZConfMode THEN _
  173.        INPUT #2, ZWasDF$, _
  174.                  ZWasDF$ _
  175.     ELSE INPUT #2, ZRBBSBat$ , _
  176.                    ZRCTTYBat$
  177.     INPUT #2,ZOmitMainDir$, _
  178.              ZFirstNamePrompt$, _
  179.              ZHelp$(3), _
  180.              ZHelp$(4), _
  181.              ZHelp$(7), _
  182.              ZHelp$(9), _
  183.              ZBulletinMenu$, _
  184.              ZBulletinPrefix$, _
  185.              ZWasDF$, _
  186.              ZMsgReminder, _
  187.              ZRequireNonASCII, _
  188.              ZAskExtendedDesc, _
  189.              ZMaxNodes                                               ' KG100701
  190.     IF ZConfMode THEN _                                              ' KG100701
  191.        INPUT #2, ZwasDF _                                            ' DD052301
  192.     ELSE INPUT #2, ZNetworkType                                      ' DD052301
  193.     INPUT #2,ZUpdateOnline, _                                        ' DD052301
  194.              ZWasDF, _
  195.              ZWasDF, _
  196.              ZTrashcanFile$
  197.     INPUT #2,ZMinLogonSec, _
  198.              ZDefaultSecLevel, _
  199.              ZSysopSecLevel, _
  200.              ZFileSecFile$, _
  201.              ZSysopMenuSecLevel, _
  202.              ZConfMailList$, _
  203.              ZMaxViolations, _
  204.              ZOptSec(50), _   ' SECURITY FOR SYSOP COMMANDS 1
  205.              ZOptSec(51), _
  206.              ZOptSec(52), _
  207.              ZOptSec(53), _
  208.              ZOptSec(54), _
  209.              ZOptSec(55), _
  210.              ZOptSec(56), _   ' SYSOP 7
  211.              ZOptSec(57), _                                          ' DD020602/SFILE
  212.              ZPswdFile$, _
  213.              ZMaxPswdChanges, _
  214.              ZMinSecForTempPswd, _
  215.              ZOverWriteSecLevel, _
  216.              ZDoorsTermType, _
  217.              ZMaxPerDay
  218.     INPUT #2,ZOptSec(1), _   ' SECURITY FOR MAIN MENU COMMANDS 1
  219.              ZOptSec(2), _
  220.              ZOptSec(3), _
  221.              ZOptSec(4), _
  222.              ZOptSec(5), _
  223.              ZOptSec(6), _
  224.              ZOptSec(7), _
  225.              ZOptSec(8), _
  226.              ZOptSec(9), _
  227.              ZOptSec(10), _
  228.              ZOptSec(11), _
  229.              ZOptSec(12), _
  230.              ZOptSec(13), _
  231.              ZOptSec(14), _
  232.              ZOptSec(15), _
  233.              ZOptSec(16), _
  234.              ZOptSec(17), _
  235.              ZOptSec(18), _   ' MAIN COMMAND 18
  236.              ZMinNewCallerBaud, _
  237.              ZWaitBeforeDisconnect
  238.     INPUT #2,ZOptSec(19), _      ' Security for FILE COMMANDS 1
  239.              ZOptSec(20), _
  240.              ZOptSec(21), _
  241.              ZOptSec(22), _
  242.              ZOptSec(23), _
  243.              ZOptSec(24), _
  244.              ZOptSec(25), _
  245.              ZOptSec(26), _      ' FILE COMMAND 8
  246.              ZOptSec(27), _      ' SECURITY FOR UTILITY COMMANDS 1 'bank time
  247.              ZOptSec(28), _                                        'whodidit
  248.              ZOptSec(29), _
  249.              ZOptSec(30), _
  250.              ZOptSec(31), _
  251.              ZOptSec(32), _
  252.              ZOptSec(33), _
  253.              ZOptSec(34), _
  254.              ZOptSec(35), _
  255.              ZOptSec(36), _
  256.              ZOptSec(37), _
  257.              ZOptSec(38), _   ' UTIL COMMAND 12
  258.              ZOptSec(46), _   ' SECURITY FOR GLOBAL COMMANDS 1
  259.              ZOptSec(47), _
  260.              ZOptSec(48), _
  261.              ZOptSec(49), _
  262.              ZUpldTimeFactor!, _
  263.              ZShowTimesDownloaded, _     'was ZComputerType          ' DD052301
  264.              ZRemindProfile, _
  265.              ZRBBSName$, _
  266.              ZCmdsBetweenRings, _
  267.              ZCopyrightSecs, _
  268.              ZPagingPtrSupport$
  269.     IF ZConfMode THEN _
  270.          INPUT #2, ZwasDF$ _                                         'Pe 04/14/92
  271.     ELSE INPUT #2, ZModemInitBaud$
  272.              IF ZErrCode > 0 THEN _
  273.                 EXIT SUB
  274. * REPLACING old line(s) by new
  275. 118 INPUT #2, ZTurnPrinterOff,_    ' Turn printer off each recycle
  276.               ZDirPath$, _    ' Where dir files are stored
  277.               ZMinSecToView, _
  278.               ZLimitSearchToFMS, _
  279.               ZDefaultCatCode$, _
  280.               ZDirCatFile$, _
  281.               ZNewFilesCheck, _
  282.               ZMaxDescLen, _
  283.               ZShowSection, _
  284.               ZCmndsInPrompt, _
  285.               ZNewUserSetsDefaults, _
  286.               ZHelpPath$, _
  287.               ZHelpExtension$, _
  288.               ZMainCmds$, _
  289.               ZFileCmd$, _
  290.               ZUtilCmds$, _
  291.               ZGlobalCmnds$, _
  292.               ZSysopCmds$
  293.     INPUT #2, ZRecycleWait, _
  294.               ZOptSec(39), _       ' SECURITY FOR Library COMMANDS 1
  295.               ZOptSec(40), _
  296.               ZOptSec(41), _
  297.               ZOptSec(42), _
  298.               ZOptSec(43), _
  299.               ZOptSec(44), _
  300.               ZOptSec(45), _       ' Library COMMANDS 7
  301.               ZLibDrive$, _
  302. * ------[ first line different ]------
  303.               ZWasDF$, _            'was ZLibDirPath$                ' DD071001
  304.               ZWasDF$, _            'was ZLibDirExtension$           ' DD071001
  305.               ZLibWorkDiskPath$, _
  306.               ZWasDF, _             'was ZLibMaxDisk                 ' DD071001
  307.               ZWasDF, _             'was ZLibMaxDir                  ' DD071001
  308.               ZWasDF, _             'was ZLibMaxSubdir               ' DD071001
  309.               ZWasDF$, _            'was ZLibSubdirPrefix$           ' DD071001
  310.               ZWasDF$, _            'was ZLibArcPath$                ' DD071001
  311.               ZDR5Def$, _           'was ZLibArcProgram$             ' DD070203
  312.               ZLibCmds$
  313. '
  314. ' *****  ESTABLISH COMMUNICATION PORT REGISTERS AND COMMANDS   ***
  315. ' *****     GET DOS SUB-DIRECTORY RBBS-PC OPTIONS              ***
  316. '
  317.     INPUT #2, ZUpldPath$, _              ' Where upl dir goes
  318.               ZMainFMSDir$, _       ' Shared dir in FMS
  319.               ZAnsMenu$, _
  320.               ZReqQues$,_
  321.               ZRememberNewUsers,_
  322.               ZSurviveNoUserRoom,_
  323.               ZPromptHash$,_
  324.               ZStartHash,_
  325.               ZLenHash,_
  326.               ZPromptIndiv$,_
  327.               ZStartIndiv,_
  328.               ZLenIndiv
  329.     INPUT #2, ZBypassMsgs, _
  330.               ZDontShowLogOff, _              'was ZMusic            ' DD062806
  331.               ZRestrictByDate, _
  332.               ZDaysToWarn, _
  333.               ZDaysInRegPeriod, _
  334.               ZVoiceType, _
  335.               ZRestrictValidCmds, _
  336.               ZMinSecPersUpld, _
  337.               ZDistriHelp$, _
  338.               ZDistriPath$, _
  339.               ZFastFileList$, _
  340.               ZFastFileLocator$, _
  341.               ZMsgsCanGrow, _
  342.               ZWrapCallersFile$, _
  343.               ZRedirectIOMethod, _
  344.               ZAutoUpgradeSec, _
  345.               ZHaltOnError, _
  346.               ZNewPublicMsgsSec, _
  347.               ZNewPrivateMsgsSec, _
  348.               SecNeededToChangeMsgs, _
  349.               ZSLCategorizeUplds, _
  350.               ZNoQuoting, _
  351.               ZHourMinToDropToDos, _
  352.               ZExpiredSec, _
  353.               ZDTRDropDelay, _
  354.               ZShowXferTime, _                   'was ZAskID         ' DD052301
  355.               ZMaxRegSec, _
  356.               ZBufferSize, _
  357.               ZMLCom, _
  358.               ZNoDoorProtect, _
  359.               ZDefaultExtension$, _
  360.               ZEnableCC, _
  361.               ZMaxBank, _
  362.               ZNetMail$, _
  363.               ZMasterDirName$, _
  364.               ZWasDF$, _
  365.               ZUpcatHelp$, _
  366.               ZAllwaysStrewTo$, _
  367.               ZLastNamePrompt$
  368.     IF ZWasDF$ <> "" THEN _
  369.        ZProtoDef$ = ZWasDF$
  370. * REPLACING old line(s) by new
  371. 119 INPUT #2, ZPersonalDrvPath$, _
  372.               ZPersonalDir$, _
  373.               ZPersonalBegin, _
  374.               ZPersonalLen, _
  375.               ZPersonalProtocol$, _
  376.               ZPersonalConcat , _
  377.               ZPrivateReadSec, _
  378.               ZPublicReadSec, _
  379.               ZSecChangeMsg
  380.     IF ZConfMode THEN _
  381.          INPUT #2, ZwasDF _
  382.     ELSE INPUT #2, ZKeepInitBaud
  383.     INPUT #2, ZMainPUI$
  384.     IF ZConfMode THEN _
  385.        INPUT #2, ZWasDF$,ZWasDF$,ZWasDF$ _
  386.     ELSE INPUT #2, ZDefaultEchoer$, _
  387.                    ZHostEchoOn$, _
  388.                    ZHostEchoOff$
  389.     INPUT #2, ZSwitchBack, _
  390.               ZDefaultLineACK$, _
  391.               ZAltdirExtension$, _
  392.               ZDirPrefix$
  393.     IF ZConfMode THEN _
  394.        INPUT #2, ZWasDF, _
  395.                  ZWasDF, _
  396.                  ZWasDF _
  397.     ELSE INPUT #2, ZWasDF,_
  398.                    ZModemInitWaitTime, _
  399.                    ZModemCmdDelayTime
  400. * ------[ first line different ]------
  401.     INPUT #2, ZNewsInterruptable, _             'was ZTurboRBBS      ' DD051001
  402.               ZSubDirCount, _
  403.               ZWasDF, _
  404.               ZUpldToSubdir, _
  405.               ZWasDF, _
  406.               ZUpldSubdir$, _
  407.               ZMinOldCallerBaud, _
  408.               ZMaxWorkVar, _
  409.               ZDiskFullGoOffline, _
  410.               ZExtendedLogging
  411.      IF ZConfMode THEN _
  412.         INPUT #2, ZWasDF$, _
  413.                   ZWasDF$, _
  414.                   ZWasDF$, _
  415.                   ZWasDF$ _
  416.      ELSE INPUT #2, ZModemResetCmd$, _
  417.                     ZModemCountRingsCmd$, _
  418.                     ZModemAnswerCmd$, _
  419.                     ZModemGoOffHookCmd$
  420.      INPUT #2,ZDiskForDos$, _
  421.               ZDumbModem, _
  422.               ZCmntsAsMsgs
  423.      IF ZConfMode THEN _
  424.         INPUT #2, ZWasDF, _
  425.                   ZWasDF, _
  426.                   ZWasDF, _
  427.                   ZWasDF, _
  428.                   ZWasDF, _
  429.                   ZWasDF _
  430.      ELSE INPUT #2, ZLSB,_
  431.                     ZMSB,_
  432.                     ZLineCntlReg,_
  433.                     ZModemCntlReg,_
  434.                     ZLineStatusReg,_
  435.                     ZModemStatusReg
  436.      INPUT #2,ZKeepTimeCredits, _
  437.               ZXOnXOff, _
  438.               ZAllowCallerTurbo, _
  439.               ZUseDeviceDriver$, _
  440.               ZPreLog$, _
  441.               ZNewUserQuestionnaire$, _
  442.               ZEpilog$, _
  443.               ZRegProgram$, _
  444.               ZQuesPath$, _
  445.               ZUserLocation$, _
  446.               ZWasDF$, _
  447.               ZWasDF$, _
  448.               ZWasDF$, _
  449.               ZEnforceRatios, _
  450.               ZSizeOfStack, _
  451.               ZSecExemptFromEpilog, _
  452.               ZWriteCallersTxt, _        'was ZUseBasicWrites        ' DD050701
  453.               ZDosANSI, _
  454.               ZEscapeInsecure, _
  455.               ZUseDirOrder, _
  456.               ZAddDirSecurity, _
  457.               ZMaxExtendedLines, _
  458.               ZOrigCommands$
  459.      INPUT #2,ZLogonMailLevel$, _
  460.               ZMacroDrvPath$, _
  461.               ZMacroExtension$, _
  462.               ZEmphasizeOnDef$, _
  463.               ZEmphasizeOffDef$, _
  464.               ZDR1Def$, _                                            ' DD070203
  465.               ZDR2Def$, _                                            ' DD070203
  466.               ZDR3Def$, _                                            ' DD070203
  467.               ZDR4Def$, _                                            ' DD070203
  468.               ZSecVioHelp$
  469.      IF ZConfMode THEN _
  470.         INPUT #2,ZWasDF _
  471.      ELSE INPUT #2,ZFossil
  472.      INPUT #2,ZMaxCarrierWait, _
  473.               ZWasDF, _
  474.               ZSmartTextCode, _
  475.               ZTimeLock, _
  476.               ZWriteBufDef, _
  477.               ZSecKillAny, _
  478.               ZDoorsDef$, _
  479.               ZScreenOutMsg$, _
  480.               ZAutoPageDef$, _                                       ' DD090501
  481.               ZLogUploader, _                                        ' DD090501
  482.               ZAddNameToDir                                          ' DD090501
  483.      IF ZErrCode > 0 THEN _
  484.         EXIT SUB
  485.      IF LEFT$(ZDR5Def$,1) <> CHR$(27) THEN                           ' DD070203
  486.         ZDR5Def$ = ZDR4Def$                                          ' DD070203
  487.      END IF                                                          ' DD070203
  488.      ZConfigFileName$ = ConfigFile$
  489.      CALL EditDef
  490. * INSERTING new line(s)
  491. 150  MKDIR ZlibWorkDiskPath$ + ZNodeId$                              ' Mpl090202
  492.      IF ZErrCode = 75 THEN _                                         ' Mpl090202
  493.         ZErrCode = 0                                                 ' Mpl090202
  494.      ZArkViewPath$ =  ZLibWorkDiskPath$ + ZNodeID$ + CHR$(92) '\     ' DD021301
  495.      ZChatFileName$ = ZLibDrive$ + "RBBSCHAT.DEF"                    ' DD092401/RCHAT
  496.      END SUB
  497. * REPLACING old line(s) by new
  498. 200 ' $SUBTITLE: 'OpenCom - subroutine to open the communications port'
  499. ' $PAGE
  500. '
  501. '  NAME    -- OpenCom
  502. '
  503. '  INPUTS  --     PARAMETER                    MEANING
  504. '                BaudRate$                  BAUD TO OPEN MODEM
  505. '                Parity$                    PARITY TO OPEN MODEM
  506. '
  507. '  OUTPUTS -- BaudTest!                     BAUD RATE TO SET RS232 AT
  508. '
  509. '  PURPOSE -- To open the communications port.
  510. '
  511.     SUB OpenCom (BaudRate$,Parity$) STATIC
  512.     ON ERROR GOTO 65000
  513.     IF ZFossil THEN _
  514.        IF ZRTS$ = "YES" THEN _
  515.           ZFlowControl = ZTrue : _
  516.           Flow = &H00F2 : _
  517.           CALL FosFlowCtl(ZComPort,Flow)
  518. * ------[ first line different ]------
  519.     IF INSTR(Parity$,CHR$(78)) THEN _                     'N         ' DD021301
  520.        Parity = 2 : _                                     ' No PARITY
  521.        DataBits = 3 : _                                   ' 8 DATA BITS
  522.        StopBits = 0 _                                     ' 1 STOP BIT
  523.     ELSE Parity = 3 : _                                   ' EVEN PARITY
  524.          DataBits = 2 : _                                 ' 7 DATA BITS
  525.          StopBits = 0                                     ' 1 STOP BIT
  526.     IF NOT ZFossil THEN _
  527.        GOTO 202
  528.     IF Baudrate$ = "38400" THEN _
  529.        ComSpeed = &H9600 _
  530.     ELSE ComSpeed = VAL(BaudRate$)
  531.     CALL FosSpeed(ZComPort,ComSpeed,Parity,DataBits,StopBits)
  532.     EXIT SUB
  533. * REPLACING old line(s) by new
  534. 202 CLOSE 3
  535.     IF ZRTS$ = "YES" THEN _
  536.        ZFlowControl = ZTrue : _
  537. * ------[ first line different ]------
  538.        WasX$ = ",TB1024,CS26600,CD,DS" _                             ' DD012802
  539.     ELSE WasX$ = ",RS,CD,DS"
  540.     WasX = (VAL(BaudRate$) > 19200)
  541.     IF WasX THEN _
  542.        ZWasY$ = "19200" _
  543.     ELSE ZWasY$ = BaudRate$
  544.     OPEN ZComPort$ + CHR$(58) + ZWasY$ + Parity$ + WasX$ AS #3       ' DD021301
  545. '
  546. ' ****************************************************************************
  547. ' *  RAISE THE RTS SIGNAL IF THE MODEM USES RTS FOR MODEM FLOW CONTROL (ONCE
  548. ' *  IT IS RAISED, IT WILL STAY UP UNTIL THE REGISTER IS CLEARED OUT).
  549. ' ****************************************************************************
  550. '
  551.     END SUB
  552. * REPLACING old line(s) by new
  553. 1479 ' $SUBTITLE: 'OpenRSeq  - open sequential file randomly'
  554. ' $PAGE
  555. '
  556. '  NAME    -- OpenRSeq
  557. '
  558. '  INPUTS  -- PARAMETER             MEANING
  559. * ------[ first line different ]------
  560. '             FilName$      NAME OF SEQUENTIAL FILE TO OPEN          ' DD031703
  561. '             RecLen        Length of a record
  562. '             FileNum       File Number to open file as              ' DD031703
  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 (FileNum,FilName$,NumRecs,LenLastRec,RecLen) STATIC ' DD031703
  571.      ON ERROR GOTO 65000
  572.      CALL OpenRand2 (FileNum,FilName$,RecLen)                        ' DD031703
  573.      IF ZErrCode > 0 THEN _
  574.         EXIT SUB
  575.      FIELD #FileNum, RecLen AS ZDnldRecord$                          ' DD031703
  576.      WasI# = LOF(FileNum)                                            ' DD031703
  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. * REPLACING old line(s) by new
  584. * ------[ first line different ]------
  585. 1486 SUB OpenRand2 (FileNum,FileToOpen$, FileLen) STATIC             ' DD031703
  586.      ON ERROR GOTO 65000
  587.      CLOSE FileNum                                                   ' DD031703
  588. * REPLACING old line(s) by new
  589. 1487 ZErrCode = 0
  590.      IF ZShareIt THEN _
  591. * ------[ first line different ]------
  592.         OPEN FileToOpen$ FOR RANDOM SHARED AS #FileNum LEN=FileLen _ ' DD031703
  593.      ELSE OPEN "R",FileNum,FileToOpen$,FileLen                       ' DD031703
  594.      END SUB
  595. * REPLACING old line(s) by new
  596. 9400 CLOSE 5
  597.      IF ZShareIt THEN _
  598.         OPEN ZActiveUserFile$ FOR RANDOM SHARED AS #5 LEN=128 _
  599.      ELSE OPEN "R",5,ZActiveUserFile$,128
  600.      WasI# = LOF(5)
  601.      LastRec = FIX(WasI#/128)
  602.      FIELD 5,31 AS ZUserName$, _
  603.              15 AS ZPswd$, _
  604.               2 AS ZSecLevel$, _
  605.              14 AS ZUserOption$,  _
  606.              24 AS ZCityState$, _
  607. * ------[ first line different ]------
  608.               1 AS MachineType$, _                                   ' DD091401/DROP
  609.               1 AS ZDropTimes$, _                                    ' DD091401/DROP
  610.               1 AS ZBankTime$,_
  611.               4 AS ZTodayDl$, _
  612.               4 AS ZTodayBytes$, _
  613.               4 AS ZDlBytes$, _
  614.               4 AS ZULBytes$, _
  615.              14 AS ZLastDateTimeOn$, _
  616.               3 AS ZListNewDate$, _
  617.               2 AS ZUserDnlds$, _
  618.               2 AS ZUserUplds$, _
  619.               2 AS ZElapsedTime$
  620.      FIELD 5,128 AS ZUserRecord$
  621.      END SUB
  622. * REPLACING old line(s) by new
  623. 13661 ' $SUBTITLE: 'UpdtCalr - subroutine to write to CALLERS file'
  624. ' $PAGE
  625. '
  626. '  NAME    -- UpdtCalr
  627. '
  628. '  INPUTS  --     PARAMETER                    MEANING
  629. '                 ErrMsg$                   MESSAGE TO GO IN CALLER LOG
  630. '                 EXTLog               = 1  CHECK FOR EXTENDED LOGGING
  631. '                                           BEFORE UPDATING.
  632. '                                      = 2  UPDATE CALLER LOG WITH ZWasZ$
  633. '                                      = 3  Time stamp before logging
  634. '
  635. '  OUTPUTS -- ZCurDate$           CURRENT DATE (MM-DD-YY)
  636. '             ZTime$                    CURRENT TIME (I.E. 1:13 PM)
  637. '             TIME.LOGGEND.ON$        TIME USER LOGGED ON (HH:MM:SS)
  638. '
  639. '  PURPOSE -- To update the caller's file and/or print on the
  640. '             local printer if it is enabled
  641. '
  642.       SUB UpdtCalr (ErrMsg$,EXTLog) STATIC
  643.       ON ERROR GOTO 65000
  644. * ------[ first line different ]------
  645. '     IF ZCallersFilePrefix$ = "" OR (ZLocalUser AND ZSysop) THEN _  ' DD021501
  646. '        EXIT SUB                                                    ' DD021501
  647.       IF ZCallersFilePrefix$ = "" THEN _                             ' DD021501
  648.          EXIT SUB
  649.       WasX$ = SPACE$(5) + ErrMsg$                                    ' DD021301
  650. * REPLACING old line(s) by new
  651. 13672 PUT 4,ZCallersFileIndex!
  652. * ------[ first line different ]------
  653.       IF NOT ZWriteCallersTxt THEN                                   ' DD050701
  654.          EXIT SUB                                                    ' DD050701
  655.       END IF                                                         ' DD050701
  656.       CALL Trim (WasX$)                                              ' DD050701
  657.       IF INSTR(WasX$,ZActiveUserName$ + " PW fail") <> 0 OR _        ' DD050701
  658.          INSTR(WasX$,"Name/Address") <> 0 OR _                       ' DD052103
  659.          INSTR(WasX$,"didn't register") <> 0 OR _                    ' DD052103
  660.          ZActiveUserName$ = "" THEN                                  ' DD050701
  661.          EXIT SUB                                                    ' DD050701
  662.       END IF                                                         ' DD050701
  663.       IF INSTR(WasX$,ZActiveUserName$ + " from") <> 0 THEN           ' DD050701
  664.          PRINT #16, STRING$(79,"=")                                  ' DD051402
  665.          DontPrintTxt = ZFalse                                       ' DD041402
  666.       ELSE                                                           ' DD050701
  667.          IF INSTR(WasX$,"Logged off") = 0 AND _                      ' DD050903
  668.             INSTR(WasX$,"Auto-logoff") = 0 AND _                     ' DD050903
  669.             INSTR(WasX$,"Carrier dropped") = 0 AND _                 ' DD050903
  670.             INSTR(WasX$,"Sleep disconnect") = 0 THEN                 ' DD050903
  671.             WasX$ = SPACE$(5) + "* " + WasX$                         ' DD050701
  672.          ELSE                                                        ' DD051402
  673.             PRINT #16, WasX$                                         ' DD051402
  674.             DontPrintTxt = ZTrue                                     ' DD051402
  675.          END IF                                                      ' DD050903
  676.       END IF                                                         ' DD050701
  677.       IF DontPrintTxt = ZFalse THEN                                  ' DD051402
  678.          PRINT #16, WasX$                                            ' DD050701
  679.       END IF                                                         ' DD051402
  680.       END SUB
  681. * REPLACING old line(s) by new
  682. 13674 IF ZPrinter THEN _
  683.          LPRINT Strng$
  684.       END SUB
  685. * ------[ first line different ]------
  686. '20101 ' $SUBTITLE: 'ChangeDir - subroutine to change subdirectories' ' DD062304
  687. ' $PAGE
  688. '
  689. '  NAME    -- ChangeDir
  690. '
  691. '  INPUTS  -- PARAMETER                    MEANING
  692. '             NewDir$                      NAME OF SUBDIRECTORY
  693. '
  694. '  OUTPUTS -- ZOK                           TRUE IF CHDIR SUCCESSFUL
  695. '             ZErrCode                      ERROR CODE
  696. '
  697. '  PURPOSE -- Change subdirectory
  698. '
  699. '     SUB ChangeDir (NewDir$) STATIC                                 ' DD062304
  700. '     ON ERROR GOTO 65000                                            ' DD062304
  701. '     ZErrCode = 0                                                   ' DD062304
  702. '     ZOK = ZTrue                                                    ' DD062304
  703. '20103 CHDIR NewDir$                                                 ' DD062304
  704. '     END SUB                                                        ' DD062304
  705. * DELETING old line(s)
  706. 20101
  707. 20103
  708. * REPLACING old line(s) by new
  709. 20219 ' $SUBTITLE: 'FINDITX - subroutine to find if a file exists'
  710. ' $PAGE
  711. '
  712. '  NAME    -- FINDITX
  713. '
  714. '  INPUTS  -- PARAMETER                    MEANING
  715. '             FilName$                 NAME OF FILE TO FIND
  716. '             FileNum                  # TO OPEN FILE AS
  717. '
  718. '  OUTPUTS -- ZOK                      TRUE IF FILE EXISTS
  719. '             ZErrCode                 ERROR CODE
  720. '
  721. '  PURPOSE -- Determine whether a file exists
  722. '
  723. * ------[ first line different ]------
  724. * REPLACING old line(s) by new
  725. * ------[ first line different ]------
  726. 20221 SUB FindItX (FilName$,FileNum) STATIC
  727.       ON ERROR GOTO 65000
  728.       ZErrCode = 0
  729.       ZOK = ZFalse
  730.       IF LEN(FilName$) < 1 THEN _
  731.          EXIT SUB
  732.       CALL FindFile (FilName$,ZOK)                                   ' DD051001
  733.       IF ZOK THEN                                                    ' DD051001
  734.          CLOSE FileNum                                               ' DD051001
  735.          CALL OpenWork (FileNum,FilName$)                            ' DD051001
  736.          IF ZErrCode = 64 OR ZErrCode = 76 THEN                      ' DD051001
  737.             ZOK = ZFalse                                             ' DD051001
  738.             EXIT SUB                                                 ' DD051001
  739.          END IF                                                      ' DD051001
  740.       ELSE                                                           ' DD051001
  741.          EXIT SUB                                                    ' DD051001
  742.       END IF                                                         ' DD051001
  743.       END SUB
  744. '
  745. * DELETING old line(s)
  746. 20222
  747. 20223
  748. * REPLACING old line(s) by new
  749. 51098 ' $SUBTITLE: 'FindFree - subroutine to find space on a device'
  750. ' $PAGE
  751. '
  752. '  NAME    -- FindFree
  753. '
  754. '  INPUTS  --     PARAMETER                    MEANING
  755. '                 ZWasZ$                       NAME OF FILE TO FIND
  756. '
  757. '  OUTPUTS -- ZFreeSpace$                      NUMBER OF BYTES FREE
  758. * ------[ first line different ]------
  759. '  OUTPUTS -- ZFreeSpaceK$                     NUMBER OF K-BYTES FREE
  760. '  OUTPUTS -- ZFreeSpaceM$                     NUMBER OF M-BYTES FREE
  761. '
  762. '  PURPOSE -- To determine amount of free space on a device
  763. '
  764.       SUB FindFree STATIC
  765.       ON ERROR GOTO 65000
  766.       ZErrCode = 0
  767. * REPLACING old line(s) by new
  768. * ------[ first line different ]------
  769. 52000 WasAX = 0                                                      ' DD051001
  770.       WasBX = 0
  771.       WasCX = 0
  772.       WasDX = 0
  773.       IF MID$(ZWasZ$,2,1) = CHR$(58) THEN _               ':         ' DD021301
  774.          WasAX = ASC(ZWasZ$) - ASC("A") + 1
  775.       CALL RBBSFree (WasAX,WasBX,WasCX,WasDX)
  776.       WasI# = CDBL(WasAX) * (WasBX + 65536! * (-(WasBX < 0)))
  777.       WasI# = WasI# * WasCX
  778.       WasK# = CDBL(WasI# / 1000!)                                    ' DD090901
  779.       WasM# = CDBL(WasI# / 1000000!)                                 ' DD090901
  780.       ZFreeSpaceK$ = STR$(WasK#)                                     ' DD090901
  781.       ZFreeSpaceK$ = LEFT$(ZFreeSpaceK$,INSTR(ZFreeSpaceK$,CHR$(46)) - 1) ' DD021301
  782.       ZFreeSpaceK$ = ZFreeSpaceK$ + CHR$(75)          'K             ' DD021301
  783.       ZFreeSpaceM$ = STR$(WasM#)                                     ' DD090901
  784.       ZFreeSpaceM$ = LEFT$(ZFreeSpaceM$,INSTR(ZFreeSpaceM$,CHR$(46)) - 1) ' DD021301
  785.       ZFreeSpaceM$ = ZFreeSpaceM$ + CHR$(77)          'M             ' DD021301
  786.       ZFreeSpace$ = STR$(WasI#) + _
  787.                     " bytes"                                         ' DD080202
  788.       END SUB
  789. * DELETING old line(s)
  790. 52001
  791. 52002
  792. 52003
  793. * REPLACING old line(s) by new
  794. 58190 ' $SUBTITLE: 'OpenFMS - subroutine to open the FMS directory'
  795. ' $PAGE
  796. '
  797. '  NAME    -- OpenFMS
  798. '
  799. '  INPUTS  -- PARAMETER                      MEANING
  800. '             ZShareIt                DOS SHARING FLAG
  801. '             ZFMSDirectory$          NAME OF FMS DIRECTORY
  802. '
  803. '  OUTPUTS -- LastRec                NUMBER OF THE Last
  804. '                                    RECORD IN THE FILE
  805. '             CatLen                 Length of the category code
  806. '
  807. '  PURPOSE -- To open the upload directory as a random file and find
  808. '             the number of the last record in the file.
  809. '
  810.       SUB OpenFMS (LastRec,CatLen) STATIC
  811.       ON ERROR GOTO 65000
  812.       CLOSE 2
  813.       IF ZActiveFMSDir$ = "" THEN _
  814. * ------[ first line different ]------
  815.          ZActiveFMSDir$ = ZFMSDirectory$                             'Pe Lib mod
  816.       OldFile = (ZActiveFMSDir$ = PrevFMS$)
  817.       IF OldFile THEN _
  818.          GOTO 58192
  819.       CALL OpenWork (2,ZActiveFMSDir$)
  820.       CALL ReadDir (2,1)
  821.       IF ZErrCode > 0 OR LEN(ZOutTxt$) < 37 THEN _                   ' KG091002
  822.          IF ZActiveFMSDir$ = ZPersonalDir$ THEN _
  823.             ZFMSFileLength = 36 + ZMaxDescLen + _                    ' DD052301
  824.                              (5 * ZShowTimesDownloaded) + _          ' DD052301
  825.                              ZPersonalLen _                          ' DD052301
  826.          ELSE ZFMSFileLength = 38 + ZMaxDescLen _
  827.       ELSE ZFMSFileLength = LEN(ZOutTxt$) + 2
  828.       IF ZFMSFileLength < (86 - (5 * ZShowTimesDownloaded)) THEN _   ' DD052301
  829.          CalcCatLen = 3 : _                                          ' KG091002
  830.          ZMaxDescLen = ZFMSFileLength - 38 _                         ' KG091002
  831.       ELSE CalcCatLen = ZPersonalLen : _                             ' KG091002
  832.            ZMaxDescLen = ZFMSFileLength - 36 - ZPersonalLen + _      ' DD052301
  833.                          (-5 * ZShowTimesDownloaded)                 ' DD052301
  834.       CLOSE 2
  835. * REPLACING old line(s) by new
  836. 58192 ZErrCode = 0
  837.       IF ZShareIt THEN _
  838.          OPEN ZActiveFMSDir$ FOR RANDOM SHARED AS #2 LEN=ZFMSFileLength _
  839.       ELSE OPEN "R",2,ZActiveFMSDir$,ZFMSFileLength
  840. * ------[ first line different ]------
  841.       IF ZErrCode > 0 THEN                                           'Pe 02/02/90
  842.          ZerrCode = 0                                                ' Mpl090202
  843.          CALL QuickTPut1 ("Drive/path does not exist or bad name for FMS dir " + _
  844.                      ZActiveFMSDir$)                                 ' Mpl090202
  845.          CALL PutCom (ZBellRinger$)                                  ' DD070402
  846.          Call QuickTPut1 ("Error Has Occured, try again!")           ' DD070402
  847.          LastRec = 0                                                 ' Mpl090202
  848.          EXIT SUB
  849.       END IF                                                         'Pe 02/02/90
  850.       LastRec = LOF(2)/ZFMSFileLength
  851.       CatLen = CalcCatLen
  852.      IF OldFile THEN _
  853.         EXIT SUB
  854.       PrevFMS$ = ZActiveFMSDir$
  855.       FIELD 2, ZFMSFileLength AS FMSRec$
  856.       GET #2,1
  857.       ZWasA = (LEFT$(FMSRec$,4) <> "\FMS")
  858.       ZUpInc = 2*(INSTR(FMSRec$," TOP ") = 0 OR ZWasA) + 1
  859.       ZDateOrderedFMS = ZWasA OR (INSTR(FMSRec$," NOSORT") = 0)
  860.       ZWasDF = INSTR(FMSRec$,"CH(")
  861.       ZChainedDir$ = ""
  862.       IF ZWasDF > 0 AND (NOT ZWasA) THEN _
  863.          WasX = INSTR(ZWasDF,FMSRec$,CHR$(41)) : _       ')          ' DD021301
  864.          IF WasX > 0 THEN _
  865.             ZChainedDir$ = MID$(FMSRec$,ZWasDF+3,WasX-ZWasDF-3) : _
  866.             CALL FindFile (ZChainedDir$,ZOK) : _
  867.             IF NOT ZOK THEN _
  868.                ZChainedDir$ = ""
  869.       IF ZActiveFMSDir$ = ZPersonalDir$ THEN _
  870.          ZFileWaiting = ZFalse
  871.       ZPersonalDnld = ((ZActiveFMSDir$ = ZPersonalDir$) OR _
  872.                        (INSTR(FMSRec$," PERS") > 0 AND NOT ZWasA))
  873.       ZFreeDnld = ZPersonalDnld
  874.       IF NOT ZWasA THEN _
  875.          IF INSTR(FMSRec$," NOFREE") > 0 THEN _
  876.             ZFreeDnld = ZFalse _
  877.          ELSE IF INSTR(FMSRec$," FREE") > 0 THEN _
  878.             ZFreeDnld = ZTrue
  879.       ZListOnly = ZPersonalDnld
  880.       IF NOT ZWasA THEN _
  881.          IF INSTR(FMSRec$," LISTONLY ") > 0 THEN _
  882.             ZListOnly = ZTrue
  883.       ZExtraDnldTime = -60 * ZPersonalDnld
  884.       IF NOT ZWasA THEN _
  885.          WasX = INSTR(FMSRec$," TIMEEXTRA ")
  886.          IF WasX > 0 THEN _
  887.             CALL CheckInt (MID$(FMSRec$,WasX+10)) : _
  888.             ZExtraDnldTime = ZTestedIntValue
  889.       END SUB
  890. * REPLACING old line(s) by new
  891. 58230 IF ZShareIt THEN _
  892.          OPEN FilName$ FOR OUTPUT SHARED AS #2 _
  893.       ELSE OPEN "O",2,FilName$
  894. * ------[ first line different ]------
  895.       IF ZErrCode = 64 OR ZErrCode = 76 THEN _                       ' DD090802
  896.          ZOK = ZFalse : _                                            ' DD090802
  897.          EXIT SUB                                                    ' DD090802
  898. * REPLACING old line(s) by new
  899. 58280 ' $SUBTITLE: 'GetPassword - sub to read the "passwords" file'
  900. ' $PAGE
  901. '
  902. '  NAME    -- GetPassword
  903. '
  904. '                          PARAMETER             MEANING
  905. '  INPUTS  -- FILE # 2 OPENED
  906. '
  907. '  OUTPUTS -- ZTempPassword$
  908. '             ZTempSecLevel
  909. '             ZTempTimeAllowed
  910. '             ZTempRegPeriod
  911. '             ZTempMaxPerDay
  912. '
  913. '  PURPOSE -- To read the RBBS-PC "PASSWORDS" file
  914. '
  915.       SUB GetPassword STATIC
  916.       ON ERROR GOTO 65000
  917.       ZErrCode = 0
  918.       INPUT #2,ZTempPassword$,    ZTempSecLevel, _
  919.                ZTempTimeAllowed,  ZTempMaxPerDay, _
  920.                ZTempRegPeriod,    ZTempExpiredSec, _
  921.                ZStartTime,        ZEndTime, _
  922.                ZByteMethod,       ZRatioRestrict#, _
  923.                ZInitialCredit#,   ZTempTimeLock, _
  924. * ------[ first line different ]------
  925.                ZTempMaxBank,      ZDropCarSecChng, _                 ' DD091401/DROP
  926.                ZDropIncrement, _                                     ' DD091401/DROP
  927.                ZPswdChngReqTime, _                                   ' DD091501/PSWD
  928.                ZTurboOnFirstCall, _                                  ' DD091802/NOTURBO
  929.                ZUpldTimeFactor!                                      ' DD022002
  930. * INSERTING new line(s)
  931. 58296 SUB ReadCommentedDir (FileNum,WhichLine) STATIC                ' DD031402
  932.       WasI = 1                                                       ' DD031402
  933.       WHILE WasI <= WhichLine                                        ' DD031402
  934.          LINE INPUT #FileNum,ZExternalString$                        ' DD031402
  935.          IF LEFT$(ZExternalString$,1) = CHR$(59) THEN WasI = WasI - 1' DD021402
  936.          WasI = WasI + 1                                             ' DD031402
  937.       WEND                                                           ' DD031402
  938.       END SUB                                                        ' DD031402
  939. * REPLACING old line(s) by new
  940. 58340 ' $SUBTITLE: 'OpenWorkA - subroutine to open output work file (2)'
  941. ' $PAGE
  942. '
  943. '  NAME    -- OpenWorkA
  944. '
  945. '  INPUTS  --     PARAMETER                    MEANING
  946. '              FilName$                  NAME OF FILE TO FIND
  947. '              ZShareIt                  USE DOS' "SHARE" FACILITIES
  948. '
  949. '  OUTPUTS -- ZErrCode                        ERROR CODE
  950. '
  951. '  PURPOSE -- To open RBBS-PC's "work" file (number 2) for appended output
  952. '
  953. * ------[ first line different ]------
  954.       SUB OpenWorkA (FileNum,FilName$) STATIC                        ' DD040601
  955.       ON ERROR GOTO 65000
  956.       CLOSE FileNum                                                  ' DD060501
  957.       ZErrCode = 0
  958.       IF ZShareIt THEN _
  959.          OPEN FilName$ FOR APPEND SHARED AS #FileNum _               ' DD040601
  960.       ELSE OPEN "A",FileNum,FilName$                                 ' DD040601
  961. * REPLACING old line(s) by new
  962. 58350 ' $SUBTITLE: 'PrintWorkA - subroutine to print to file 2 with CR'
  963. ' $PAGE
  964. '
  965. '  NAME    -- PrintWorkA
  966. '
  967. '                          PARAMETER             MEANING
  968. '  INPUTS  --            FILE # 2 OPENED
  969. '                        STRING TO WRITE OUT
  970. '
  971. '  OUTPUTS -- NONE
  972. '
  973. '  PURPOSE -- To print a string to file #2 followed by a carriage return
  974. '
  975. * ------[ first line different ]------
  976.       SUB PrintWorkA (FileNum,Strng$) STATIC                         ' DD040601
  977.       ON ERROR GOTO 65000
  978.       ZErrCode = 0
  979.       PRINT #FileNum,Strng$                                          ' DD040601
  980. * REPLACING old line(s) by new
  981. 58360 ' $SUBTITLE: 'CheckInt - subroutine to check input is an integer'
  982. ' $PAGE
  983. '
  984. '  NAME    -- CheckInt
  985. '
  986. '             PARAMETER             MEANING
  987. '  INPUTS  -- Strng$         STRING TO VERIFY CAN BE AN INTEGER
  988. '
  989. '  OUTPUTS -- ZErrCode             = 0 MEANS IT IS AN INTEGER VALUE
  990. '                                 <> 0 MEANS IT IS NOT AN INTEGER VALUE
  991. '             ZTestedIntValue  Integer value of expression
  992. '
  993. '  PURPOSE -- To validate that a string represents an integer
  994. '
  995.       SUB CheckInt (Strng$) STATIC
  996.       ON ERROR GOTO 65000
  997.       ZErrCode = 0
  998.       WasX$ = Strng$
  999.       CALL Trim (WasX$)
  1000. * ------[ first line different ]------
  1001.       ZTestedIntValue = VAL(LEFT$(WasX$,INSTR(WasX$+SPACE$(1),SPACE$(1))-1)) ' DD021301
  1002. * REPLACING old line(s) by new
  1003. 59650 ' $SUBTITLE: 'PutCom -- subroutine to write to communications port'
  1004. ' $PAGE
  1005. '
  1006. '  NAME    --  PutCom
  1007. '
  1008. '  INPUTS  --   PARAMETER     MEANING
  1009. '                STRNG$      STRING TO PRINT TO COMM PORT
  1010. '              ZFlowControl  WHETHER USING CLEAR TO SEND FOR FLOW
  1011. '                            CONTROL BETWEEN THE PC AND THE MODEM
  1012. '
  1013. '  OUTPUTS --
  1014. '
  1015. '  PURPOSE -- Checks for carrier drop and flow control (xon/xoff)
  1016. '             before writing to the communications port.
  1017. '
  1018.       SUB PutCom (Strng$) STATIC
  1019.       ON ERROR GOTO 65000
  1020.       IF ZLocalUser THEN _
  1021.          EXIT SUB
  1022.       CALL CheckCarrier
  1023.       IF ZSubParm = -1 THEN _
  1024.          EXIT SUB
  1025.       IF NOT ZXOffEd THEN _
  1026.          GOTO 59652
  1027.       ZSubParm = 1
  1028.       CALL Line25
  1029.       ZWasY$ = ZXOff$
  1030. * ------[ first line different ]------
  1031.       XOffTimeout! = TIMER + ZWaitBeforeDisconnect                   ' Mpl090202
  1032.       WHILE ZWasY$ = ZXOff$ AND ZSubParm <> -1
  1033.          Char = -1
  1034.          WHILE Char = -1 AND ZSubParm <> -1
  1035.             GOSUB 59654
  1036.          WEND
  1037.          IF Char <> -1 THEN _
  1038.             CALL GetCom(ZWasY$) : _
  1039.             IF ZXOnXOff AND ZWasY$ <> ZXOn$ THEN _
  1040.                ZWasY$ = ZXOff$
  1041.       WEND
  1042.       ZXOffEd = ZFalse
  1043.       ZSubParm = 1
  1044.       CALL Line25
  1045. * REPLACING old line(s) by new
  1046. 59654 CALL EofComm (Char)
  1047.       CALL GoIdle
  1048.       CALL CheckCarrier
  1049. * ------[ first line different ]------
  1050.       CALL CheckTime(XOffTimeout!, TempElapsed!,1)
  1051.       IF ZSubParm = 2 THEN _
  1052.          ZSubParm = -1
  1053.       RETURN
  1054.       END SUB
  1055. * REPLACING old line(s) by new
  1056. 59700 ' $SUBTITLE: 'Talk -- subroutine for voice response'
  1057. ' $PAGE
  1058. '
  1059. '  NAME    -- Talk
  1060. '
  1061. '  INPUTS  --   PARAMETER     MEANING
  1062. '               ZVoiceType    TYPE OF VOICE SYNTHESIZER
  1063. '               VoiceRecord   RECORD NUMBER TO RETRIEVE
  1064. '
  1065. '  OUTPUTS --
  1066. '
  1067. '  PURPOSE -- Retrieve voice record and send to voice synthesizer
  1068. '
  1069. * ------[ first line different ]------
  1070. '     SUB Talk (VoiceRecord,StringWork$) STATIC                      ' DD060401
  1071. '     IF ZVoiceType = 0 THEN _                                       ' DD060401
  1072. '        EXIT SUB                                                    ' DD060401
  1073. '     IF VoiceRecord > 0 THEN _                                      ' DD060401
  1074. '        GOTO 59720                                                  ' DD060401
  1075. '     CLOSE 9,8                                                      ' DD060401
  1076. '     IF ZVoiceType = 1 THEN _                                       ' DD060401
  1077. '        OPEN "COM2:2400,E,7,1,CS65535" AS #9 : _                    ' DD060401
  1078. '        LPRINT "OPENED COM PORT"                                    ' DD060401
  1079. '     IF ZShareIt THEN _                                             ' DD060401
  1080. '        OPEN "RBBSTALK.DEF" FOR RANDOM SHARED AS #8 LEN=32 _        ' DD060401
  1081. '     ELSE OPEN "R",8,"RBBSTALK.DEF",32                              ' DD060401
  1082. '     FIELD 8,30 AS TalkRecord$,2 AS Dummy$                          ' DD060401
  1083. '     EXIT SUB                                                       ' DD060401
  1084. '59720 IF NOT ZSnoop THEN _                                          ' DD060401
  1085. '        EXIT SUB                                                    ' DD060401
  1086. '     IF VoiceRecord < 65 THEN _                                     ' DD060401
  1087. '        GET 8,VoiceRecord : _                                       ' DD060401
  1088. '        StringWork$ = TalkRecord$ : _                               ' DD060401
  1089. '        CALL Trim (StringWork$)                                     ' DD060401
  1090. '59721 IF ZSmartTextCode THEN _                                      ' DD060401
  1091. '        CALL SmartText (StringWork$, CRFound,ZFalse)                ' DD060401
  1092. '59722 IF ZVoiceType = 1 THEN _                                      ' DD060401
  1093. '        PRINT #9,StringWork$                                        ' DD060401
  1094. '59723 IF ZVoiceType = 2 THEN _                                      ' DD060401
  1095. '        CALL RBBSHS (CHR$(LEN(StringWork$)+1)+StringWork$+CHR$(13)) ' DD060401
  1096. '     END SUB                                                        ' DD060401
  1097. * DELETING old line(s)
  1098. 59720
  1099. 59721
  1100. 59722
  1101. 59723
  1102. * REPLACING old line(s) by new
  1103. 59791 IF FExists THEN _
  1104.          IOErrorCount = 0 : _
  1105.          CALL RBBSFind (FilName$,WasZ,WasY,WasM,WasD) : _
  1106.          FExists = (WasZ = 0)
  1107.       END SUB
  1108. * ------[ first line different ]------
  1109. '
  1110. '
  1111. '  $SUBTITLE: 'Error Handling for separately compiled subroutines'
  1112. '  $PAGE
  1113. '
  1114. '
  1115. ' Error handling for the separately compiled subroutines of RBBS-PC
  1116. '
  1117. '
  1118. * REPLACING old line(s) by new
  1119. 65000 IF ZDebug THEN _
  1120.          ZOutTxt$ = "RBBSSUB1 DEBUG Error Trap Entry ERL=" + _
  1121.               STR$(ERL) + _
  1122.               " ERR=" + _
  1123.               STR$(ERR) : _
  1124.          IF ZPrinter THEN _
  1125.             CALL Printit(ZOutTxt$) _
  1126.          ELSE CALL LPrnt(ZOutTxt$,1)
  1127.       ZErrCode = ERR
  1128. '
  1129. '     SetCall
  1130. '
  1131.       IF ERL = 108 THEN _
  1132.          CALL PScrn ("Unable to create callers log " + ZCallersFile$) : _
  1133.          SYSTEM
  1134.       IF ERL = 110 THEN _
  1135.           RESUME NEXT
  1136. '
  1137. '     OPEN CONFIG FILE
  1138. '
  1139.        IF ERL => 117 AND ERL <= 119 THEN _
  1140.           RESUME NEXT
  1141. '
  1142. * ------[ first line different ]------
  1143. '    Create ArkViewSubdir error handling                             'Pe 08/15/91
  1144. '                                                                    ' Mpl090202
  1145.       IF ERL = 150 and ERR = 75 THEN _                               'Pe 08/15/91
  1146.          ZErrCode = ERR : _                                          ' Mpl090202
  1147.          RESUME NEXT                                                 'Pe 08/15/91
  1148. '
  1149. '     Disk Not Ready                                                 ' DD042602
  1150. '                                                                    ' DD042602
  1151.       IF ERR = 71 THEN _                                             ' DD042602
  1152.          ZErrCode = ERR : _                                          ' DD042602
  1153.          CALL QuickTPut1 (ZFGF$ + ZBG4$ + _                          ' DD042602
  1154.                           "ERROR! Disk Not Ready!" + _               ' DD042602
  1155.                           ZEmphasizeOff$) : _                        ' DD042602
  1156.          RESUME NEXT                                                 ' DD042602
  1157. '
  1158. '     Path not found                                                 ' DD090802
  1159. '                                                                    ' DD090802
  1160.       IF ERR = 76 THEN _                                             ' DD090802
  1161.          ZErrCode = ERR : _                                          ' DD090802
  1162.          CALL QuickTPut1 (ZFGF$ + ZBG4$ + _                          ' DD090802
  1163.                           "ERROR! Path Not Found!" + _               ' DD090802
  1164.                           ZEmphasizeOff$) : _                        ' DD090802
  1165.          RESUME NEXT                                                 ' DD090802
  1166. '
  1167. '     OPEN COM PORT ERROR HANDLING
  1168. '
  1169.       IF ERL = 200 THEN _
  1170.          CLS : _
  1171.          CALL PScrn (ZComPort$ + " does not exist/not responding- Error" + STR$(ERR)) : _
  1172.          STOP
  1173. '
  1174. '     GetCom ERROR HANDLING
  1175. '
  1176.        IF ERL = 1420 AND ERR = 57 THEN _
  1177.           RESUME NEXT
  1178.        IF ERL = 1420 AND ERR = 69 THEN _
  1179.           ZSubParm = -1 :_
  1180.           RESUME NEXT
  1181. '
  1182. '      OPENRESEQ ERROR HANDLING
  1183. '
  1184.        IF ERL = 1487 THEN _                                          ' Pe 08/25/91
  1185.            ZErrCode = ERR : _
  1186.            RESUME NEXT
  1187. '
  1188. '      OpenUser ERROR HANDLING
  1189. '
  1190.        IF ERL = 9400 AND ERR = 75 AND ZShareIt THEN _
  1191.           CALL DelayTime (30) : _
  1192.           RESUME
  1193. '
  1194. '      FindUser ERROR HANDLING
  1195. '
  1196.        IF ERL = 12610 OR ERL = 12600 THEN _
  1197.           RESUME NEXT
  1198. '
  1199. '     UpdtCalr ERROR HANDLING
  1200. '
  1201.        IF ERL = 13663 THEN _
  1202.           RESUME NEXT
  1203.        IF ERL = 13672 AND ERR = 61 THEN _
  1204.           CALL QuickTPut1 ("Disk Full") : _
  1205.           IF ZDiskFullGoOffline THEN _
  1206.              GOTO 65010 _
  1207.           ELSE RESUME NEXT
  1208.        IF ERL = 13672 THEN _
  1209.           ZCallersFileIndex! = ZCallersFileIndex! - 1 : _
  1210.           RESUME NEXT
  1211. '
  1212. '     ZPrinter ERROR HANDLING
  1213. '
  1214.        IF ERL = 13674 THEN _
  1215.           ZPrinter = ZFalse : _
  1216.           RESUME
  1217. '
  1218. '      ChangeDir ERROR HANDLING
  1219. '
  1220. '      IF ERL = 20103 THEN _                                         ' DD062304
  1221. '         ZOK = ZFalse : _                                           ' DD062304
  1222. '         RESUME NEXT                                                ' DD062304
  1223. '
  1224. '     FindIt ERROR HANDLING
  1225. '
  1226.        IF ERL = 20221 THEN _
  1227.           RESUME NEXT
  1228.        IF ERL = 20223 AND ZErrCode = 58 THEN _
  1229.           ZErrCode = 64 : _
  1230.           ZOK = ZFalse : _
  1231.           RESUME NEXT
  1232.        IF ERL = 20223 AND ZErrCode = 76 THEN _
  1233.           CALL LPrnt("Bad path.  File name is " + FilName$,1) : _
  1234.           ZErrCode = 76 : _
  1235.           ZOK = ZFalse : _
  1236.           RESUME NEXT
  1237.        IF ERL => 20221 AND ERL <= 20223 AND ZErrCode = 70 _
  1238.           AND ZNetworkType = 6 THEN _
  1239.              ZErrCode = 0 : _
  1240.              RESUME NEXT
  1241.        IF ERL => 20221 AND ERL <= 20223 THEN _
  1242.           RESUME
  1243. '
  1244. '     FlushCom ERROR HANDLING
  1245. '
  1246.        IF ERL = 20310 AND ERR = 14 THEN _                            'Pe 01/03/90
  1247.           RESUME NEXT
  1248.        IF ERL = 20311 AND ERR = 57 THEN _                            ' Mpl090201
  1249.           RESUME NEXT
  1250.        IF ERL = 20311 AND ERR = 69 THEN _
  1251.           ZAbort = ZTrue : _
  1252.           ZSubParm = -1 : _
  1253.           RESUME NEXT
  1254. '
  1255. '     NetBIOS ERROR HANDLING
  1256. '
  1257.        IF ERL => 29900 AND ERL <= 29920 THEN _
  1258.           RESUME NEXT
  1259. '
  1260. '     UpdateC ERROR HANDLING
  1261. '
  1262.       IF ERL => 43050 AND ERR <= 43060 AND ERR = 54 THEN _           ' Mpl111401
  1263.          RESUME NEXT                                                 ' Mpl111401
  1264.       IF ERL => 43050 AND ERL <= 43060 AND ERR = 61 THEN _
  1265.          ZOutTxt$ = "* Disk full - terminating *" : _
  1266.          ZSubParm =2 : _
  1267.          CALL TPut : _
  1268.          IF ZDiskFullGoOffline THEN _
  1269.            GOTO 65010 _
  1270.          ELSE SYSTEM
  1271. '
  1272. '     CheckInt ERROR HANDLING
  1273. '
  1274.        IF (ERL = 59652 OR ERL = 59727) AND ERR = 24 THEN _
  1275.           ZNotCTS = ZTrue : _
  1276.           CALL Line25 : _
  1277.           ZErrCode = 0 : _
  1278.           RESUME
  1279.        IF ERL => 52000 AND ERL <= 59725 THEN _
  1280.           RESUME NEXT
  1281. '
  1282. '     FindFile ERROR HANDLING
  1283. '
  1284.       IF ERL = 59791 THEN _
  1285.          IF ERR = 57 THEN _                                          ' Mpl090202
  1286.             CALL DelayTime (1) : _
  1287.             CALL UpdtCalr ("SLOW I/O ERROR",1) : _
  1288.             IOErrorCount = IOErrorCount + 1 : _
  1289.             IF IOErrorCount < 19 THEN _                              'Was 11 Pe 08/05/92
  1290.                RESUME
  1291. '
  1292. '      VIEW ARC TXT ERROR HANDLER                                    ' Mpl090202
  1293. '                                                                    ' Mpl090202
  1294. '     IF ERL => 60140 AND ERR = 53 THEN _                            'Pe 10/20/91
  1295. '        CALL QuickTPut1 ("ERROR!  No Such File, EXITING") : _       ' DD060101
  1296. '        RESUME NEXT                                                 ' Mpl090202
  1297. '     IF ERL => 60140 AND ERR = 63 THEN _                            'Pe 10/20/91
  1298. '        CALL QuickTPut1 ("ERROR Occured, Please notify SysOp") : _  ' Mpl090202
  1299. '        RESUME NEXT                                                 ' Mpl090202
  1300. '
  1301. '     CATCH ALL OTHER ERRORS
  1302. '
  1303.        ZOutTxt$ = "RBBS-SUB1 Untrapped Error" + _
  1304.             STR$(ERR) + _
  1305.             " in line" + _
  1306.             STR$(ERL)
  1307.        CALL QuickTPut1 (ZOutTxt$)
  1308.        CALL UpdtCalr (ZOutTxt$,2)
  1309.        RESUME NEXT
  1310. '     SHARED ROUTINE FOR GOING OFF LINE WHEN DISK FULL
  1311.