home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / BBS / RBBS_PC / 173_BAS.ZIP / RBBSSUB3.BAS < prev    next >
Encoding:
BASIC Source File  |  1990-02-11  |  112.2 KB  |  3,395 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB3.BAS CPC17.3, Copyright 1986 - 90 by D. Thomas Mack'
  3. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB3.BAS
  5. '  First Released .....: February 11, 1990
  6. '  Subsequent Releases.: 
  7. '  Copyright ..........: 1986 - 1990
  8. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  9. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  10. '     require error trapping are incorporated within RBBSSUB 2-5 as
  11. '     separately callable subroutines in order to free up as much
  12. '     code as possible within the 64K 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. '  AllCaps         58050 Convert a string to all upper case characters
  18. '  AMorPM          41498 Calculate the current time as AM or PM
  19. '  AskGraphics     43004 Determine users graphic default
  20. '  BadFile         20741 Check for system crash attempt with bad device name
  21. '  Carrier         42000 Test for whether to continue in RBBS
  22. '  CheckRatio      20096 Test upload/download ratio
  23. '  CheckTime       58070 Test to insure that users don't exceed their time
  24. '  CheckCarrier    42005 Checks whether still have carrier
  25. '  CheckNewBul     58110 Check for new bulletins based on their file creation date
  26. '  CheckTimeRemain 41008 Set up to log off if time exceeded
  27. '  CommInfo        44020 Get users baud rate and parity in a string format
  28. '  CountLines      58160 Count categories a file can be classified into
  29. '  CountNewFiles   58150 Check for number of files uploaded after a specific date
  30. '  DelayTime       50495 Wait number of seconds specified before returning
  31. '  DispCall        57001 Display callers file
  32. '  DispTimeRemain  41032 Compute and display time remaining
  33. '  DispUpDir       58165 Display the shared directory of the FMS mng. sys.
  34. '  FileLock        21993 Allow files to be shared among multiple RBBS-PC's
  35. '  FindFKey        30595 Handle local keyboard's function & ZSysop's keys
  36. '  FindLast        58600 Finds last occurence of a string in a string
  37. '  FlushKeys       35000  Completely flush all user input
  38. '  Graphic         43031 Determines if graphic ver of file exists, opens as #2
  39. '  GraphicX        43031 Determines if graphic ver of file exists, any file #
  40. '  HashRBBS        58080 "Hash" to a user's record in the USERS file
  41. '  InitFMS         58162 Initialize the RBBS-PC's File Management System
  42. '  InitIBM         30000 Open/create NetBIOS semaphore file
  43. '  AddCommas       58130 Format commands in the command prompt
  44. '  Library         21105 Provide support for "library" drives
  45. '  LinesInFile     58161 Counts lines in a file
  46. '  LoadNew         58140 Find the latest uploads
  47. '  ModemPut        52070 Write a modem command string to the modem
  48. '  NameCaps        58060 Convert a string to Proper Case (for name output)
  49. '  OpenMsg         30500 Open the messages file as file number 1
  50. '  PageUp          33202 Display user info. on local screen for ZSysop
  51. '  ReadProf        44000 Read user's profile on return from a "door"
  52. '  SaveProf        43068 Save the user's provile when exiting to "doors" or DOS
  53. '  SendName        20293 Send filename via EXEC-PC protocol during autodownload
  54. '  SetOpts         58100 Set correct prompt line for each subsystem
  55. '  SortString      58120 Sort characters in a string
  56. '  TestUser        20310 Check if user's software can do auto downloading
  57. '  TimeRemain      41010 Compute time remaining in minutes
  58. '  UpdtUpload      20705 Updates upload directory file
  59. '  WildFile        20290 Determines whether string matches a pattern
  60. '  XferType        21600 Identify the file transfer protocol
  61. '
  62. '  $INCLUDE: 'RBBS-VAR.BAS'
  63. '
  64. 20290 ' $SUBTITLE: 'WildFile -- Matches file to a filespec'
  65. ' $PAGE
  66. '  NAME    -- WildFile
  67. '
  68. '  INPUTS  -- PARAMETER             MEANING
  69. '             Pattern$           PATTERN TO CHECK AGAINST
  70. '             ItemToMatch$       FILE NAME TO MATCH
  71. '
  72. '  OUTPUTS -- DoesMatch         WHETHER MATCHES
  73. '
  74. '  PURPOSE  Determine whether a file name is an instance of
  75. '    a file specification.  Exactly like DOS except that ? must have a
  76. '    character.
  77. '
  78.       SUB WildFile (Pattern$,ItemToMatch$,DoesMatch) STATIC
  79.       IF Pattern$ <> PrevPattern$ THEN _
  80.          CALL BreakFileName (Pattern$,PDrive$,PPrefix$,PExt$,ZFalse) : _
  81.          PrevPattern$ = Pattern$
  82.       CALL BreakFileName (ItemToMatch$,IDrive$,IPrefix$,IExt$,ZFalse)
  83.       DoesMatch = ZFalse
  84.       IF PDrive$ <> "" AND PDrive$ <> IDrive$ THEN _
  85.          EXIT SUB
  86.       CALL WildCard (PPrefix$,IPrefix$)
  87.       IF NOT ZOK THEN _
  88.          EXIT SUB
  89.       CALL WildCard (PExt$,IExt$)
  90.       DoesMatch = ZOK
  91.       END SUB
  92. 20293 ' $SUBTITLE: 'SendName - send FILENAME using EXEC-PC protocol'
  93. ' $PAGE
  94. '
  95. '  NAME    -- SendName
  96. '
  97. '  INPUTS  --  PARAMETER                    MEANING
  98. '              ZUserIn$()                ARRAY OF FILENAME FOR AUTODOWNLOAD
  99. '              ZDwnIndex                 Index OF FILENAME TO Transfer
  100. '
  101. '  OUTPUTS --  ZAbort                    -1 FOR AN ABORTED ATTEMPT
  102. '
  103. '  PURPOSE -- Send the download filename to user during an autodownload
  104. '
  105.       SUB SendName STATIC
  106. '
  107. '
  108. ' *  Transfer FILENAME TO USER
  109. ' *         PROCESS - SEND USER THE "ALERT" CHARACTER SEQUENCE -- <ESC>OD
  110. ' *                   THEN THIS IS FOLLOWED BY CHARACTER-BY-CHARACTER
  111. ' *                   TRANSMISSION OF THE FILENAME WITH ECHO.  IF ANY OF THE
  112. ' *                   CHARACTERS OF THE FILENMAE ARE GARBLED A SERIES OF
  113. ' *                   <CAN> ARE SENT, OTHERWISE AN <ACK> IS SENT AT
  114. ' *                   COMPLETION AND FILE Transfer BEGINS.
  115. '
  116. '
  117.       ZAbort = ZFalse                    ' RESET ABORT FLAG
  118.       Attempts = 0                       ' RESET COUNT FOR # OF TRANS Attempts
  119. 20295 CALL DelayTime (1)                 ' ONE SECOND DELAY
  120. 20296 CALL FlushCom(ZWasY$)              ' CLEAR THE COMM BUFFER OF GARBAGE
  121.       IF ZSubParm = -1 THEN _
  122.          EXIT SUB
  123.       CALL PutCom (ZEscape$+"OD")         ' SEND "ALERT" STRING
  124.       IF ZSubParm = -1 THEN _
  125.          EXIT SUB
  126.       IF ZAbort = ZTrue THEN _
  127.          GOTO 20306
  128.       CALL LPrnt("Sending FILENAME -- ",1)
  129.       CALL LPrnt(ZReturnLineFeed$ + CHR$(9),0)
  130.       CALL DelayTime (1)                   ' WAIT 1 SECOND FOR SETUP
  131. '
  132. '               SEND ONE CHARACTER AT A TIME
  133. '
  134.       CALL BreakFileName (ZUserIn$(ZDwnIndex),WasX$,ZOutTxt$,ZWasY$,ZTrue)
  135.       ZOutTxt$ = ZOutTxt$ + ZWasY$ + "X"
  136.       FOR WasX = 1 TO LEN(ZOutTxt$)
  137.          CALL PutCom (MID$(ZOutTxt$,WasX,1))     ' SEND 1 CHARACTER
  138.          IF ZSubParm = -1 THEN _
  139.             EXIT SUB
  140.          IF ZAbort = ZTrue THEN _
  141.             GOTO 20306
  142.          CALL LPrnt(MID$(ZOutTxt$,WasX,1),0)     ' DISPLAY IF NEEDED
  143.          ZDelay! = TIMER + 10            ' SET MAXIMUM TIME TO WAIT FOR Reply
  144.          Char = ZTrue
  145.          WHILE Char = -1
  146.             CALL CheckTime(ZDelay!, TempElapsed!, 1)
  147.             IF TempElapsed! <= 0 THEN _
  148.                GOTO 20300     ' IF ZNo ECHO, CANCEL FILENAME Transfer
  149.             CALL EofComm (Char)
  150.          WEND                 ' JUMP OUT IF CHARACTER IS RECEIVED
  151. 20298    CALL FlushCom(ZWasY$)    ' COLLECT CHARACTER(ZWasS) USER ECHOED
  152.          IF ZSubParm = -1 THEN _
  153.             EXIT SUB
  154.          IF MID$(ZOutTxt$,WasX,1) = ZWasY$ THEN _
  155.             GOTO 20305         ' IF CORRECTLY ECHOED, THEN CONTINUE
  156.          IF INSTR(ZWasY$,ZCancel$) THEN _
  157.             ZAbort = ZTrue : _
  158.             GOTO 20306          ' CHECK FOR USER ZAbort
  159. 20300    CALL PutCom (STRING$(5,24)) ' TELL USER THAT FILE NAME IS GARBLED
  160.          IF ZSubParm = - 1 THEN _
  161.             EXIT SUB
  162.          IF ZAbort = ZTrue THEN _
  163.             GOTO 20306
  164.          CALL LPrnt("Name Trans Failure",1) ' DISPLAY FAILURE ON SCREEN
  165.          Attempts = Attempts + 1  ' INCREMENT COUNTER FOR # WasOF TRIES
  166.          IF Attempts < 6 THEN _   ' TRY IT FIVE TIMES, THEN GIVE UP
  167.             GOTO 20295
  168.          CALL PutCom (STRING$(50,24)) ' GUARANTEE CANCELLATION WasOF USER
  169.          IF ZSubParm = -1 THEN _
  170.             EXIT SUB
  171.          IF ZAbort = ZTrue THEN _
  172.             GOTO 20306
  173.          IF ZSnoop THEN _
  174.             CALL LPrnt("ABORTING AUTODOWNLOAD!",1) : _
  175.             ZAbort = ZTrue : _
  176.             GOTO 20306
  177. '
  178. 20305 NEXT                               ' LOOP BACK FOR NEXT CHARACTER
  179. '
  180.       CALL PutCom (ZAcknowledge$)    ' WHEN FILENAME SENT, ACKNOWLEDGE
  181.       IF ZSubParm = -1 THEN _
  182.          EXIT SUB
  183.       CALL SkipLine(1)              ' CLEAN UP Sysop's DISPLAY
  184. '
  185. '                COMPLETION OF AUTODOWNLOAD FILENAME Transfer
  186. '
  187. 20306 END SUB
  188. 20310 ' $SUBTITLE: 'TestUser - interrogate user for AUTO-Downloading support'
  189. ' $PAGE
  190. '
  191. '  NAME    -- TestUser
  192. '
  193. '  INPUTS  -- NONE
  194. '
  195. '  OUTPUTS -- ZAutoDownYes         -1 IF USER'S COMMUNICATION
  196. '                                  SOFTWARE CAN DO AUTODOWNLOADING
  197. '
  198. '             ZAutoDownVerified    TRUE IF COMMUNICATIONS PGM
  199. '                                  EVER CHECKED
  200. '
  201. '  PURPOSE -- Send the user an <ESCAPE><XON> and if response
  202. '             is a recognized package, set appropriate flag.
  203. '
  204.       SUB TestUser STATIC
  205. '
  206. '
  207. ' *    TEST FOR COMMUNICATIONS USING WasN,8,1 Protocol AND EXECPC Talk VER 2.0+
  208. ' *     TO SEE IF CALLER CAN USE THE AUTODOWNLOAD FEATURE
  209. '
  210. '
  211.       ZAbort = ZFalse
  212.       ZAutoDownVerified = ZTrue
  213.       CALL FlushCom(ZWasY$)                          ' FLUSH THE COMM BUFFER
  214.       IF ZSubParm = -1 THEN _
  215.          EXIT SUB
  216.       CALL PutCom (ZEscape$ + ZXOn$)
  217.       IF ZAbort = ZTrue THEN _
  218.          GOTO 20315
  219.       CALL DelayTime (2)                         ' WAIT TWO SECONDS FOR Reply
  220. 20313 CALL FlushCom(ZWasY$)                      ' GET CONTENTS OF COMM BUFFER
  221.       IF ZSubParm = -1 THEN _
  222.          EXIT SUB
  223.       IF INSTR(ZWasY$,"EXECPC") THEN _
  224.          ZComProgram = 1
  225.       IF INSTR(ZWasY$,"PIBTERM") THEN _
  226.          ZComProgram = 2
  227.       IF INSTR(ZWasY$,"PROCOMM") THEN _
  228.          ZComProgram = 3
  229.       IF INSTR(ZWasY$,"QMODEM") THEN _
  230.          ZComProgram = 4
  231.       ZAutoDownYes = (ZComProgram > 0 AND ZComProgram < 3)
  232. 20315 END SUB
  233. 20705 ' $SUBTITLE: 'UpdtUpload -- Updates upload directory'
  234. ' $PAGE
  235. '  NAME    -- UpdtUpload
  236. '
  237. '  INPUTS  -- PARAMETER             MEANING
  238. '             ZFileName$
  239. '             ZUpldDir$
  240. '             ZFileNameHold$
  241. '             ZShareIt
  242. '             ZFMSDirectory$
  243. '             ZWasQ!
  244. '             ZSecsUsedSession!
  245. '
  246. '  OUTPUTS -- ZBytesInFile#
  247. '             ZSecsPerSession!
  248. '
  249. '  PURPOSE -- Upon a successful upload, add entry to the upload
  250. '             directory and give any session time credit.
  251. '
  252.       SUB UpdtUpload (ZCategoryName$(1),ZCategoryCode$(1), LinesInDesc) STATIC
  253.       IF ZGetExtDesc THEN _
  254.          GOTO 20723
  255.       GOSUB 20734
  256.       CALL TimeRemain (MinsRemaining)
  257.       IF ZPrivateDoor THEN _
  258.          WasX! = ZUpldTimeFactor! * ZWasQ! _
  259.       ELSE WasX! = ZUpldTimeFactor! * (ZSecsUsedSession! - ZWasQ!)
  260.       CALL BreakFileName (ZFileName$,Pre$,Body$,Ext$,ZFalse)
  261.       WasX$ = ZDiskForDos$ + "T" + Ext$ + ".BAT"
  262.       CALL FindIt (WasX$)
  263.       IF NOT ZOK THEN _
  264.          GOTO 20708
  265.       CALL QuickTPut1 ("Verifying file integrity...") : _
  266.       CALL ReadDir (2,1)
  267.       IF EOF(2) THEN _
  268.          WasX$ = ZOutTxt$ : _
  269.          ZGSRAra$(1) = ZFileName$ : _
  270.          ZGSRAra$(2) = ZNodeWorkFile$ _
  271.       ELSE WasX$ = WasX$ + " " + _
  272.            ZFileName$ + " " + ZNodeWorkFile$
  273.       CALL ShellExit (WasX$)
  274.       CALL FindIt (ZNodeWorkFile$)
  275.       IF ZOK THEN _
  276.          IF LOF(2) > 2 THEN _
  277.             ZBytesInFile# = 0.0 : _
  278.             WasX$ = "Deleting BAD upload " + ZFileNameHold$ : _
  279.             CALL QuickTPut1 (WasX$) : _
  280.             CALL UpdtCalr (WasX$,2) : _
  281.             CALL KillWork (ZFileName$) : _
  282.             EXIT SUB
  283. 20708 WasX$ = ZDiskForDos$ + "C" + Ext$ + ZDefaultExtension$ + ".BAT"
  284.       CALL FindIt (WasX$)
  285.       IF NOT ZOK THEN _
  286.          GOTO 20709
  287.       ZOutTxt$ = "Converting"
  288.       IF Ext$ = ZDefaultExtension$ THEN _
  289.          ZOutTxt$ = "Re-" + ZOutTxt$
  290.       CALL QuickTPut1 (ZOutTxt$ + " upload to "+ZDefaultExtension$+".  Please wait...")
  291.       CALL ReadDir (2,1)
  292.       IF EOF(2) THEN _
  293.          WasX$ = ZOutTxt$
  294.       ZGSRAra$(1) = ZFileName$
  295.       CALL BreakFileName (ZFileName$,Pre$,Body$,Ext$,ZTrue)
  296.       ZFileNameHold$ = Body$ + "." + ZDefaultExtension$
  297.       ZUserIn$(0) = ZFileName$
  298.       ZFileName$ = Pre$ + ZFileNameHold$
  299.       CALL ShellExit (WasX$ + " " + Body$ + " " + ZNodeID$)
  300.       CALL FindIt (ZFileName$)
  301.       IF NOT ZOK THEN _
  302.          ZFileName$ = ZGSRAra$(1) : _
  303.          CALL FindIt (ZFileName$) : _
  304.          ZFileNameHold$ = Body$ + Ext$ : _
  305.          IF ZOK THEN _
  306.             GOTO 20709
  307.       GOSUB 20736
  308. 20709 CALL QuickTPut1 ("Upload successful")
  309.       WasX$ = DATE$
  310.       ZWasZ$ = LEFT$(WasX$,6) + _
  311.            RIGHT$(WasX$,2)
  312.       StrewTo$ = ""
  313.       UCat$ = ""
  314. 20710 CALL QuickTPut1 ("Describe " + ZFileNameHold$ + _
  315.            " (Begin with '/' if for SYSOP only)")
  316.       CALL QuickTPut1 (LEFT$(" |----+--Min<..-+---2+0---+---3+0---+---4+0---+-", _
  317.                  ZMaxDescLen - 4) + "..Max>")
  318.       CALL QuickTPut ("? ",0)
  319.       ZOutTxt$ = ""
  320.       ZSubParm = 1
  321.       ZParseOff = ZTrue
  322.       CALL TGet
  323.       CALL Carrier
  324.       IF ZSubParm = -1 THEN _
  325.          ZUserIn$ = "<description unavailable>": _
  326.          GOTO 20712
  327.       IF LEN(ZUserIn$) > ZMaxDescLen OR LEN(ZUserIn$) < 10 THEN _
  328.          CALL QuickTPut1 ("10 chars min," + STR$(ZMaxDescLen) + " max") : _
  329.          GOTO 20710
  330. 20712 ZOK = 0
  331.       CALL CheckNovell (ZOK)
  332.       IF ZOK <> -1 THEN _
  333.          CALL SetSharedAttr (ZFileName$, ZOK) : _
  334.          IF ZOK <> 0 THEN _
  335.             CALL PScrn ("Error setting shared attribute")
  336.       Desc$ = ZUserIn$
  337.       IF NOT ZLimitSearchToFMS THEN _
  338.          IF ZFMSDirectory$ <> ZUpldDir$ THEN _
  339.             IF LEFT$(ZUserIn$,1) = "/" THEN _
  340.                CALL UpdtCalr (ZUserIn$,2) : _
  341.                GOTO 20726_
  342.             ELSE GOTO 20717
  343. 20715 IF LEFT$(ZUserIn$,1) = "/" THEN _
  344.          UCat$ = "***" : _
  345.          GOTO 20722
  346.       UCat$ = ZDefaultCatCode$
  347. 20717 IF ZSubParm = -1 OR _
  348.          ZUserSecLevel < ZSLCategorizeUplds THEN _
  349.          GOTO 20722
  350. 20719 CALL BufFile (ZUpcatHelp$,WasX)
  351. 20720 ZOutTxt$= "Upload best fits what category (D=default,H=help)"
  352.       ZSubParm = 1
  353.       CALL TGet
  354.       CALL AllCaps (ZUserIn$(1))
  355.       IF ZSubParm = -1 OR ZUserIn$(1) = "D" THEN _
  356.          ZUserIn$ = ZDefaultCatCode$ : _
  357.          GOTO 20722
  358.       IF ZWasQ = 0 THEN _
  359.          GOTO 20719
  360.       IF ZUserIn$(1) = "H" OR _
  361.          ZUserIn$(1) = "*" OR _
  362.          ZUserIn$(1) = "?" THEN _
  363.          GOTO 20719
  364.       CALL SearchArray (ZUserIn$(1),ZCategoryName$(),ZNumCategories,Found)
  365.       IF Found > 0 THEN _
  366.          UCat$ = ZCategoryCode$(Found) : _
  367.          IF LEN(UCat$) > 0 AND LEN(UCat$) < 4 AND INSTR(UCat$,",") = 0 THEN _
  368.             GOTO 20722
  369.       UCat$ = ""
  370.       IF NOT ZLimitSearchToFMS THEN _
  371.          StrewTo$ = ZDirPath$ + _
  372.                      ZUserIn$(1) + _
  373.                      "." + _
  374.                      ZDirExtension$ : _
  375.          CALL FindIt (StrewTo$) : _
  376.          IF ZOK THEN _
  377.             GOTO 20722 _
  378.          ELSE CALL WordInFile (ZUpcatHelp$,ZUserIn$(1),ZOK) : _
  379.               IF ZOK THEN _
  380.                  GOTO 20722
  381.       StrewTo$ = ""
  382.       CALL QuickTPut1 ("No such category " + ZUserIn$(1))
  383.       GOTO 20719
  384. 20722 IF ZUserSecLevel >= ZAskExtendedDesc AND _
  385.          ZMaxExtendedLines > 0 AND ZSubParm <> -1 THEN _
  386.          ZOutTxt$ = "Add an EXTENDED DESCRIPTION of " + _
  387.               ZFileNameHold$ + " ([Y],N)" : _
  388.          ZTurboKey = -ZTurboKeyUser : _
  389.          ZSubParm = 1 : _
  390.          CALL TGet : _
  391.          IF ZSubParm <> -1 THEN _
  392.             IF NOT ZNo THEN _
  393.                ZGetExtDesc = ZTrue : _
  394.                EXIT SUB
  395. 20723 ZUserIn$ = Desc$
  396.       WasX$ = DATE$
  397.       ZWasZ$ = LEFT$(WasX$,6) + _
  398.            RIGHT$(WasX$,2)
  399.       ZWasEN$ = StrewTo$
  400.       GOSUB 20730
  401.       ZWasEN$ = ZAllwaysStrewTo$
  402.       GOSUB 20730
  403. 20725 ZWasEN$ = ZUpldDir$
  404.       GOSUB 20730
  405. 20726 ZWasDF$ = " >> uploaded << "
  406.       ZUplds = ZUplds + 1
  407.       ZGlobalUplds = ZGlobalUplds + 1
  408.       ZULBytes! = ZULBytes! + ZBytesInFile#
  409.       ZGlobalULBytes! = ZGlobalULBytes! + ZBytesInFile#
  410.       CALL Muzak (7)
  411.       CALL TimeRemain (MinsRemaining)
  412.       ZTimeCredits! = ZTimeCredits! + WasX!
  413.       ZSecsPerSession! = ZSecsPerSession! + WasX!
  414.       IF ZPrivateDoor THEN _
  415.          WasX! = (WasX! - ZWasQ!) / 60 _
  416.       ELSE WasX! = (WasX! - ZSecsUsedSession! + ZWasQ!)/60.0
  417.       WasX$ = STR$(FIX(WasX!*10.0))
  418.       WasX$ = LEFT$(WasX$,LEN(WasX$)-1) + "." + RIGHT$(WasX$,1)
  419.       IF WasX! > 1 THEN _
  420.          CALL QuickTPut1 ("Increased your session time by"+WasX$+" minutes")
  421.       CALL QuickTPut1 ("Thanks for the upload!")
  422.       ZGetExtDesc = ZFalse
  423.       EXIT SUB
  424. 20730 '          ---[ lock file ]---
  425.       IF ZWasEN$ = "" THEN _
  426.          RETURN
  427.       FMSFormat = ZFalse
  428.       IF ZWasEN$ = ZFMSDirectory$ OR ZLimitSearchToFMS THEN _
  429.          FMSFormat = ZTrue _
  430.       ELSE CALL FindIt (ZWasEN$) : _
  431.            IF ZOK THEN _
  432.               CALL ReadDir (2,1) : _
  433.               IF ZErrCode = 0 THEN _
  434.                  FMSFormat = (LEFT$(ZOutTxt$,4) = "\FMS")
  435.       IF NOT FMSFormat THEN _
  436.          ReadBackwards = ZFalse : _
  437.          FixedLen = 0 : _
  438.          ZUserIn$ = Desc$ _
  439.       ELSE FixedLen = 34 + ZMaxDescLen : _
  440.            ZUserIn$ = Desc$ + _
  441.                 SPACE$(ZMaxDescLen - LEN(Desc$)) + _
  442.                 UCat$ + _
  443.                 SPACE$(3 - LEN(UCat$)) : _
  444.            ReadBackwards = ZTrue : _
  445.            CALL FindIt (ZWasEN$) : _
  446.            IF ZOK THEN _
  447.               CALL ReadDir (2,1) : _
  448.               IF ZErrCode = 0 THEN _
  449.                  ReadBackwards = (INSTR(ZOutTxt$," TOP ") = 0)
  450.       CALL LockAppend
  451.       IF ZErrCode <> 0 THEN _
  452.          GOTO  20731
  453.       '          ---[ append ]---
  454.       IF ZGetExtDesc THEN _
  455.          IF ReadBackwards THEN _
  456.             FOR WasI = LinesInDesc TO 1 STEP -1 : _
  457.                GOSUB 20732 : _
  458.             NEXT
  459.       PRINT #2,USING "\           \########  &  &"; _
  460.                      ZFileNameHold$; _
  461.                      ZBytesInFile#; _
  462.                      ZWasZ$; _
  463.                      ZUserIn$
  464.       IF ZGetExtDesc THEN _
  465.          IF NOT ReadBackwards THEN _
  466.             FOR WasI = 1 TO LinesInDesc : _
  467.                GOSUB 20732 : _
  468.             NEXT
  469. 20731 CALL UnLockAppend
  470.       FixedLen = 0
  471.       RETURN
  472. 20732 WasX$ = ZOutTxt$(WasI)
  473.       CALL Trim (WasX$)
  474.       IF WasX$ = "" THEN _
  475.          RETURN
  476.       IF NOT FMSFormat THEN _
  477.          PRINT #2,"  ";ZOutTxt$(WasI) : _
  478.          RETURN
  479.       IF FixedLen > LEN(ZOutTxt$(WasI)) THEN _
  480.          WasX$ = SPACE$(FixedLen - 1 - LEN(ZOutTxt$(WasI))) + "." _
  481.       ELSE WasX$ = ""
  482.       PRINT #2, "  ";LEFT$(ZOutTxt$(WasI),FixedLen);WasX$
  483.       RETURN
  484. 20734 CALL FindIt (ZFileName$)
  485. 20736 IF NOT ZOK THEN _
  486.          ZBytesInFile# = 0.0_
  487.       ELSE ZBytesInFile# = LOF(2)
  488.       IF ZBytesInFile# < 2.0 THEN _
  489.          EXIT SUB
  490.       RETURN
  491.       END SUB
  492. 20741 ' $SUBTITLE: 'BadFile - subroutine to find bad file names'
  493. ' $PAGE
  494. '
  495. '  NAME    -- BadFile
  496. '
  497. '  INPUTS  --     PARAMETER                    MEANING
  498. '               ZViolation$
  499. '               ZViolationsThisSession
  500. '               FilName$                      NAME OF FILE
  501. '
  502. '  OUTPUTS -- Result                      1 = FILE NAME IS OK
  503. '                                         2 = CHARACTER NOT ALLOWED
  504. '                                         3 = SYSTEM CRASH ATTEMPT
  505. '             ZViolationsThisSession     NUMBER OF VIOLATIONS
  506. '             FilName$                    Gets capitalized
  507. '
  508. '  PURPOSE -- To protect RBBS-PC against the use of bad file names
  509. '             to either crash the system or to breach RBBS-PC's security.
  510. '
  511.       SUB BadFile (FilName$,Result) STATIC
  512. '
  513. '
  514. ' *  TEST FOR INVALID CHARACTERS IN FILENAME
  515. '
  516. '
  517.       Result = 2
  518.       IF LEN(FilName$) < 1 THEN _
  519.          EXIT SUB
  520.       CALL BadFileChar (FilName$,ZOK)
  521.       IF NOT ZOK THEN _
  522.          EXIT SUB
  523.       CALL AllCaps (FilName$)
  524.       WasXX = INSTR(FilName$,".")
  525.       IF WasXX > 0 THEN _
  526.          IF WasXX < LEN(FilName$) THEN _
  527.             WasXX = INSTR(WasXX + 1,FilName$,".") : _
  528.             IF WasXX > 0 THEN _
  529.                EXIT SUB
  530.       WasXX = LEN(FilName$)
  531.       IF WasXX => 3 THEN _
  532.          IF INSTR("PRN:CON:AUX:NUL:",FilName$) THEN _
  533.             GOTO 20742
  534.       IF WasXX => 4 THEN _
  535.          IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",FilName$) THEN _
  536.             GOTO 20742
  537.       CALL BreakFileName (FilName$,Pre$,Body$,Ext$,ZFalse)
  538.       IF LEN(Pre$) > 64 OR LEN(Body$) > 8 OR LEN(Body$) < 1 OR LEN(Ext$) > 3 THEN _
  539.          EXIT SUB
  540.       WasXX = LEN(Body$)
  541.       IF WasXX => 3 THEN _
  542.          IF INSTR("PRN:CON:AUX:NUL:",Body$) THEN _
  543.             GOTO 20742
  544.       IF WasXX => 4 THEN _
  545.          IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",Body$) THEN _
  546.             GOTO 20742
  547.       Result = 1
  548.       EXIT SUB
  549. 20742 ZViolationsThisSession = ZMaxViolations
  550.       ZViolation$ = ZViolation$ + _
  551.                    FilName$
  552.       Result = 3
  553.       END SUB
  554. '
  555. 21105 ' $SUBTITLE: 'Library - sub to support Library downloads'
  556. ' $PAGE
  557. '
  558. '  NAME    -- Library
  559. '
  560. '  INPUTS  --     PARAMETER                    MEANING
  561. '              ZSubParm                 1 = DISPLAY ACTIVE AREA
  562. '                                       2 = CHANGE ACTIVE AREA
  563. '                                       3 = DISPLAY PC-SIG
  564. '                                           DISCLAIMER
  565. '                                       4 = ARCHIVE Library DISK
  566. '                                       5 = DOWNLOAD COMPLETED
  567. '              ZLibType                 0 = No Library ACTIVE
  568. '                                       1 = Library FROM PC-SIG
  569. '              ZLibDrive$                   Library DRIVE ID
  570. '
  571. '  OUTPUTS -- NONE
  572. '
  573. '  PURPOSE -- To provide access support for library drives
  574. '
  575.       SUB Library STATIC
  576.       STATIC LibSubdirName$(1)
  577.       STATIC DiskTitle$
  578.       ZErrCode = 0
  579.       IF ZLibType = 0 THEN _
  580.          EXIT SUB
  581.       IF ZLibDiskChar$ = "" THEN _
  582.          ZLibDiskChar$ = "0000"
  583.       ON ZSubParm GOTO 21110, 21115, 21130, 21140, 21159
  584. 21110 IF ZLibDiskChar$ = "0000" THEN _
  585.          ZOutTxt$ = "No Library disk currently selected" _
  586.       ELSE ZOutTxt$ = "Library disk " + _
  587.                 ZLibDiskChar$ + _
  588.                 " selected - " + _
  589.                 DiskTitle$
  590.       CALL QuickTPut1 (ZOutTxt$)
  591.       IF LibDiskArc$ = "" THEN _
  592.          EXIT SUB
  593.       IF INSTR(ZLibDiskArc$,"ARC") THEN _
  594.          Extension$ = "ARC" _
  595.       ELSE IF INSTR(ZLibDiskArc$,"ZIP") THEN _
  596.          Extension$ = "ZIP" _
  597.       ELSE IF INSTR(ZLibDiskArc$,"LHA") THEN _
  598.          Extension$ = "LHZ" _
  599.       ELSE Extension$ = ZDefaultExtension$
  600.       FOR LibDisplayCount = 0 TO LibLoopCount - 1
  601.          IF LibSubdirName$(LibDisplayCount) <> "" THEN _
  602.             CALL QuickTPut1 (LibSubdirName$(LibDisplayCount) + _
  603.                        "." + Extension$ + " ready for transmission!")
  604.       NEXT
  605.       EXIT SUB
  606. 21115 IF ZWasQ = 1 THEN _
  607.          ZOutTxt$ = "Change Library disk from " + _
  608.               ZLibDiskChar$ + _
  609.               " to (1 -" + _
  610.               STR$(ZLibMaxDisk) + _
  611.               ")" : _
  612.          ZSubParm = 1 : _
  613.          CALL TGet : _
  614.          IF ZSubParm = -1 THEN _
  615.             EXIT SUB _
  616.          ELSE IF ZWasQ = 0 THEN _
  617.                  ZLibDiskChar$ = "0000" : _
  618.                  ChdirLib$ = ZLibDrive$ + _
  619.                                   "\" : _
  620.                  GOTO 21126
  621. 21117 IF VAL(ZUserIn$(ZWasQ)) < 1 OR VAL(ZUserIn$(ZWasQ)) > ZLibMaxDisk THEN _
  622.          ZWasQ = 1 : _
  623.          GOTO 21115
  624. 21120 ZLibDiskChar$ = ZUserIn$(ZWasQ)
  625.       CLOSE 2
  626.       ZLibDiskChar$ = RIGHT$("0000" + ZLibDiskChar$,4)
  627. 21121 CALL FindIt("RBBS-CDR.DEF")
  628.       IF NOT ZOK THEN _
  629.          EXIT SUB
  630. 21122 IF EOF(2) THEN _
  631.          ZLibDiskChar$ = "" : _
  632.          EXIT SUB
  633.       INPUT #2,WorkSubdir$,ChdirLib$
  634.       LINE INPUT #2,DiskTitle$
  635.       IF ZLibDiskChar$ = WorkSubdir$ THEN _
  636.          ChdirLib$ = ZLibDrive$ + _
  637.                           ChdirLib$ : _
  638.          GOTO 21126
  639.       GOTO 21122
  640. 21126 ZErrCode = 0
  641.       CALL ChangeDir (ChdirLib$)
  642.       IF ZErrCode <> 0 THEN _
  643.          ZLibDiskChar$ = "0000" : _
  644.          ChdirLib$ = ZLibDrive$ + _
  645.                           "\" : _
  646.          GOTO 21126
  647.       EXIT SUB
  648. 21130 IF ZLibType <> 1 THEN _
  649.          EXIT SUB
  650.       CALL SkipLine(1)
  651.       ZOutTxt$ = "The PC-SIG Library file that you are about to "
  652.       CALL QuickTPut1 (ZOutTxt$)
  653.       ZOutTxt$ = "download can also be ordered as DISK " + _
  654.            ZLibDiskChar$
  655.       CALL QuickTPut1 (ZOutTxt$)
  656.       ZOutTxt$ = "from PC-SIG, 1030D East Duane Ave. Sunnyvale, Ca. 94086"
  657.       CALL QuickTPut (ZOutTxt$,2)
  658.       EXIT SUB
  659. 21140 IF ZLibDiskChar$ = "0000" THEN _
  660.          CALL QuickTPut1 ("First select a Library disk!") : _
  661.          EXIT SUB
  662.       ZOutTxt$ = "Archive files in Library disk - " + _
  663.            ZLibDiskChar$ + _
  664.            " for download (Y/[N])"
  665.       ZSubParm = 1
  666.       CALL TGet
  667.       IF NOT ZLocalUser THEN _
  668.          IF ZSubParm = -1 THEN _
  669.             EXIT SUB
  670.       IF NOT ZYes THEN _
  671.          EXIT SUB
  672. 21145 CALL KillWork (ZLibWorkDiskPath$ + _
  673.                     ZLibNodeID$ + _
  674.                     "DK*." + Extension$)
  675. 21150 CALL QuickTPut1 ("Work/RAM disk purged")
  676.       CALL QuickTPut1 ("Archiving with " + _
  677.                   ZLibArcProgram$ + _
  678.                   " Please be patient!")
  679.       REDIM LibSubdirName$(10)
  680.       LibSubdirChar$ = ""
  681.       LibLoopCount = 0
  682.       GOSUB 21157
  683.       ZOutTxt$ = "Contents of Library disk - " + _
  684.            ZLibDiskChar$ + _
  685.            " now archived for download"
  686.       CALL QuickTPut1 (ZOutTxt$)
  687.       ZOutTxt$ = "Searching for Sub-directories"
  688.       CALL QuickTPut1 (ZOutTxt$)
  689.       GOSUB 21158
  690.       LibDiskArc$ = ZLibDiskChar$
  691. '
  692. ' SEARCH AND ARCHIVE ANY SUBDIRECTORIES
  693. '
  694.       Treedir$ = ZLibWorkDiskPath$ + _
  695.                  ZLibNodeID$ + _
  696.                  "DKDIR.LST"
  697.       DirCmd$ = "DIR " + _
  698.                 ZLibDrive$ + _
  699.                 " | FIND " +  _
  700.                 CHR$(34) + _
  701.                 " <DIR> " + _
  702.                 CHR$(34) + _
  703.                 "  > " + _
  704.                 Treedir$
  705. 21151 SHELL DirCmd$
  706.       CALL SkipLine (2)
  707.       LOCATE 24,1
  708.       ZErrCode = 0
  709. 21152 CLOSE 2
  710. 21153 CALL OpenWork (2,Treedir$)
  711.       LibSubdirCount = 0
  712.       WHILE NOT EOF(2)
  713.          LINE INPUT #2, Dirrec$
  714.          IF LEFT$(Dirrec$,1) <> "." THEN _
  715.             LibSubdirCount = LibSubdirCount + 1 : _
  716.             LibSubdirName$(LibSubdirCount) = _
  717.             LEFT$(Dirrec$,8)
  718.       WEND
  719.       CLOSE 2
  720.       LibLoopCount = 1
  721.       IF LibSubdirCount = 0 THEN _
  722.          GOTO 21156
  723.       ZOutTxt$ = STR$(LibSubdirCount) + _
  724.            " Subdirectories on Library disk - " + _
  725.            ZLibDiskChar$
  726.       CALL QuickTPut1 (ZOutTxt$)
  727.       FOR LibLoopCount = 1 TO LibSubdirCount
  728.          IF NOT ZLocalUser THEN _
  729.             CALL Carrier : _
  730.             IF ZSubParm THEN _
  731.                GOTO 21155
  732.          LibSubdirChar$ = MID$("ABCDEFGHI",LibLoopCount,1)
  733.          ZOutTxt$ = "Creating " + _
  734.               ZLibNodeID$ + _
  735.               "DK" + _
  736.               ZLibDiskChar$ + _
  737.               LibSubdirChar$ + "." + ZDefaultExtension$ + _
  738.               " using " + ZLibArcProgram$
  739.          CALL QuickTPut1 (ZOutTxt$)
  740.          CHDIR ChdirLib$ + _
  741.                "\" + _
  742.                LibSubdirName$(LibLoopCount)
  743.          GOSUB 21157
  744.          ZOutTxt$ = "Disk - " + _
  745.               ZLibDiskChar$ + _
  746.               "; Subdirectory" + _
  747.               " -" + _
  748.               STR$(LibLoopCount) + _
  749.               " archived for download"
  750.          CALL QuickTPut1 (ZOutTxt$)
  751.          GOSUB 21158
  752. 21155 NEXT LibLoopCount
  753. 21156 CALL Carrier
  754.       ZOutTxt$ = ""
  755.       EXIT SUB
  756. 21157 LibArc$ = ZLibArcPath$ + _
  757.                        ZLibArcProgram$ + _
  758.                        " " + _
  759.                        ZLibWorkDiskPath$ + _
  760.                        ZLibNodeID$ + _
  761.                        "DK" + _
  762.                        ZLibDiskChar$ + _
  763.                        LibSubdirChar$ + _
  764.                        " " + _
  765.                        ZLibDrive$ + _
  766.                        "*.*"
  767.       IF ZUseDeviceDriver$ <> "" AND ZFossil AND NOT ZLocalUser THEN _
  768.          LibArc$ = ZDiskForDos$ + _
  769.                             "COMMAND /C " + _
  770.                             LibArc$ + _
  771.                             " > " + _
  772.                             ZUseDeviceDriver$
  773.       SHELL LibArc$
  774.       CALL SkipLine (2)
  775.       LOCATE 24,1
  776.       RETURN
  777. 21158 LibSubdirName$(LibLoopCount) = ZLibNodeID$ + _
  778.                                              "DK" + _
  779.                                              ZLibDiskChar$ + _
  780.                                              LibSubdirChar$
  781.       RETURN
  782. 21159 FOR LibDisplayCount = 0 TO LibLoopCount - 1
  783.          IF LibSubdirName$(LibDisplayCount) = ZOutTxt$ THEN _
  784.             LibSubdirName$(LibDisplayCount) = ""
  785.       NEXT
  786.       END SUB
  787. 21598 ' $SUBTITLE: 'XferType - sub to identify file xfer protocol'
  788. ' $PAGE
  789. '
  790. '  NAME    -- XferType
  791. '
  792. '  INPUTS  --     PARAMETER                    MEANING
  793. '               Index            = 1       Manual select for up/download
  794. '                                = 2       Default select
  795. '                                = 3       Set transfer default
  796. '               ZOutTxt$
  797. '               ZUserIn$(1)
  798. '               ZWasQ
  799. '               ZReliableMode
  800. '               ZTransferOption$
  801. '               ZUserXferDefault$
  802. '               ZXferSupport
  803. '
  804. '  OUTPUTS   -- ZCheckSum
  805. '               ZFLen
  806. '               ZWasFT$
  807. '
  808. '  PURPOSE -- To identify the file transfer protocol (either
  809. '             from the user's default or via explicit selection)
  810. '
  811.       SUB XferType (Index,SkipHelp) STATIC
  812.       IF ZTransferOption$ = "" OR ZUserSecLevel <> PrevUSL THEN _
  813.          CALL Protocol : _
  814.          PrevUSL = ZUserSecLevel
  815.       WasX$ = ZOutTxt$ + "Protocol"
  816.       ON Index GOTO 21600,21620,21600
  817. '
  818. '
  819. ' *  MANUAL SELECT OF Transfer Protocol
  820. '
  821. '
  822. 21600 IF SkipHelp THEN _
  823.          GOTO 21604
  824. 21602 CALL BufFile (ZHelpPath$ + "UF" + ZHelpExtension$,WasX)
  825.       IF ZSubParm = -1 THEN _
  826.          EXIT SUB
  827. 21604 ZStopInterrupts = ZTrue
  828.       IF Index = 3 THEN _
  829.          IF ZAnsIndex < ZLastIndex THEN _
  830.             GOTO 21605
  831.       CALL QuickTPut1 (WasX$)
  832.       CALL BufString (ZTransferOption$,4096,WasX)
  833.       CALL QuickTPut (MID$("?!",1-ZTurboKeyUser,1)+" ",0)
  834. 21605 ZOutTxt$ = ""
  835.       ZTurboKey = -ZTurboKeyUser
  836.       ZMacroMin = 2
  837.       ZSubParm = 1
  838.       ZSuspendAutoLogoff = ZTrue
  839.       ZStackC = ZTrue
  840.       IF Index = 3 THEN _
  841.          CALL PopCmdStack : _
  842.          WasX = ZAnsIndex _
  843.       ELSE ZSubParm = 1 : _
  844.            CALL TGet : _
  845.            WasX = 1
  846.       ZSuspendAutoLogoff = ZFalse
  847.       IF ZSubParm = -1 THEN _
  848.          EXIT SUB
  849.       IF ZWasQ = 0 THEN _
  850.          GOTO 21604
  851. 21606 ZWasZ$ = ZUserIn$(WasX)
  852. '
  853. '
  854. ' *  DEFAULT SELECT OF Transfer Protocol
  855. '
  856. '
  857. 21610 CALL AllCaps (ZWasZ$)
  858.       IF INSTR("H",ZWasZ$) > 0 THEN _
  859.          GOTO 21602
  860.       ZFF = INSTR(ZDefaultXfer$,ZWasZ$)
  861.       IF ZFF < 1 THEN _
  862.          GOTO 21600
  863. 21612 ZWasFT$ = MID$(ZDefaultXfer$,ZFF,1)
  864.       ZInternalProt$ = MID$(ZInternalEquiv$,ZFF,1)
  865.       GOTO 21621
  866. 21620 ZFF = -1
  867.       IF ZCmdTransfer$ <> "" THEN _
  868.          ZWasZ$ = ZCmdTransfer$ : _
  869.          GOTO 21610
  870.       WasX = INSTR(ZDefaultXfer$,ZUserXferDefault$)
  871.       IF WasX > 0 THEN _
  872.          IF MID$(ZInternalEquiv$,WasX,1) <> "N" THEN _
  873.             ZWasZ$ = ZUserXferDefault$ : _
  874.             GOTO 21610
  875.       ZProtoPrompt$ = "None"
  876.       ZFF = 0
  877.       EXIT SUB
  878. 21621 IF ZFF = PrevFF AND PrevProtoDef$ = ZProtoDef$ THEN _
  879.          ZProtoPrompt$ = PrevProtoPrompt$ : _
  880.          EXIT SUB
  881.       PrevFF = ZFF
  882.       PrevProtoDef$ = ZProtoDef$
  883.       ZInternalProt$ = MID$(ZInternalEquiv$,ZFF,1)
  884.       ZCheckSum = (ZInternalProt$ = "X")
  885.       CALL FindIt (ZProtoDef$)
  886.       IF ZOK THEN _
  887.          GOTO 21623
  888.       WasX = INSTR("AXCYN",ZInternalProt$)
  889.       IF WasX < 1 THEN _
  890.          ZInternalProt$ = "N"
  891.       ZProtoPrompt$ = MID$("Ascii     Xmodem    Xmodem/CRCYmodem    None",10*INSTR("AXCYN",ZInternalProt$)-9,10)
  892.       CALL TrimTrail (ZProtoPrompt$," ")
  893.       ZCheckSum = (ZInternalProt$ = "X")
  894.       ZFLen = 128 - 896 * (ZInternalProt$ = "Y")
  895.       ZBlockSize = ZFLen
  896.       IF ZInternalProt$ = "Y" THEN _
  897.          ZSpeedFactor! = 0.87 _
  898.       ELSE IF ZInternalProt$ = "A" THEN _
  899.          ZSpeedFactor! = 0.92 _
  900.       ELSE ZSpeedFactor! = 0.78
  901.       GOTO 21625
  902. 21623 CALL ReadParms (ZWorkAra$(),13,ZFF)
  903.       IF ZErrCode > 0 THEN _
  904.          ZFF = LEN(ZDefaultXfer$) : _
  905.          ZProtoPrompt$ = "None" : _
  906.          GOTO 21625
  907.       ZProtoPrompt$ = ZWorkAra$(1)
  908.       IF LEN(ZProtoPrompt$) > 2 THEN _
  909.          IF MID$(ZProtoPrompt$,2,1) = ")" THEN _
  910.             ZProtoPrompt$ = LEFT$(ZProtoPrompt$,1) + MID$(ZProtoPrompt$,3)
  911.       WasX = INSTR(ZProtoPrompt$+ZCrLf$,ZCrLf$)
  912.       ZProtoPrompt$ = LEFT$(ZProtoPrompt$,WasX-1)
  913.       CALL Trim (ZProtoPrompt$)
  914.       ZProtoMethod$ = LEFT$(ZWorkAra$(3),1)
  915.       CALL AllCaps (ZProtoMethod$)
  916.       ZReq8Bit = (LEFT$(ZWorkAra$(4),1) = "8")
  917.       ZDownTemplate$ = ZWorkAra$(12)
  918.       ZUpTemplate$ = ZWorkAra$(13)
  919.       WasX$ = ZWorkAra$(11)
  920.       WasX = INSTR(WasX$,"=")
  921.       ZAdvanceProtoWrite = ZFalse
  922.       IF WasX < 2 OR WasX >= LEN(WasX$) THEN _
  923.          ZFailureParm = 4 : _
  924.          ZFailureString$ = "F" _
  925.       ELSE ZFailureParm = VAL(LEFT$(WasX$,WasX-1)) : _
  926.            ZFailureString$ = MID$(WasX$,WasX+1) : _
  927.            WasX = INSTR(ZFailureString$,"=") : _
  928.            IF WasX > 0 THEN _
  929.               ZAdvanceProtoWrite = (MID$(ZFailureString$,WasX) = "=A") : _
  930.               ZFailureString$ = LEFT$(ZFailureString$,WasX-1)
  931.       ZProtoMacro$ = ZWorkAra$(10)
  932.       ZFakeXRpt = (LEFT$(ZWorkAra$(8),1) = "F")
  933.       ZBatchProto = (LEFT$(ZWorkAra$(6),1) = "B")
  934.       ZSpeedFactor! = VAL(ZWorkAra$(9))
  935.       IF ZSpeedFactor! < 0.1 THEN _
  936.          ZSpeedFactor! = 0.87
  937.       ZBlockSize = VAL(ZWorkAra$(7))
  938.       ZFLen = ZBlockSize
  939.       IF ZFLen < 1 THEN _
  940.          ZFLen = 128
  941. 21625 PrevProtoPrompt$ = ZProtoPrompt$
  942.       END SUB
  943. 21993 ' $SUBTITLE: 'FileLock - subroutine to share RBBS-PC files'
  944. ' $PAGE
  945. '
  946. '  NAME    -- FileLock
  947. '
  948. '  INPUTS  --     PARAMETER                    MEANING
  949. '             ZSubParm               = 1 UNLOCK USERS AND MESSAGES
  950. '                                      2 FLUSH MESSAGE RECORD TO DISK
  951. '                                        AND UNLOCK MESSAGES
  952. '                                      3 LOCK MESSAGE FILE
  953. '                                      4 UNLOCK MESSAGE FILE
  954. '                                      5 LOCK USER FILE
  955. '                                      6 LOCK 4 RECORD BLOCK IN USER
  956. '                                        FILE
  957. '                                      7 UNLOCK USER FILE
  958. '                                      8 UNLOCK 4 RECORD BLOCK IN USER
  959. '                                        FILE
  960. '                                      9 LOCK UPLOAD DIRECTORY OR
  961. '                                        COMMENTS FILE
  962. '                                     10 UNLOCK UPLOAD DIRECTORY OR
  963. '                                        COMMENTS FILE
  964. '               ACTIVE.MESSAGE FILE$     NAME OF MESSAGE FILE
  965. '               ZActiveUserFile$         NAME OF USER FILE
  966. '               CONFIG.FILE.NAME$        FILE NAME TO FLUSH RECORD FROM
  967. '               ZWasEN$                  UPLOAD DIRECTORY OR COMMENTS
  968. '                                        FILE NAME TO LOCK/UNLOCK
  969. '               ZNetworkType             TYPE OF NETWORK LOCKING TO USE
  970. '
  971. '  OUTPUTS -- ZSubParm = -1 TERMINATE RBBS-PC IMMEDATELY
  972. '             ZBlk
  973. '             ZLockDrive
  974. '             ZLockFileName$
  975. '             ZLockStatus$
  976. '             ZMsgFileLock
  977. '             ZUserBlockLock
  978. '             ZUserFileLock
  979. '             ZUserFileIndex
  980. '
  981. '  PURPOSE -- To lock and unlock the shared RBBS-PC files when
  982. '             multiple copies of RBBS-PC are sharing the same
  983. '             files in either a multi-tasking DOS environment or
  984. '             in a local area network environment
  985. '
  986.       SUB FileLock STATIC
  987.       ON ZSubParm GOSUB 21995,21996,22000,25000,26000, _
  988.                                     26500,27000,27500,29000,29500
  989.       EXIT SUB
  990. '
  991. '
  992. ' *  UNLOCK USERS AND MESSAGES
  993. '
  994. '
  995. 21995 GOSUB 27000
  996.       GOSUB 25000
  997.       RETURN
  998. '
  999. '
  1000. ' *  FLUSH MESSAGE FILE DATA TO DISK BY OPENING DUMMY FILE # 1
  1001. '
  1002. '
  1003. 21996 CLOSE 1
  1004.       IF ZShareIt THEN _
  1005.          OPEN ZConfigFileName$ FOR INPUT SHARED AS #1 _
  1006.       ELSE OPEN "I",1,ZConfigFileName$
  1007. '
  1008. '
  1009. ' *  UNLOCK MESSAGES
  1010. '
  1011. '
  1012.       GOSUB 25000
  1013.       CALL OpenMsg
  1014.       RETURN
  1015. '
  1016. '
  1017. ' *  LOCK MESSAGE FILE
  1018. '
  1019. '
  1020. 22000 IF ZMsgFileLock = ZTrue THEN _
  1021.          RETURN
  1022.       ZMsgFileLock = ZTrue
  1023.       MID$(ZLockStatus$,1,2) = "LM"
  1024.       ZSubParm = 2
  1025.       CALL Line25
  1026.       ZLockFileName$ = ZActiveMessageFile$
  1027.       ON ZNetworkType GOTO 22100,22200,22300,22400,22500,29700
  1028.       RETURN
  1029. '
  1030. '
  1031. ' *  LOCK MESSAGE FILE (MULTI-LINK)
  1032. '
  1033. '
  1034. 22100 WasAX = &H0
  1035.       WasBX = &H1
  1036.       IF ZMultiLinkPresent > 0 THEN _
  1037.          CALL RBBSML(WasAX,WasBX)
  1038.       RETURN
  1039. '
  1040. '
  1041. ' *  LOCK MESSAGE FILE (OMNINET)
  1042. '
  1043. '
  1044. 22200 CALL BreakFileName (ZActiveMessageFile$,Drive$,Prefix$,Ext$,ZFalse)
  1045.       WasCC$ = CHR$(1) + _
  1046.             LEFT$(Prefix$ + SPACE$(8),8)
  1047.       GOSUB 28000
  1048.       IF WasCT = 0 THEN _
  1049.          RETURN
  1050.       CALL DelayTime (1)
  1051.       GOTO 22200
  1052. '
  1053. '
  1054. ' *  LOCK MESSAGE FILE (ORCHID PC-NET)
  1055. ' *  LOCK USER FILE (ORCHID PC-NET)
  1056. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (ORCHID PC-NET)
  1057. '
  1058. '
  1059. 22300 GOSUB 28100
  1060.       CALL LPLKIT(ZLockDrive,ZLockFileName$,ZWasA)
  1061.       RETURN
  1062. '
  1063. '
  1064. ' *  LOCK SYSTEM (DESQview)
  1065. '
  1066. '
  1067. 22400 CALL DVLock("MESSAGE")
  1068.       RETURN
  1069. '
  1070. '
  1071. ' *  LOCK MESSAGE FILE (10 NET)
  1072. ' *  LOCK USER FILE (10 NET)
  1073. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (10 NET)
  1074. '
  1075. '
  1076. 22500 GOSUB 28100
  1077.       CALL LPLK10(ZLockDrive,ZLockFileName$,ZWasA)
  1078.       RETURN
  1079. '
  1080. '
  1081. ' *  UNLOCK MESSAGE FILE
  1082. '
  1083. '
  1084. 25000 IF NOT ZMsgFileLock THEN _
  1085.          RETURN
  1086.       ZMsgFileLock = ZFalse
  1087.       MID$(ZLockStatus$,1,2) = "UM"
  1088.       ZSubParm = 2
  1089.       CALL Line25
  1090.       ZLockFileName$ = ZActiveMessageFile$
  1091.       ON ZNetworkType GOTO 25100,25200,25300,25400,25500,29800
  1092.       RETURN
  1093. '
  1094. '
  1095. ' *  UNLOCK MESSAGE FILE (MULTI-LINK)
  1096. '
  1097. '
  1098. 25100 WasAX = &H100
  1099.       WasBX = &H1
  1100.       IF ZMultiLinkPresent > 0 THEN _
  1101.          CALL RBBSML(WasAX,WasBX)
  1102.       RETURN
  1103. '
  1104. '
  1105. ' *  UNLOCK MESSAGE FILE (OMNINET)
  1106. '
  1107. '
  1108. 25200 CALL BreakFileName (ZActiveMessageFile$,Drive$,Prefix$,Ext$,ZFalse)
  1109.       WasCC$ = CHR$(17) + _
  1110.             LEFT$(Prefix$ + SPACE$(8),8)
  1111.       GOSUB 28000
  1112.       IF WasCT = 128 THEN _
  1113.          RETURN
  1114.       CALL DelayTime (1)
  1115.       GOTO 25200
  1116. '
  1117. '
  1118. ' *  UNLOCK MESSAGE FILE (ORCHID PC-NET)
  1119. ' *  UNLOCK USER FILE (ORCHID PC-NET)
  1120. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (ORCHID PC-NET)
  1121. '
  1122. '
  1123. 25300 GOSUB 28100
  1124.       CALL UNLOKIT(ZLockDrive,ZLockFileName$,ZWasA)
  1125.       RETURN
  1126. '
  1127. '
  1128. ' *  UNLOCK MESSAGE FILE (DESQVIEW)
  1129. '
  1130. '
  1131. 25400 CALL DVUnlock("MESSAGE")
  1132.       RETURN
  1133. '
  1134. '
  1135. ' *  UNLOCK MESSAGE FILE (10 NET)
  1136. ' *  UNLOCK USER FILE (10 NET)
  1137. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (10 NET)
  1138. '
  1139. '
  1140. 25500 GOSUB 28100
  1141.       CALL UNLOK10(ZLockDrive,ZLockFileName$,ZWasA)
  1142.       RETURN
  1143.  
  1144. '
  1145. '
  1146. ' *  LOCK USER FILE
  1147. '
  1148. '
  1149. 26000 IF ZUserFileLock = ZTrue THEN _
  1150.          RETURN
  1151.       ZUserFileLock = ZTrue
  1152.       MID$(ZLockStatus$,4,2) = "LU"
  1153.       ZSubParm = 2
  1154.       CALL Line25
  1155.       ZLockFileName$ = ZActiveUserFile$
  1156.       ON ZNetworkType GOTO 26100,26200,22300,26300,22500,29720
  1157.       RETURN
  1158. '
  1159. '
  1160. ' *  LOCK USER FILE (MULTI-LINK)
  1161. '
  1162. '
  1163. 26100 WasAX = &H0
  1164.       WasBX = &H2
  1165.       IF ZMultiLinkPresent > 0 THEN _
  1166.          CALL RBBSML(WasAX,WasBX)
  1167.       RETURN
  1168. '
  1169. '
  1170. ' *  LOCK USER FILE (OMNINET)
  1171. '
  1172. '
  1173. 26200 CALL BreakFileName (ZActiveUserFile$,Drive$,Prefix$,Ext$,ZFalse)
  1174.       WasCC$ = CHR$(1) + _
  1175.             LEFT$(Prefix$ + SPACE$(8),8)
  1176.       GOSUB 28000
  1177.       IF WasCT = 0 THEN _
  1178.          RETURN
  1179.       CALL DelayTime (1)
  1180.       GOTO 26200
  1181. '
  1182. '
  1183. ' *  LOCK USER FILE (DESQVIEW)
  1184. '
  1185. '
  1186. 26300 CALL DVLock("USER")
  1187.       RETURN
  1188. '
  1189. '
  1190. ' *  LOCK 4 RECORD BLOCK IN USER FILE
  1191. '
  1192. '
  1193. 26500 IF ZUserBlockLock = ZTrue THEN _
  1194.          RETURN
  1195.       ZUserBlockLock = ZTrue
  1196.       ZBlk = (ZUserFileIndex / 4) + .26
  1197.       MID$(ZLockStatus$,7,2) = "LB"
  1198.       ZSubParm = 2
  1199.       CALL Line25
  1200.       ON ZNetworkType GOTO 26600,26700,26800,26750,26900,29730
  1201.       RETURN
  1202. '
  1203. '
  1204. ' *  LOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)
  1205. '
  1206. '
  1207. 26600 WasAX = &H0
  1208.       WasBX = ZBlk + 10
  1209.       IF ZMultiLinkPresent > 0 THEN _
  1210.          CALL RBBSML(WasAX,WasBX)
  1211.       RETURN
  1212. '
  1213. '
  1214. ' *  LOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
  1215. '
  1216. '
  1217. 26700 WasCC$ = CHR$(1) + _
  1218.             "BLK" + _
  1219.             RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1220.       GOSUB 28000
  1221.       IF WasCT = 0 THEN _
  1222.          RETURN
  1223.       CALL DelayTime (1)
  1224.       GOTO 26700
  1225. '
  1226. '
  1227. ' *  LOCK 4 RECORD BLOCK IN USER FILE (DESKVIEW)
  1228. '
  1229. '
  1230. 26750 CALL DVLock("BLK" + RIGHT$("0000" + MID$(STR$(ZBlk),2),5))
  1231.       RETURN
  1232. '
  1233. '
  1234. ' *  LOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)
  1235. '
  1236. '
  1237. 26800 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
  1238.                         "BLK" + _
  1239.                         RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1240.       GOTO 22300
  1241. '
  1242. '
  1243. ' *  LOCK 4 RECORD BLOCK IN USER FILE (10 NET)
  1244. '
  1245. '
  1246. 26900 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
  1247.                         "BLK" + _
  1248.                         RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1249.       GOTO 22500
  1250. '
  1251. '
  1252. ' *  UNLOCK USER FILE
  1253. '
  1254. '
  1255. 27000 IF NOT ZUserFileLock THEN _
  1256.          RETURN
  1257.       ZUserFileLock = ZFalse
  1258.       MID$(ZLockStatus$,4,2) = "UU"
  1259.       ZSubParm = 2
  1260.       CALL Line25
  1261.       ZLockFileName$ = ZActiveUserFile$
  1262.       ON ZNetworkType GOTO 27100,27200,25300,27300,25500,29820
  1263.       RETURN
  1264. '
  1265. '
  1266. ' *  UNLOCK USER FILE (MULTI-LINK)
  1267. '
  1268. '
  1269. 27100 WasAX = &H100
  1270.       WasBX = &H2
  1271.       IF ZMultiLinkPresent > 0 THEN _
  1272.          CALL RBBSML(WasAX,WasBX)
  1273.       RETURN
  1274. '
  1275. '
  1276. ' *  UNLOCK USER FILE (OMNINET)
  1277. '
  1278. '
  1279. 27200 CALL BreakFileName (ZActiveUserFile$,Drive$,Prefix$,Ext$,ZFalse)
  1280.       WasCC$ = CHR$(17) + _
  1281.             LEFT$(Prefix$ + SPACE$(8),8)
  1282.       GOSUB 28000
  1283.       IF WasCT = 128 THEN _
  1284.          RETURN
  1285.       CALL DelayTime (1)
  1286.       GOTO 27200
  1287. '
  1288. '
  1289. ' *  UNLOCK USER FILE (DESQVIEW)
  1290. '
  1291. '
  1292. 27300 CALL DVUnlock("USER")
  1293.       RETURN
  1294. '
  1295. '
  1296. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE
  1297. '
  1298. '
  1299. 27500 IF NOT ZUserBlockLock THEN _
  1300.          RETURN
  1301.       ZUserBlockLock = ZFalse
  1302.       ZBlk = (ZUserFileIndex / 4) + .26
  1303.       MID$(ZLockStatus$,7,2) = "UB"
  1304.       ZSubParm = 2
  1305.       CALL Line25
  1306.       ON ZNetworkType GOTO 27600,27700,27800,27750,27900,29830
  1307.       RETURN
  1308. '
  1309. '
  1310. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)
  1311. '
  1312. '
  1313. 27600 WasAX = &H100
  1314.       WasBX = ZBlk + 10
  1315.       IF ZMultiLinkPresent > 0 THEN _
  1316.          CALL RBBSML(WasAX,WasBX)
  1317.       RETURN
  1318. '
  1319. '
  1320. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
  1321. '
  1322. '
  1323. 27700 WasCC$ = CHR$(17) + _
  1324.             "BLK" + _
  1325.             RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1326.       GOSUB 28000
  1327.       IF WasCT = 128 THEN _
  1328.          RETURN
  1329.       CALL DelayTime (1)
  1330.       GOTO 27700
  1331. '
  1332. '
  1333. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (DESQVIEW)
  1334. '
  1335. '
  1336. 27750 CALL DVUnlock("BLK" + RIGHT$("0000" + MID$(STR$(ZBlk),2),5))
  1337.       RETURN
  1338. '
  1339. '
  1340. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)
  1341. '
  1342. '
  1343. 27800 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
  1344.                         "BLK" + _
  1345.                         RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1346.       GOTO 25300
  1347. '
  1348. '
  1349. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (10-NET)
  1350. '
  1351. '
  1352. 27900 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
  1353.                         "BLK" + _
  1354.                         RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1355.       GOTO 25500
  1356. '
  1357. '
  1358. ' *  CORVUS OMNINET INTERFACE
  1359. '
  1360. '
  1361. 28000 WasCC$ = ZLineFeed$ + _
  1362.             CHR$(0) + _
  1363.             CHR$(11) + _
  1364.             WasCC$
  1365.       CALL CDSend(WasCC$)
  1366.       CALL CDRecv(ZWasCN$)
  1367.       WasCT = ASC(MID$(ZWasCN$,3,1))
  1368.       IF WasCT => 128 THEN _
  1369.          CALL LPrnt("CORVUS LOCK FAIL",1) : _
  1370.          ZSubParm = -1
  1371. 28010 WasCT = ASC(MID$(ZWasCN$,4,1))
  1372.       IF WasCT => 129 THEN _
  1373.          CALL LPrnt("CORVUS FULL",1) : _
  1374.          ZSubParm = -1
  1375.       RETURN
  1376. '
  1377. '
  1378. ' *  ORCHID PC-NET & 10 NET INTERFACE
  1379. '
  1380. '
  1381. 28100 CALL AllCaps (ZLockFileName$)
  1382.       ZLockDrive = ASC(LEFT$(ZLockFileName$,1)) - ASC("A")
  1383.       ZLockFileName$ = ZLockFileName$ + _
  1384.                         STRING$(32 - LEN(ZLockFileName$),0)
  1385.       ZWasA = 0
  1386.       RETURN
  1387. '
  1388. '
  1389. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$
  1390. '
  1391. '
  1392. 29000 IF LockedEn$ = ZWasEN$ THEN _
  1393.          RETURN
  1394.       LockedEn$ = ZWasEN$
  1395.       MID$(ZLockStatus$,10,2) = "LD"
  1396.       ZSubParm = 2
  1397.       CALL Line25
  1398.       ZLockFileName$ = ZWasEN$
  1399.       ON ZNetworkType GOTO 29100,29010,22300,29300,22500,29710
  1400. 29010 RETURN
  1401. '
  1402. '
  1403. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (MULTI-LINK)
  1404. '
  1405. '
  1406. 29100 WasAX = &H0
  1407.       WasBX = &H3
  1408.       IF ZMultiLinkPresent > 0 THEN _
  1409.          CALL RBBSML(WasAX,WasBX)
  1410.       RETURN
  1411. '
  1412. '
  1413. ' *  LOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
  1414. '
  1415. '
  1416. 29300 CALL DVLock("MISC")
  1417.       RETURN
  1418. '
  1419. '
  1420. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$
  1421. '
  1422. '
  1423. 29500 IF LockedEn$ <> ZWasEN$ THEN _
  1424.          RETURN
  1425.       LockedEn$ = ""
  1426.       MID$(ZLockStatus$,10,2) = "UD"
  1427.       ZSubParm = 2
  1428.       CALL Line25
  1429.       ZLockFileName$ = ZWasEN$
  1430.       ON ZNetworkType GOTO 29600,29510,25300,29650,25500,29810
  1431. 29510 RETURN
  1432. '
  1433. '
  1434. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (MULTI-LINK)
  1435. '
  1436. '
  1437. 29600 WasAX = &H100
  1438.       WasBX = &H3
  1439.       IF ZMultiLinkPresent > 0 THEN _
  1440.          CALL RBBSML(WasAX,WasBX)
  1441.       EXIT SUB
  1442. '
  1443. '
  1444. ' *  UNLOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
  1445. '
  1446. '
  1447. 29650 CALL DVUnlock("MISC")
  1448.       RETURN
  1449. '
  1450. '
  1451. ' *  NetBIOS SEMAPHORE LOCK MECHANISM
  1452. ' *     Only the USERS file is actually locked.  All other files are locked
  1453. ' *     by means of the semaphore file IBMFLAGS.  Each IBMFLAGS record is a
  1454. ' *     file semaphore as follows:
  1455. ' *        RECORD 1 = MESSAGES file lock status
  1456. ' *        RECORD 2 = Comments/Upload dir locked
  1457. ' *        RECORD 3 = entire USERS file lock
  1458. '
  1459. '
  1460. ' * Lock MESSAGES
  1461. 29700 CALL NetBIOS (1,6,1)
  1462.       RETURN
  1463.  
  1464. ' * Lock Comments/Upload dir
  1465. 29710 CALL NetBIOS (1,6,2)
  1466.       RETURN
  1467.  
  1468. ' * Lock USERS file
  1469. 29720 CALL NetBIOS (1,6,3)
  1470.       RETURN
  1471.  
  1472. ' * Lock single USERS record
  1473. 29730 CALL NetBIOS (1,6,3)
  1474.       RETURN
  1475.  
  1476. ' * UNLOCK MESSAGES
  1477. 29800 CALL NetBIOS (0,6,1)
  1478.       RETURN
  1479.  
  1480. ' * UNLOCK Comments/Upload dir
  1481. 29810 CALL NetBIOS (0,6,2)
  1482.       RETURN
  1483.  
  1484. ' * UNLOCK USERS file
  1485. 29820 CALL NetBIOS (0,6,3)
  1486.       RETURN
  1487.  
  1488. ' * UNLOCK single USERS record
  1489. 29830 CALL NetBIOS (0,6,3)
  1490.       RETURN
  1491.       END SUB
  1492. 30000 ' $SUBTITLE: 'InitIBM - sub to create/open NetBIOS semaphore file'
  1493. ' $PAGE
  1494. '
  1495. '  NAME    -- InitIBM   (Written by Doug Azzarito)
  1496. '
  1497. '  INPUTS  -- NONE
  1498. '
  1499. '  OUTPUTS -- ZSubParm = -1   Abort RBBS
  1500. '
  1501. '  PURPOSE -- Open semaphore file "IBMFLAGS" on default drive as file #6
  1502. '             Create file if it does not exits.
  1503. '
  1504.       SUB InitIBM STATIC
  1505. '
  1506. '
  1507. ' *  SEE IF FILE EXISTS
  1508. '
  1509. '
  1510.       ZShareIt = ZTrue
  1511.       CALL BreakFileName (ZMainMsgFile$,IBMFlagFile$,Dummy$,Dummy$,ZTrue)
  1512.       IBMFlagFile$ = IBMFlagFile$ + _
  1513.                        "IBMFLAGS"
  1514.       CALL FindIt (IBMFlagFile$)
  1515.       CLOSE 2
  1516.       IF ZOK THEN _
  1517.          GOTO 30020
  1518. '
  1519. '
  1520. ' *  CREATE A NEW FILE, EACH RECORD IS A SEMAPHORE
  1521. '
  1522. '
  1523.       OPEN IBMFlagFile$ ACCESS WRITE AS #6 LEN=2
  1524.       FIELD 6, 2 AS LockBuf$
  1525.       LSET LockBuf$ = MKI$(0)
  1526.       FOR WasI = 1 TO 3
  1527.          PUT 6
  1528.       NEXT
  1529.       CLOSE #6
  1530. 30020 OPEN IBMFlagFile$ ACCESS READ WRITE SHARED AS #6 LEN=2
  1531.       END SUB
  1532. 30500 ' $SUBTITLE: 'OpenMsg - open the MESSAGES file'
  1533. ' $PAGE
  1534. '
  1535. '  NAME    -- OpenMsg
  1536. '
  1537. '  INPUTS  --     PARAMETER                    MEANING
  1538. '              ZActiveMessageFile$
  1539. '              ZShareIt
  1540. '
  1541. '  OUTPUTS --  ZMsgRec$
  1542. '
  1543.       SUB OpenMsg STATIC
  1544. '
  1545. '
  1546. ' *  OPEN AND DEFINE MESSAGE FILE
  1547. '
  1548. '
  1549.      CLOSE 1
  1550.       IF ZShareIt THEN _
  1551.          OPEN ZActiveMessageFile$ ACCESS READ WRITE SHARED AS #1 _
  1552.       ELSE OPEN "R",1,ZActiveMessageFile$
  1553.       FIELD 1,128 AS ZMsgRec$
  1554.       END SUB
  1555. 30595 ' $SUBTITLE: 'FindFKey - sub to handle local keyboard functions'
  1556. ' $PAGE
  1557. '
  1558. '  NAME    -- FindFKey
  1559. '
  1560. '  INPUTS  --  PARAMETER                 MEANING
  1561. '             ZActiveMenu$              INDICATOR OF ACTIVE MENU
  1562. '             ZAdjustedSecurity         Switch INDICATING TEMP. SECURITY CHANGE
  1563. '             ZAutoDownDesired          USER'S PREFERENCE FOR AUTODOWNLOADING
  1564. '             ZCallersFile$             NAME OF CALLERS FILE
  1565. '             ZChatAvail                Toggle INDICATING IF Sysop WILL CHAT
  1566. '             ZCheckBulletLogon         USER'S PREFERENCE FOR BULLETIN CHECK
  1567. '             ZConfMode                 INDICATOR THAT USER IS IN A CONFERENCE
  1568. '             ZCursorLine               LINE THAT THE CURSOR IS AT
  1569. '             ZCursorRow                ROW THAT THE CURSOR IS AT
  1570. '             ZDiskForDos$              DISK TO LOAD COMMAND.COM FROM
  1571. '             ZDiskFullGoOffline        INDICATOR OF WHAT TO DO WHEN DISK FULL
  1572. '             ZExitToDoors              FLAG INDICATING EXITING TO DOORS
  1573. '             ZExpertUser               FLAG FOR EXPERT/NOVICE USER MODE
  1574. '             ZFirstName$               LOGGED ON USER'S First NAME
  1575. '             ZF1Key                    FUNCTION KEY ONE VALUE
  1576. '             ZF10Key                   FUNCTION KEY TEN VALUE
  1577. '             ZWasGR                    GRAPHICS PREFERENCE OF USER
  1578. '             ZLineFeeds                SWTICH FOR USER'S LINE FEED PREFERENCE
  1579. '             ZLocalUser                FLAG INDICATING USER IS LOCAL
  1580. '             ZMinLogonSec              MINIMUM SECURITY TO LOGON
  1581. '             ZModemGoOffHookCmd$       COMMAND TO TAKE MODEM OFF-HOOK
  1582. '             ZModemInitBaud$           BAUD TO INITIALIZE MODEM AT
  1583. '             ZNodeID$                  NODE IDENTIFIER
  1584. '             ZNodeRecIndex             NODE RECORD Index FOR THIS NODE
  1585. '             ZNulls                    Switch FOR USER'S PREFERENCE FOR Nulls
  1586. '             ZPrinter                  Toggle INDICATING Printer IS AVAILABLE
  1587. '             ZPromptBell               USER'S PREFERENCE FOR BELLS ON PROMPTS
  1588. '             SECONDS.PER.SESSION       TIME LEFT IN CURRENT USER SESSION
  1589. '             ZSkipFilesLogon           USER'S LOGON NOTIFICIATION PREFERENCE
  1590. '             ZSnoop                    Toggle INDICATING Snoop STATUS
  1591. '             ZSubParm                  -8  = Sysop'S OPTION 6 REMOTELY
  1592. '                                       -9  = GOT TO DOS
  1593. '                                       -10 = Sysop GET'S SYSTEM NEXT
  1594. '             ZSysop                    INDICATOR THAT USER IS Sysop
  1595. '             ZSysopAnnoy               Toggle INDICATING Sysop IS AVAILABLE
  1596. '             ZSysopNext                Toggle SO Sysop GETS SYSTEM NEXT
  1597. '             ZUpperCase                USER'S PREFERENCE FOR UPPER/LOWER CASE
  1598. '             ZUserFileIndex            Index INTO THE USER FILE FOR CALLER
  1599. '             ZUserSecLevel             USER'S SECURITY LEVEL
  1600. '             USERT.TRANSFER.DEFAULT    USER'S FILE Transfer DEFAULT PREFERENCE
  1601. '
  1602. '  OUTPUTS --
  1603. '             ZAdjustedSecurity         Switch INDICATING TEMP. SECURITY CHANGE
  1604. '             ZChatAvail                Toggle INDICATING IF Sysop WILL CHAT
  1605. '             ZFunctionKey              VALUE 1 TO 10 CORRESPONDING TO
  1606. '                                       THE FUNCTION KEY THAT WAS PRESSED
  1607. '             ZKeyPressed$              CHARACTER STRING GENERATED BY KEY
  1608. '             ZPrinter                  TOGGLE INDICATING Printer IS AVAILABLE
  1609. '             ZSnoop                    Toggle INDICATING Snoop STATUS
  1610. '             ZSysop                    INDICATOR THAT USER IS Sysop
  1611. '             ZSysopAnnoy               Toggle INDICATING Sysop IS AVAILABLE
  1612. '             ZSysopNext                Toggle SO Sysop GETS SYSTEM NEXT
  1613. '             ZSubParm                  -1 Carrier LOST
  1614. '                                       -2 CHAT MODE ACTIVATED
  1615. '                                       -3 FORCE CALLER ON-LINE
  1616. '                                       -4 EXIT TO SYSTEM IMMEDIATELY
  1617. '                                       -5 EXIT TO SYSTEM AFTER MULTI-LINK CALL
  1618. '                                       -6 TELL USER ACCESS IS DENIED
  1619. '                                       -7 UPDATE CALLERS FILE AND DENY ACCESS
  1620. '             ZUserSecLevel      USER'S SECURITY LEVEL
  1621. '
  1622. '  PURPOSE -- To determine if a function has been pressed on
  1623. '             the PC'S keyboard that is running RBBS-PC.
  1624. '
  1625.       SUB FindFKey STATIC
  1626.       LookUp = ZSubParm
  1627.       IF ZSubParm < -1 THEN _
  1628.          ZSubParm = 0 : _
  1629.          IF LookUp = - 8 THEN _
  1630.             GOTO 33070 _
  1631.          ELSE IF LookUp = - 9 THEN _
  1632.                  GOTO 31000 _
  1633.               ELSE IF LookUp = - 10 THEN _
  1634.                       GOTO 33090
  1635. '
  1636. '
  1637. ' *  TEST FOR FUNCTION KEY PRESSED
  1638. '
  1639. '
  1640. 30600 IF ZKeyboardStack$ = "" THEN _
  1641.          ZKeyPressed$ = INKEY$ _
  1642.       ELSE ZKeyPressed$ = ZKeyboardStack$ : _
  1643.            ZKeyboardStack$ = ""
  1644.       ZFunctionKey = 0
  1645.       IF LEN(ZKeyPressed$) <> 2 THEN _
  1646.          GOTO 33970
  1647.       ZKeyPressed = ASC(RIGHT$(ZKeyPressed$,1))
  1648.       IF ZLocalUser AND NOT ZSysop THEN _
  1649.          ZKeyPressed$ = "" : _
  1650.          GOTO 33970
  1651.       IF ZKeyPressed => ZF1Key AND _
  1652.          ZKeyPressed <= ZF10Key THEN _
  1653.              ZFunctionKey = ZKeyPressed - 58 : _
  1654.              GOTO 30610
  1655.       IF ZKeyPressed = 117 THEN _    'Ctrl-End
  1656.          ZFunctionKey = 11
  1657.       IF ZKeyPressed = 73 THEN _     'PgUp
  1658.          ZFunctionKey = 12
  1659.       IF ZKeyPressed = 72 THEN _     'up arrow
  1660.          ZFunctionKey = 13
  1661.       IF ZKeyPressed = 80 THEN _     'Down arrow
  1662.          ZFunctionKey = 14
  1663.       IF ZKeyPressed = 81 THEN _     'PgDn
  1664.          ZFunctionKey = 15
  1665.       IF ZKeyPressed = 75 THEN _     'left arrow
  1666.          ZFunctionKey = 16
  1667.       IF ZKeyPressed = 77 THEN _     'Right arrow
  1668.          ZFunctionKey = 17
  1669.       IF ZKeyPressed = 141 THEN _    'CTRL-up arrow
  1670.          ZFunctionKey = 18
  1671.       IF ZKeyPressed = 132 THEN _    'CTRL-PgUp (same as CTRL-UP)
  1672.          ZFunctionKey = 18
  1673.       IF ZKeyPressed = 145 THEN _    'CTRL-down arrow
  1674.          ZFunctionKey = 19
  1675.       IF ZKeyPressed = 118 THEN _    'CTRL-PgDn (same as CTRL-DOWN)
  1676.          ZFunctionKey = 19
  1677.       IF ZKeyPressed = 115 THEN _    'CTRL-left arrow
  1678.          ZFunctionKey = 20
  1679.       IF ZKeyPressed = 116 THEN _    'CTRL-right arrow
  1680.          ZFunctionKey = 21
  1681.       IF ZKeyPressed = 79 THEN _     'End (a nice way to kick user off)
  1682.          ZFunctionKey = 22
  1683. 30610 ZKeyPressed$ = ""
  1684.       IF ZFunctionKey < 1 OR ZFunctionKey > 22 THEN _
  1685.          GOTO 33970
  1686.       IF ZFunctionKey < 10 AND (ZFunctionKey <> 8) THEN _
  1687.          GOTO 30620
  1688.       IF ZToggleOnly THEN _
  1689.          ZSubParm = 1 : _
  1690.          GOTO 33970
  1691. 30620 ON ZFunctionKey GOTO  31000, _            '  1 =  F1
  1692.                             32000, _            '  2 =  F2
  1693.                             33000, _            '  3 =  F3
  1694.                             33040, _            '  4 =  F4
  1695.                             33060, _            '  5 =  F5
  1696.                             33070, _            '  6 =  F6
  1697.                             33090, _            '  7 =  F7
  1698.                             33110, _            '  8 =  F8
  1699.                             33130, _            '  9 =  F9
  1700.                             33150, _            ' 10 = F10
  1701.                             31398, _            ' 11 = CTRL END
  1702.                             33200, _            ' 12 = PGUP
  1703.                             33170, _            ' 13 = UP ARROW
  1704.                             33180, _            ' 14 = DOWN ARROW
  1705.                             33220, _            ' 15 = PGDN
  1706.                             33240, _            ' 16 = LEFT ARROW
  1707.                             33250, _            ' 17 = RIGHT ARROW
  1708.                             33170, _            ' 18 = CTRL-UP ARROW
  1709.                             33180, _            ' 19 = CTRL-DOWN
  1710.                             33245, _            ' 20 = CTRL-LEFT
  1711.                             33255, _            ' 21 = CTRL-RIGHT
  1712.                             31398               ' 22 = END
  1713. '
  1714. '
  1715. ' * F1 - COMMAND FROM LOCAL KEYBOARD (IMMEDIATE EXIT TO DOS)
  1716. '
  1717. '
  1718. 31000 ZSubParm = -10
  1719.       CALL Carrier
  1720.       IF ZSubParm = 0 THEN _
  1721.          GOTO 33970
  1722.       ZFileName$ = ZNodeWorkDrvPath$ + "RBBS" + ZNodeFileID$ + "F1.DEF"
  1723.       CLOSE 2
  1724.       CALL OpenOutW (ZFileName$)
  1725.       PRINT #2,MID$(ZFileName$,3,7)
  1726.       IF ZExitToDoors THEN _
  1727.          ZSubParm = -4 : _
  1728.          GOTO 33970
  1729.       CALL OpenCom(ZModemInitBaud$,",N,8,1")
  1730.       CALL TakeOffHook
  1731.       ZSubParm = -5
  1732.       GOTO 33970
  1733. '
  1734. '
  1735. ' *  END KEY - FORCE CURRENT USER OFF AND LOCK THEM OUT
  1736. '
  1737. '
  1738. 31398 IF NOT ZLocalUser THEN _
  1739.          CALL Carrier : _
  1740.          IF ZSubParm = -1 THEN _
  1741.             GOTO 33970
  1742.       IF INSTR("MUF",ZActiveMenu$) > 0 THEN _
  1743.          GOTO 31399
  1744.       ZCursorLine = CSRLIN
  1745.       ZCursorRow = POS(0)
  1746.       LOCATE 25,1
  1747.       WasD$ = SPACE$(79)
  1748.       GOSUB 33210
  1749.       LOCATE 25,1
  1750.       WasD$ ="Cannot FORCE OFF until user reaches MAIN menu"
  1751.       GOSUB 33210
  1752.       CALL DelayTime (1)
  1753.       LOCATE ZCursorLine,ZCursorRow
  1754.       ZSubParm = 1
  1755.       CALL Line25
  1756.       GOTO 33970
  1757. 31399 IF ZFunctionKey = 22 THEN _
  1758.          CALL SkipLine (2) : _
  1759.          CALL QuickTPut1 ("Sorry, " + ZFirstName$ + ", SYSOP needs the system.") : _
  1760.          CALL DelayTime (8 + ZBPS) : _
  1761.          ZSubParm = -6 : _
  1762.          GOTO 33970
  1763.       CALL QuickTPut1 (ZFirstName$ + ", goodbye and don't call back")
  1764.       CALL DelayTime (8 + ZBPS) : _
  1765.       IF ZUserFileIndex < 1 THEN _
  1766.          ZSubParm = -6 : _
  1767.          GOTO 33970
  1768.       ZUserSecLevel = ZMinLogonSec - 1
  1769.       CALL DenyAccess
  1770.       ZSubParm = -7
  1771.       GOTO 33970
  1772. '
  1773. '
  1774. ' * F2 - COMMAND FROM LOCAL KEYBOARD (SYSOP EXIT TO DOS AND RETURN)
  1775. '
  1776. '
  1777.  
  1778. 32000 IF NOT ZLocalUser THEN _
  1779.          CALL SkipLine (1) : _
  1780.          CALL QuickTPut1 ("Sysop exiting to DOS. Please wait...") : _
  1781.          ZFunctionKey = 0 : _
  1782.          CALL DelayTime (3)
  1783.       CALL ShellExit (ZDiskForDos$ + "COMMAND")
  1784.       'SHELL ZDiskForDos$ + _
  1785.       '      "COMMAND"
  1786.       CLS
  1787.       IF NOT ZLocalUser THEN _
  1788.          CALL Carrier : _
  1789.          IF ZSubParm = -1 THEN _
  1790.             GOTO 33970
  1791.       ZSubParm = 2
  1792.       CALL Line25
  1793.       CALL QuickTPut1 ("Sysop back from DOS.  Returning control to you.")
  1794.       ZCommPortStack$ = ZCarriageReturn$
  1795.       GOTO 33970
  1796. '
  1797. '
  1798. ' * F3 - COMMAND FROM LOCAL KEYBOARD (Printer Toggle)
  1799. '
  1800. '
  1801. 33000 ZPrinter = NOT ZPrinter
  1802.       ChangeValue = ZPrinter
  1803.       FieldPosition = 38
  1804.       GOTO 33950
  1805. '
  1806. '
  1807. ' * F4 - COMMAND FROM LOCAL KEYBOARD (Sysop ANNOY)
  1808. '
  1809. '
  1810. 33040 ZSysopAnnoy = NOT ZSysopAnnoy
  1811.       ChangeValue = ZSysopAnnoy
  1812.       FieldPosition = 34
  1813.       GOTO 33950
  1814. '
  1815. '
  1816. ' * F5 - COMMAND FROM LOCAL KEYBOARD (FORCE CALLER ONLINE)
  1817. '
  1818. '
  1819. 33060 ZFunctionKey = 0
  1820.       ZSubParm = -3
  1821.       GOTO 33970
  1822. '
  1823. '
  1824. ' * F6 - COMMAND FROM LOCAL KEYBOARD (Sysop AVAILABLE Toggle)
  1825. ' *  6 - COMMAND FROM Sysop MENU (Sysop AVAILABLE Toggle)
  1826. '
  1827. '
  1828. 33070 ZSysopAvail = NOT ZSysopAvail
  1829.       ChangeValue = ZSysopAvail
  1830.       FieldPosition = 32
  1831.       GOTO 33950
  1832. '
  1833. '
  1834. ' * F7 - COMMAND FROM LOCAL KEYBOARD (Sysop GETS SYSTEM NEXT)
  1835. '
  1836. '
  1837. 33090 IF ERR=61 AND NOT ZDiskFullGoOffline THEN _
  1838.          GOTO 33970
  1839.       ZSysopNext = NOT ZSysopNext
  1840.       ChangeValue = ZSysopNext
  1841.       FieldPosition = 36
  1842.       GOTO 33950
  1843. '
  1844. '
  1845. ' * F8 - COMMAND FROM LOCAL KEYBOARD (ASSIGN USER TEMPORARY Sysop SECURITY)
  1846. '
  1847. '
  1848. 33110 ZSysop = NOT ZSysop
  1849.       ZCursorLine = CSRLIN
  1850.       ZCursorRow = POS(0)
  1851.       LOCATE 25,1
  1852.       WasD$ = SPACE$(79)
  1853.       NumReturns = 0
  1854.       CALL LPrnt (WasD$,NumReturns)
  1855.       LOCATE 25,1
  1856.       ZUserSecLevel = (1 + ZSysop) * _
  1857.                             ZUserSecSave  - _
  1858.                             ZSysop * _
  1859.                             ZSysopSecLevel
  1860.       WasD$ = "Sysop Privileges " + FNOffOn$(ZSysop)
  1861.       CALL LPrnt (WasD$,NumReturns)
  1862.       CALL DelayTime (3)
  1863.       LOCATE ZCursorLine,ZCursorRow
  1864.       ZSubParm = 1
  1865.       CALL Line25
  1866.       CALL SetPrompt
  1867.       GOTO 33970
  1868. '
  1869. '
  1870. ' * F9 - COMMAND FROM LOCAL KEYBOARD (Snoop Toggle)
  1871. '
  1872. '
  1873. 33130 IF NOT ZSnoop THEN _
  1874.          ZSnoop = ZTrue : _
  1875.          LOCATE 24,1,0 : _
  1876.          WasD$ = "SNOOP ON" : _
  1877.          NumReturns = 0 : _
  1878.          CALL LPrnt (WasD$,NumReturns) : _
  1879.          ZSubParm = 2 : _
  1880.          CALL Line25 _
  1881.       ELSE LOCATE ,,0 : _
  1882.            ZSnoop = ZFalse : _
  1883.            CLS
  1884. 33140 ChangeValue = ZSnoop
  1885.       FieldPosition = 58
  1886.       GOTO 33950
  1887. '
  1888. '
  1889. ' * F10 - COMMAND FROM LOCAL KEYBOARD (FORCE CHAT WITH USER)
  1890. '
  1891. '
  1892. 33150 GOTO 33160
  1893. 33155 ZSubParm = 1
  1894.       CALL Line25
  1895.       GOTO 33970
  1896. 33160 CALL UpdtCalr ("Sysop began chat",1)
  1897.       ZPageStatus$ = ""
  1898.       CALL SkipLine (1)
  1899.       CALL QuickTPut1 ("Hi " + _
  1900.            ZFirstName$ + _
  1901.            ", this is " + _
  1902.            ZSysopFirstName$ + _
  1903.            " " + _
  1904.            ZSysopLastName$ + _
  1905.            "  Sorry to break in to CHAT but..")
  1906.       CALL TimeBack (1)
  1907.       CALL SysopChat
  1908.       CALL TimeBack (2)
  1909.       ZCommPortStack$ = CHR$(13)
  1910.       GOTO 33155
  1911. '
  1912. '
  1913. ' * UP / CTRL-UP: INCREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE
  1914. '
  1915. '
  1916. 33170 ZUserSecLevel = ZUserSecLevel + _
  1917.                             1 - 4 * (ZFunctionKey = 18)
  1918.       GOTO 33190
  1919. '
  1920. '
  1921. ' * DOWN / CTRL-DOWN: DECREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE
  1922. '
  1923. '
  1924. 33180 ZUserSecLevel = ZUserSecLevel - _
  1925.                             1 + 4 * (ZFunctionKey = 19)
  1926. 33190 ZAdjustedSecurity = ZTrue
  1927.       ZUserSecSave = ZUserSecLevel
  1928.       IF (NOT ZConfMode) AND (NOT SubBoard) THEN _
  1929.          ZOrigSec = ZUserSecLevel : _
  1930.       ZSubParm = 2
  1931.       CALL Line25
  1932.       CALL SetPrompt
  1933.       GOTO 33970
  1934. '
  1935. '
  1936. ' * PGUP DISPLAY USER PROFILE
  1937. '
  1938. '
  1939. 33200 IF NOT ZLocalUser THEN _
  1940.          CALL Carrier : _
  1941.          IF ZSubParm = -1 THEN _
  1942.             GOTO 33970
  1943.       IF ZVoiceType <> 0 THEN _
  1944.          ZTalkAll = ZTrue
  1945.       CALL PageUp
  1946.       WasD$ = MID$("NoviceExPERT",1 -6 * ZExpertUser,6)
  1947.       GOSUB 33210
  1948.       WasD$ = "GRAPHICS: " + _
  1949.            MID$("None AsciiColor",ZWasGR * 5 + 1,5)
  1950.       GOSUB 33210
  1951.       WasD$ = "Protocol : " + _
  1952.            ZUserXferDefault$
  1953.       GOSUB 33210
  1954.       WasD$ = "UPPER CASE " + _
  1955.            MID$("and lowerONLY", 1 - 9 * ZUpperCase,9)
  1956.       GOSUB 33210
  1957.       WasD$ = "Line Feeds " + FNOffOn$(ZLineFeeds)
  1958.       GOSUB 33210
  1959.       WasD$ = "Nulls " + FNOffOn$(ZNulls)
  1960.       GOSUB 33210
  1961.       WasD$ = "Prompt Bell " + FNOffOn$(ZPromptBell)
  1962.       GOSUB 33210
  1963.       WasD$ = MID$("SKIP CHECK",1 -5 * ZCheckBulletLogon,5) + _
  1964.            " old BULLETINS on logon."
  1965.       GOSUB 33210
  1966.       WasD$ = MID$("CHECKSKIP ",1 -5 * ZSkipFilesLogon,5) + _
  1967.            " new files on logon."
  1968.       GOSUB 33210
  1969.       WasD$ = "Autodownload " + FNOffOn$(ZAutoDownDesired)
  1970.       GOSUB 33210
  1971.       ZTalkAll = ZFalse
  1972.       GOTO 33970
  1973. 33210 NumReturns = 1
  1974.       CALL LPrnt(WasD$,NumReturns)
  1975.       RETURN
  1976. '
  1977. '
  1978. ' * PGDN CLEAR DISPLAY OF USER'S PROFILE
  1979. '
  1980. '
  1981. 33220 IF NOT ZLocalUser THEN _
  1982.          CALL Carrier : _
  1983.          IF ZSubParm = -1 THEN _
  1984.             GOTO 33970
  1985.       CLS
  1986.       GOTO 33155
  1987. '
  1988. '
  1989. ' * LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY ONE MINUTE
  1990. '
  1991. '
  1992. 33240 IF ZSecsPerSession! > 120 THEN _
  1993.          ZSecsPerSession! = ZSecsPerSession! - 60
  1994.       GOTO 33970
  1995. '
  1996. '
  1997. ' * CTRL-LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY FIVE MINUTES
  1998. '
  1999. '
  2000. 33245 IF ZSecsPerSession! > 360 THEN _
  2001.          ZSecsPerSession! = ZSecsPerSession! - 300
  2002.       GOTO 33970
  2003. '
  2004. '
  2005. ' * RIGHT ARROW - INCREASE THE ON-LINE USER'S TIME BY ONE MINUTE
  2006. '
  2007. '
  2008. 33250 IF ZSecsPerSession! < 86280 THEN _
  2009.          ZSecsPerSession! = ZSecsPerSession! + 60
  2010.       ZTimeLockSet = 0
  2011.       GOTO 33970
  2012. '
  2013. '
  2014. ' * CTRL-RIGHT ARROW - INCREASE THE ON-LINE USER'S TIME BY FIVE MINUTES
  2015. '
  2016. '
  2017. 33255 IF ZSecsPerSession! < 86040 THEN _
  2018.          ZSecsPerSession! = ZSecsPerSession! + 300
  2019.       ZTimeLockSet = 0
  2020.       GOTO 33970
  2021. '
  2022. '
  2023. ' * UPDATE NODE RECORD WITH LOCAL FUNCTION KEY ACTIVITY
  2024. '
  2025. '
  2026. 33950 IF ZSnoop THEN _
  2027.          ZSubParm = 1 : _
  2028.          CALL Line25
  2029. 33960 IF ZConfMode = ZTrue THEN _
  2030.          IF ZLocalUser THEN _
  2031.             GOTO 33970 _
  2032.          ELSE WasD$ = "Cannot change status during Conference!" : _
  2033.               GOSUB 33210 : _
  2034.               GOTO 33970
  2035.       ZSubParm = 3
  2036.       CALL FileLock
  2037.       IF ZSubParm = -1 THEN _
  2038.          GOTO 33970
  2039.       CALL OpenMsg
  2040.       FIELD 1,128 AS ZMsgRec$
  2041.       GET 1,ZNodeRecIndex
  2042.       MID$(ZMsgRec$,FieldPosition,2) = STR$(ChangeValue)
  2043.       CALL SaveProf (2)
  2044.       FIELD 1, 128 AS ZMsgRec$
  2045. 33970 END SUB
  2046. 33990 ' $SUBTITLE: 'PageUp - Display user profile to Sysop'
  2047. ' $PAGE
  2048. '
  2049. '  NAME    -- PageUp
  2050. '
  2051. '  INPUTS  --     PARAMETER                    MEANING
  2052. '                 ZActiveUserName$       CURRENT USER NAME
  2053. '                 ZDnlds                 # OF FILES DOWNLOADED
  2054. '                 ZExpirationDate$       REGISTRATION EXPIRATION
  2055. '                 ZLastDateTimeOnSave$   Last DATE & TIME ON SYSTEM
  2056. '                 ZLastMsgRead           Last MESSAGE READ BY USER
  2057. '                 ZPswdSave$             USERS PASSWORD
  2058. '                 ZTimesLoggedOn         TIMES USER HAS LOGGED ON
  2059. '                 ZUplds                 # OF FILES UPLOADED
  2060. '                 ZUserSecSave           USERS SECURITY LEVEL
  2061. '
  2062. '  OUTPUTS -- ZMsgRec$
  2063. '
  2064.       SUB PageUp STATIC
  2065.       CALL LPrnt (" ",1)
  2066.       CALL LPrnt ("USER NAME : " + ZActiveUserName$,1)
  2067.       CALL LPrnt ("SECURITY  :" + STR$(ZUserSecSave),1)
  2068.       CALL LPrnt ("PASSWORD  :" + ZPswdSave$,1)
  2069.       CALL LPrnt ("READ MSG. :" + STR$(ZLastMsgRead),1)
  2070.       CALL LPrnt ("TIMES ON  :" + STR$(ZTimesLoggedOn),1)
  2071.       CALL LPrnt ("LAST ON   :" + ZLastDateTimeOnSave$,1)
  2072.       CALL LPrnt ("DOWNLOADS :" + STR$(ZDnlds),1)
  2073.       CALL LPrnt ("UPLOADS   :" + STR$(ZUplds),1)
  2074.       IF ZEnforceRatios THEN _
  2075.          CALL LPrnt ("DL-BYTES  :" + STR$(ZDLBytes!),1) : _
  2076.          CALL LPrnt ("UL-BYTES  :" + STR$(ZULBytes!),1)
  2077.       IF ZRestrictByDate THEN _
  2078.          CALL LPrnt ("EXPIRATION: " + ZExpirationDate$,1)
  2079.       CALL LPrnt ("User's Profile",1)
  2080.       END SUB
  2081. 35000 ' $SUBTITLE: 'FlushKeys - Completely flush all user input'
  2082. ' $PAGE
  2083. '
  2084. '  NAME    -- FlushKeys
  2085. '
  2086.       SUB FlushKeys STATIC
  2087.       CALL FlushCom (ZWasY$)
  2088.       ZAnsIndex = 0
  2089.       ZLastIndex = 0
  2090.       REDIM ZUserIn$(ZMsgDim)
  2091.       END SUB
  2092. 41008 ' $SUBTITLE: 'CheckTimeRemain - Kicks off if no time remaining'
  2093. ' $PAGE
  2094. '
  2095. '  NAME    -- CheckTimeRemain
  2096. '
  2097. '  INPUTS  -- PARAMETER                 MEANING
  2098. '
  2099. '  OUTPUTS -- PARAMETER                 MEANING
  2100. '             MinsRemaining         TIME IN MINUTES LEFT IN SESSION
  2101. '             ZSecsUsedSession!     TIME USED IN SECONDS
  2102. '             ZSubParm              -1 IF No TIME LEFT
  2103. '
  2104.       SUB CheckTimeRemain (MinsRemaining) STATIC
  2105.       CALL TimeRemain (MinsRemaining)
  2106.       IF ZBypassTimeCheck THEN _
  2107.          EXIT SUB
  2108.       IF MinsRemaining <= 0 THEN _
  2109.          ZSubParm = -1
  2110.       END SUB
  2111. 41010 ' $SUBTITLE: 'TimeRemain - calculates time remaining in a session'
  2112. ' $PAGE
  2113. '
  2114. '  NAME    -- TimeRemain
  2115. '
  2116. '  INPUTS  -- PARAMETER                 MEANING
  2117. '             ZUserLogonTime!          WHEN DID THE CALLER GET HERE
  2118. '             ZSecsPerSession!         HOW LONG MAY THE CALLER STAY ON
  2119. '             ZTimeToDropToDos!        WHEN ARE WE DOING OUR DAILY EVENT
  2120. '             ZBypassTimeCheck         DO WE CARE HOW LONG THEY CAN STAY
  2121. '
  2122. '  OUTPUTS -- PARAMETER                 MEANING
  2123. '             MinsRemaining            TIME IN MINUTES LEFT IN SESSION
  2124. '             ZSecsUsedSession!        TIME USED IN SECONDS
  2125. '
  2126.       SUB TimeRemain (MinsRemaining) STATIC
  2127.       TOA! = FRE("A")
  2128.       IF ZBypassTimeCheck THEN _
  2129.          MinsRemaining = ZSecsPerSession! / 60 : _
  2130.          EXIT SUB
  2131.       CALL CheckTime (ZUserLogonTime!, ZSecsUsedSession!, 2)
  2132.       IF ZTimeToDropToDos! = 0 OR _
  2133.          ZOldDate$ = DATE$ THEN _
  2134.          GOTO 41020
  2135.       CALL CheckTime (ZTimeToDropToDos!, HowMuchTimeLeft!, 1)
  2136.       IF (ZSecsPerSession! - ZSecsUsedSession!) _
  2137.          > HowMuchTimeLeft! THEN _
  2138.          ZSecsPerSession! = HowMuchTimeLeft! + _
  2139.          ZSecsUsedSession! : _
  2140.          IF NOT ToldShort THEN _
  2141.             ToldShort = ZTrue : _
  2142.             ZOutTxt$ = "Time shortened for scheduled event" : _
  2143.             CALL RingCaller
  2144. 41020 MinsRemaining = (ZSecsPerSession! - ZSecsUsedSession!) / 60
  2145.       END SUB
  2146. 41032 ' $SUBTITLE: 'DispTimeRemain - Display users time remaining'
  2147. ' $PAGE
  2148. '
  2149. '  NAME    -- DispTimeRemain
  2150. '
  2151. '  INPUTS  --     PARAMETER                    MEANING
  2152. '              MinsRemaining
  2153. '
  2154. '  OUTPUTS --     PARAMETER                    MEANING
  2155. '                MinsRemaining               TIME IN MINUTES LEFT IN SESSION
  2156. '
  2157.       SUB DispTimeRemain (MinsRemaining) STATIC
  2158.       CALL TimeRemain (MinsRemaining)
  2159.       CALL QuickTPut1 (STR$(MinsRemaining) + " min left")
  2160.       END SUB
  2161. 41498 ' $SUBTITLE: 'AMorPM - give time of day in AM/PM format'
  2162. ' $PAGE
  2163. '
  2164. '  NAME    -- AMorPM
  2165. '
  2166. '  INPUTS  --     PARAMETER                    MEANING
  2167. '
  2168. '  OUTPUTS -- ZCurDate$                 CURRENT DATE (MM-DD-YY)
  2169. '             ZTime$                    CURRENT TIME (I.E. 1:13 PM)
  2170. '
  2171. '  PURPOSE -- To set the time and date and
  2172. '             describe the time as "AM" or "PM."
  2173. '
  2174.       SUB AMorPM STATIC
  2175. '
  2176. '
  2177. ' *  CALCULATE CURRENT TIME FOR AM OR PM
  2178. '
  2179. '
  2180. 41500 ZCurDate$ = DATE$
  2181.       ZCurDate$ = LEFT$(ZCurDate$ ,6) + _
  2182.                       RIGHT$(ZCurDate$ ,2)
  2183. 41510 ZTime$ = TIME$
  2184.       IF VAL(MID$(ZTime$,1,2)) = 12 THEN _
  2185.          MID$(ZTime$,1,2) = RIGHT$(STR$(VAL(MID$(ZTime$,1,2))),2) : _
  2186.          ZTime$ = LEFT$(ZTime$,5) + _
  2187.                 " PM" : _
  2188.          EXIT SUB
  2189.       IF VAL(MID$(ZTime$,1,2)) > 11 THEN _
  2190.          MID$(ZTime$,1,2) = RIGHT$(STR$(VAL(MID$(ZTime$,1,2))-12),2) : _
  2191.          ZTime$ = LEFT$(ZTime$,5) + _
  2192.                 " PM" : _
  2193.          EXIT SUB
  2194.       ZTime$ = LEFT$(ZTime$,5) + _
  2195.              " AM"
  2196.       END SUB
  2197. 42000 ' $SUBTITLE: 'Carrier - sub to monitor carrier on comm. port'
  2198. ' $PAGE
  2199. '
  2200. '  NAME    -- Carrier
  2201. '
  2202. '  INPUTS  --     PARAMETER                    MEANING
  2203. '              ZAutoLogoffReq                  -1 if in autologoff request
  2204. '
  2205. '  OUTPUTS --  ZSubParm = 0                    CONTINUE
  2206. '              ZSubParm = -1                   TERMINATE (No Carrier)
  2207. '
  2208. '  PURPOSE --  To test whether should continue in RBBS.  Reasons
  2209. '              NOT to continue are:  autologoff, out of time, or
  2210. '              carrier dropped.
  2211. '
  2212.       SUB Carrier STATIC
  2213.       IF ZAutoLogoffReq THEN _
  2214.          IF NOT ZSuspendAutologoff THEN _
  2215.             ZSubParm = -1 : _
  2216.             EXIT SUB
  2217.       CALL CheckCarrier
  2218.       END SUB
  2219. 42005 ' $SUBTITLE: 'CheckCarrier - monitors carrier on comm. port'
  2220. ' $PAGE
  2221. '
  2222. '  NAME    -- CheckCarrier
  2223. '
  2224. '  INPUTS  --     PARAMETER                    MEANING
  2225. '              ZLocalUser = 0               REMOTE USER
  2226. '              ZLocalUser = -1              LOCAL KEYBOARD USER
  2227. '              ZModemStatusReg              ADDRESS OF THE COMMUNI-
  2228. '                                           CATIONS PORT'S REGISTER
  2229. '              ZSubParm = -9                DON'T WRITE TO CALLERS
  2230. '              ZSubParm = -10               SAME AS -9, BUT DON'T
  2231. '                                           DELAY
  2232. '
  2233. '  OUTPUTS --  ZSubParm = 0                 Carrier STILL PRESENT
  2234. '              ZSubParm = -1                Carrier NOT PRESENT
  2235. '
  2236. '  PURPOSE --  To test if carrier is present (i.e. the user
  2237. '              is still on line).  Ignores whether in autologoff.
  2238. '
  2239.       SUB CheckCarrier STATIC
  2240.       IF ZSubParm = -1 THEN _
  2241.          EXIT SUB
  2242.       Speedy = ZSubParm
  2243.       ZSubParm = 0
  2244. '
  2245. '
  2246. ' * TEST FOR Carrier PRESENT (DROP CALLER IF Carrier NOT PRESENT)
  2247. '
  2248. '
  2249.       IF ZLocalUser THEN _
  2250.          EXIT SUB
  2251.       IF ZFossil THEN _
  2252.          CALL FosStatus(ZComPort,Status) : _
  2253.          Status = Status AND &H0080 : _
  2254.          IF Status = &H0080 THEN _
  2255.             EXIT SUB _
  2256.          ELSE GOTO 42015
  2257. 42010 IF INP(ZModemStatusReg) > 127 THEN _
  2258.          EXIT SUB
  2259. '
  2260. '
  2261. ' * IN CASE USER IS 2400 BAUD, PAUSE A SECOND AND CHECK AGAIN FOR Carrier
  2262. ' * DETECT.  SOME 2400 BAUD MODEMS TAKE A WHILE TO SYNCHRONIZE THE Carrier,
  2263. ' * HENCE A THREE-SECOND PAUSE BEFORE CHECKING AGAIN.
  2264. '
  2265. '
  2266. 42015 IF Speedy = -10 THEN _
  2267.          GOTO 42020
  2268.       CALL DelayTime (ZModemInitWaitTime)
  2269.       IF ZFossil THEN _
  2270.          CALL FosStatus(ZComPort,Status) : _
  2271.          Status = Status AND &H0080 : _
  2272.          IF Status = &H0080 THEN _
  2273.             EXIT SUB _
  2274.          ELSE GOTO 42020
  2275.       IF INP(ZModemStatusReg) > 127 THEN _
  2276.          EXIT SUB
  2277. 42020 ZSubParm = -1
  2278.       IF Speedy < -8 THEN _
  2279.          EXIT SUB
  2280.       IF AlreadyWritten = -9 THEN _
  2281.          EXIT SUB
  2282.       CALL TakeOffHook
  2283.       ZModemOffHook = -1
  2284.       AlreadyWritten = -9
  2285.       CALL UpdtCalr ("Carrier dropped",1)
  2286.       END SUB
  2287. 43004 ' $SUBTITLE: 'AskGraphics -- sub to ask users graphic preference'
  2288. ' $PAGE
  2289. '
  2290. '  NAME    -- AskGraphics
  2291. '
  2292. '  INPUTS  --    PARAMETER                    MEANING
  2293. '                ZUserGraphicDefault$        USER Graphic DEFAULT
  2294. '
  2295. '  OUTPUTS --
  2296. '
  2297. '  PURPOSE --  To determine users graphics default
  2298. '
  2299.       SUB AskGraphics STATIC
  2300.       IF ZExpertUser THEN _
  2301.          GOTO 43007
  2302. 43006 ZFileName$ = ZHelp$(9)
  2303.       CALL BufFile (ZFileName$,WasX)
  2304.       IF ZSubParm = -1 THEN _
  2305.          EXIT SUB
  2306. 43007 CALL QuickTPut1 ("GRAPHICS for text files and menus")
  2307.       ZOutTxt$ = "Change from " + MID$("NAC",ZWasGR+1,1) + " to N)one, A)scii-IBM, C)olor-IBM, H)elp" + ZPressEnterExpert$
  2308.       ZSubParm = 1
  2309.       ZTurboKey = -ZTurboKeyUser
  2310.       CALL TGet
  2311.       IF ZSubParm = -1 THEN _
  2312.          EXIT SUB
  2313.       IF ZWasQ = 0 THEN _
  2314.          CALL QuickTPut1 ("Unchanged") : _
  2315.          EXIT SUB
  2316.       CALL AllCaps (ZUserIn$(1))
  2317.       ZWasGR = INSTR("NAC",ZUserIn$(1))
  2318.       IF ZWasGR = 2 AND NOT ZEightBit THEN _
  2319.          CALL QuickTPut1 ("Ascii unavailable.  Requires 8 bit") : _
  2320.          GOTO 43007
  2321.       IF ZWasGR = 0 THEN _
  2322.          GOTO 43006
  2323.       ZWasGR = ZWasGR - 1
  2324.       CALL SetGraphic (ZWasGR,ZUserGraphicDefault$)
  2325.       END SUB
  2326. '
  2327. 43031 ' $SUBTITLE: 'GraphicX - sub to find graphic version of a file'
  2328. ' $PAGE
  2329. '
  2330. '  NAME    -- GraphicX
  2331. '
  2332. '  INPUTS  --     PARAMETER                    MEANING
  2333. '                 Default$              USERS Graphic DEFAULT
  2334. '                 ZWasGR                WHETHER GRAPHICS ARE AVAILABLE
  2335. '                 FilName$              FILE TO CHECK
  2336. '                 FileNum               # of file to use
  2337. '
  2338. '  OUTPUTS --     FilName$              SUBSTITUTES NAME OF GRAPHICS
  2339. '                                       FILE (IF IT EXISTS).
  2340. '
  2341. '  PURPOSE -- Checks whether there is a graphics version of
  2342. '             a file, based on users graphics perference.
  2343. '             Sets file name to graphics file if it exists,
  2344. '             Otherwise leaves file name intact.  Returns file
  2345. '             name to use.
  2346. '
  2347.       SUB GraphicX (Default$,FilName$,FileNum) STATIC
  2348.       ZOK = ZFalse
  2349.       IF ZWasGR THEN _
  2350.          CALL BreakFileName (FilName$,DR$,WasX$,Extension$,ZTrue) : _
  2351.          IF LEN(WasX$) < 8 THEN _
  2352.             ZWasDF$ = DR$ + _
  2353.                   WasX$ + _
  2354.                   Default$ + _
  2355.                   Extension$ : _
  2356.              CALL FINDITX (ZWasDF$,FileNum) : _
  2357.              IF ZOK THEN _
  2358.                 FilName$ = ZWasDF$ : _
  2359.                 IF Default$ = "C" THEN _
  2360.                    ZLinesPrinted = 0
  2361.       IF NOT ZOK THEN _
  2362.          CALL FINDITX (FilName$,FileNum)
  2363.       END SUB
  2364. ' Sets Graphic version but uses file # 2 always
  2365.       SUB Graphic (Default$,FilName$) STATIC
  2366.       CALL GraphicX (Default$,FilName$,2)
  2367.       END SUB
  2368. 43068 ' $SUBTITLE: 'SaveProf - subroutine to read a user profile'
  2369. ' $PAGE
  2370. '
  2371. '  NAME    -- SaveProf
  2372. '
  2373. '  INPUTS  --     PARAMETER                    MEANING
  2374. '              ZBPS
  2375. '              ZEightBit
  2376. '              ZExitToDoors
  2377. '              ZWasGR
  2378. '              ZMsgRec$
  2379. '              ZNodeRecIndex
  2380. '              ZSysop
  2381. '              ZUpperCase
  2382. '              ZTimeLoggedOn$
  2383. '              ZPrivateDoor
  2384. '              ZReliableMode
  2385. '
  2386. '  OUTPUTS -- NONE
  2387. '
  2388. '  PURPOSE -- Saves a user's options and communications parameters
  2389. '             in the node record when a user exits to a "door" so
  2390. '             that he is in the same status as when he exited.
  2391. '
  2392.       SUB SaveProf (IParm) STATIC
  2393.       ON IParm GOTO 43070,43080
  2394. 43070 ZActiveMessageFile$ = ZOrigMsgFile$
  2395.       ZSubParm = 3
  2396.       CALL FileLock
  2397.       CALL OpenMsg
  2398.       FIELD 1, 128 AS ZMsgRec$
  2399.       GET 1,ZNodeRecIndex
  2400.       IF ZGlobalSysop THEN _
  2401.          MID$(ZMsgRec$,1,30) = "SYSOP" + SPACE$(25)
  2402.       MID$(ZMsgRec$,40,2) = STR$(ZExitToDoors)
  2403.       MID$(ZMsgRec$,42,2) = STR$(ZEightBit)
  2404.       MID$(ZMsgRec$,44,2) = STR$(ZBPS)
  2405.       MID$(ZMsgRec$,46,2) = STR$(ZUpperCase)
  2406.       MID$(ZMsgRec$,48,5) = MKS$(ZNumDwldBytes!) + MID$(STR$(-ZBatchTransfer),2)
  2407.       MID$(ZMsgRec$,53,2) = STR$(ZWasGR)
  2408.       MID$(ZMsgRec$,55,2) = STR$(ZSysop)
  2409.       MID$(ZMsgRec$,65,3) = CHR$(VAL(LEFT$(ZTimeLoggedOn$,2))) + _
  2410.                                    CHR$(VAL(MID$(ZTimeLoggedOn$,4,2))) + _
  2411.                                    CHR$(VAL(MID$(ZTimeLoggedOn$,7,2)))
  2412.       MID$(ZMsgRec$,72,2) = STR$(ZPrivateDoor)
  2413.       MID$(ZMsgRec$,74,1) = MID$(STR$(ZTransferFunction),2,1)
  2414.       MID$(ZMsgRec$,75,1) = ZWasFT$
  2415.       MID$(ZMsgRec$,113,2) = MKI$(CINT(ZTimeCredits!)/60)
  2416.       MID$(ZMsgRec$,79,8) = LEFT$(ZDooredTo$+"        ",8)
  2417.       MID$(ZMsgRec$,91,2) = STR$(ZReliableMode)
  2418.       CALL BreakFileName (ZCurPUI$,ZOutTxt$,ZUserIn$,ZWasZ$,ZFalse)
  2419.       MID$(ZMsgRec$,93,8) = ZUserIn$ + SPACE$(8 - LEN(ZUserIn$))
  2420.       MID$(ZMsgRec$,101,2) = STR$(ZLocalUser)
  2421.       MID$(ZMsgRec$,103,2) = STR$(ZLocalUserMode)
  2422.       ZConfName$ = LEFT$(ZConfName$,INSTR(ZConfName$ + " "," ") - 1)
  2423.       MID$(ZMsgRec$,105,8) = ZConfName$ + SPACE$(8 - LEN(ZConfName$))
  2424.       MID$(ZMsgRec$,115,1) = MID$(STR$(ZAutoLogoffReq),2,1)
  2425.       MID$(ZMsgRec$,117,2) = STR$(ZMenuIndex)
  2426.       MID$(ZMsgRec$,119,2) = LEFT$(DATE$,2)
  2427.       MID$(ZMsgRec$,121,2) = MID$(DATE$,4,2)
  2428.       MID$(ZMsgRec$,123,2) = RIGHT$(DATE$,2)
  2429.       MID$(ZMsgRec$,125,2) = LEFT$(TIME$,2)
  2430.       MID$(ZMsgRec$,127,2) = MID$(TIME$,4,2)
  2431. ' ***   Save additional parameters for door restoral
  2432.       CALL OpenOutW (ZNodeWorkDrvPath$+"DRST"+ZNodeFileID$+".DEF")
  2433.       CALL PrintWorkA (STR$(ZLimitMinsPerSession))
  2434.       CLOSE 2
  2435. 43080 PUT 1,ZNodeRecIndex
  2436.       ZSubParm = 2
  2437.       CALL FileLock
  2438.       CALL OpenMsg
  2439.       END SUB
  2440. 44000 ' $SUBTITLE: 'ReadProf - subroutine to restore a user profile'
  2441. ' $PAGE
  2442. '
  2443. '  NAME    -- ReadProf
  2444. '
  2445. '  INPUTS  --     PARAMETER                    MEANING
  2446. '              ZNodeRecIndex               NODE RECORD TO USE
  2447. '              ZSysopPswd1$               Sysop'S PSEUDONYM 1
  2448. '              ZSysopPswd2$               Sysop'S PSEUDONYM 2
  2449. '
  2450. '  OUTPUTS -- USER'S OPTIONS AND COMMUNICATIONS PARAMETERS
  2451. '             UPON EXITING RBBS-PC TO A "DOOR"
  2452. '
  2453. '  PURPOSE -- Reset a user's options and communications parameters
  2454. '             that were saved in the node record when a user exited
  2455. '             to a "door" so that he is in the same status as when
  2456. '             he exited.
  2457. '
  2458.       SUB ReadProf STATIC
  2459.       FIELD 1, 128 AS ZMsgRec$
  2460.       GET 1,ZNodeRecIndex
  2461.       ZReliableMode = VAL(MID$(ZMsgRec$,91,2))
  2462.       MID$(ZMsgRec$,40,2) = "00"
  2463.       ZEightBit = VAL(MID$(ZMsgRec$,42,2))
  2464.       ZBPS = VAL(MID$(ZMsgRec$,44,2))
  2465.       CALL CommInfo
  2466.       ZBaudTest! = VAL(MID$(ZBaudRates$,(-5 * ZBPS),5))
  2467.       ZUpperCase = VAL(MID$(ZMsgRec$,46,2))
  2468.       ZNumDwldBytes! = CVS(MID$(ZMsgRec$,48,4))
  2469.       ZBatchTransfer = (MID$(ZMsgRec$,52,1) = "1")
  2470.       ZWasGR = VAL(MID$(ZMsgRec$,53,2))
  2471.       HourLoggedOn$ = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,65,1))),2),2)
  2472.       MinLoggedOn$  = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,66,1))),2),2)
  2473.       SecLoggedOn$  = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,67,1))),2),2)
  2474.       ZTimeLoggedOn$ = HourLoggedOn$ + _
  2475.                         ":" + _
  2476.                         MinLoggedOn$ + _
  2477.                         ":" + _
  2478.                         SecLoggedOn$
  2479.       ZTransferFunction = VAL(MID$(ZMsgRec$,74,1))
  2480.       ZWasFT$ = MID$(ZMsgRec$,75,1)
  2481.       ZTimeCredits! = 60*CVI(MID$(ZMsgRec$,113,2))
  2482.       ZDooredTo$ = MID$(ZMsgRec$,79,8)
  2483.       CALL Trim (ZDooredTo$)
  2484.       IF ZExitToDoors AND ZDooredTo$ <> "" THEN _
  2485.          CALL OpenWork (2,ZDoorsDef$) : _
  2486.          IF ZErrCode = 0 THEN _
  2487.             CALL ReadParms (ZOutTxt$(),8,1) : _
  2488.             WHILE ZErrCode = 0 AND ZOutTxt$(1) <> ZDooredTo$ : _
  2489.                CALL ReadParms (ZOutTxt$(),8,1) : _
  2490.             WEND : _
  2491.             IF ZOutTxt$(1) = ZDooredTo$ THEN _
  2492.                ZDoorSkipsPswd = (ZOutTxt$(6) <> "Y") : _
  2493.                CALL BufFile (ZOutTxt$(7),WasX)
  2494.       ZErrCode = 0
  2495.       ZMenuIndex = VAL(MID$(ZMsgRec$,117,2))
  2496.       ZCurPUI$ = MID$(ZMsgRec$,93,8)
  2497.       CALL Remove (ZCurPUI$," ")
  2498.       IF ZCurPUI$ <> "" THEN _
  2499.          CALL BreakFileName (ZMainPUI$,ZOutTxt$,ZUserIn$,ZWasZ$,ZTrue) : _
  2500.          ZCurPUI$ = ZOutTxt$ + ZCurPUI$ + ZWasZ$
  2501.       ZCustomPUI = (ZCurPUI$ <> "")
  2502.       ZLocalUser = VAL(MID$(ZMsgRec$,101,2))
  2503.       ZLocalUserMode = VAL(MID$(ZMsgRec$,103,2))
  2504.       ZHomeConf$ = MID$(ZMsgRec$,105,8)
  2505.       ZAutoLogoffReq = (VAL(MID$(ZMsgRec$,115,1)) <> 0)
  2506.       CALL Trim (ZHomeConf$)
  2507.       IF ZRequiredRings > 0 AND _
  2508.          INSTR(ZModemInitCmd$,"S0=255") THEN _
  2509.          COLOR 7,0,0 _
  2510.       ELSE COLOR ZFG,ZBG,ZBorder
  2511.       IF ZLocalUserMode THEN _
  2512.          GOTO 44003
  2513.       CALL SetBaud
  2514. 44003 ZUserLogonTime! = VAL(HourLoggedOn$) * 3600 + _
  2515.                          VAL(MinLoggedOn$) * 60 + _
  2516.                          VAL(SecLoggedOn$)
  2517.       HourLoggedOn$ = ""
  2518.       MinLoggedOn$ = ""
  2519.       SecLoggedOn$ = ""
  2520.       IF ZMinsPerSession < 1 THEN _
  2521.          ZMinsPerSession = 3
  2522.       IF NOT ZEightBit THEN _
  2523.          OUT ZLineCntlReg,&H1A
  2524.       IF LEFT$(ZMsgRec$,7) = "SYSOP  " THEN _
  2525.          ZFirstName$ = ZSysopPswd1$ : _
  2526.          ZActiveUserName$ = ZSysopPswd1$ + " " + ZSysopPswd2$ _
  2527.       ELSE ZFirstNameEnd = INSTR(ZMsgRec$," ") : _
  2528.            ZLastNameEnd = INSTR(ZFirstNameEnd + 1,ZMsgRec$ + " ","  ") : _
  2529.            ZFirstName$ = LEFT$(ZMsgRec$,ZFirstNameEnd-1) : _
  2530.            ZLastName$ = MID$(ZMsgRec$,ZFirstNameEnd + 1,ZLastNameEnd - (ZFirstNameEnd + 1)) : _
  2531.            ZActiveUserName$ = MID$(ZFirstName$ + " " + ZLastName$,1,31)
  2532.       ZWasZ$ = ZFirstName$
  2533.       CALL OpenWork (2,ZNodeWorkDrvPath$+"DRST"+ZNodeFileID$+".DEF")
  2534.       CALL ReadDir (2,1)
  2535.       ZLimitMinsPerSession = VAL (ZOutTxt$)
  2536.       CLOSE 2
  2537.       END SUB
  2538. 44020 ' $SUBTITLE: 'CommInfo - sub for variable of users baud/parity'
  2539. ' $PAGE
  2540. '
  2541. '  NAME    -- CommInfo
  2542. '
  2543. '  INPUTS  --     PARAMETER                    MEANING
  2544. '                 ZBPS                BAUD RATE INDICATOR
  2545. '                 ZEightBit           INDICATE FOR N/8/1
  2546. '
  2547. '  OUTPUTS -- ZBaudParity$
  2548. '
  2549. '  PURPOSE -- Create a string that shows a users baud rate and parity
  2550. '
  2551.       SUB CommInfo STATIC
  2552. '
  2553. '
  2554. ' *  DETERMINE BAUD AND PARITY
  2555. '
  2556. '
  2557.   IF ZReliableMode THEN _
  2558.      ReliableMode$ = "-R," _
  2559.   ELSE ReliableMode$ = ","
  2560.   ZBaudParity$ = MID$(ZBaudRates$,(-5 * ZBPS),5) + _
  2561.                  " BAUD" + _
  2562.                  ReliableMode$ + _
  2563.                  MID$("N,8,1E,7,1",6 + 5 * ZEightBit,5)
  2564.   ZBaudTest! = VAL(ZBaudParity$)
  2565.   END SUB
  2566. 50495 ' $SUBTITLE: 'DelayTime - sub to wait number of seconds specified'
  2567. ' $PAGE
  2568. '
  2569. '  NAME    -- DelayTime
  2570. '
  2571. '  INPUTS  --     PARAMETER                    MEANING
  2572. '                 DelaySecs           NUMBER OF SECONDS TO DELAY
  2573. '                                      (0 TO 3,600)
  2574. '
  2575. '  OUTPUTS -- NONE
  2576. '
  2577. '  PURPOSE -- To wait the number of seconds indicated before
  2578. '             returning control to the calling routine.
  2579. '
  2580.       SUB DelayTime (DelaySecs) STATIC
  2581.       IF DelaySecs < 1 THEN _
  2582.          EXIT SUB
  2583.       ZDelay! = TIMER + DelaySecs
  2584. 50500 CALL CheckTime(ZDelay!, TempElapsed!, 1)
  2585.       IF TempElapsed! > 0 THEN _
  2586.          GOTO 50500
  2587.       END SUB
  2588. 52070 ' $SUBTITLE: 'ModemPut - sub to write modem commands to modem'
  2589. ' $PAGE
  2590. '
  2591. '  SUBROUTINE NAME    -- ModemPut
  2592. '
  2593. '  INPUT PARAMETERS   --     PARAMETER               MEANING
  2594. '                            Strng$                MODEM COMMAND
  2595. '                            ZCmdsBetweenRings     INDICATOR TO WAIT FOR
  2596. '                                                  MODEM TO STOP RINGING
  2597. '                                                  BEFORE ISSUING COMMANDS
  2598. '                            ZDumbModem            INDICATOR THAT MODEM WOULD
  2599. '                                                  NOT UNDERSTAND COMMANDS
  2600. '
  2601. '  OUTPUT PARAMETERS  -- NONE
  2602. '
  2603. '  SUBROUTINE PURPOSE -- TO ISSUE MODEM COMMANDS TO THE MODEM
  2604. '
  2605.       SUB ModemPut (Strng$) STATIC
  2606. '
  2607. '
  2608. ' *  SEND MODEM COMMAND
  2609. '
  2610. '
  2611.       IF ZDumbModem THEN _
  2612.          EXIT SUB
  2613.       IF NOT ZCmdsBetweenRings OR _
  2614.          NOT (INP(ZModemStatusReg) AND &H40) THEN _
  2615.          GOTO 52080
  2616.       ConnectDelay! = TIMER + 7
  2617. 52072 IF (INP(ZModemStatusReg) AND &H40) > 0 THEN _
  2618.          CALL CheckTime(ConnectDelay!, TempElapsed!, 1) : _
  2619.          IF ZSubParm = 2 THEN _
  2620.             GOTO 52080
  2621.       GOTO 52072
  2622. 52080 CALL DelayTime (ZModemCmdDelayTime)
  2623.       WasX$ = " "
  2624.       FOR WasI = 1 TO LEN(Strng$)
  2625.          LSET WasX$ = MID$(Strng$,WasI,1)
  2626.          ON INSTR("{~",WasX$) GOTO 52082,52084
  2627.             GOTO 52085
  2628. 52082       LSET WasX$ = ZCarriageReturn$
  2629.             GOTO 52085
  2630. 52084       CALL DelayTime (1)
  2631.             GOTO 52086
  2632. 52085    CALL CommPut (WasX$)
  2633. 52086 NEXT
  2634.       CALL CommPut (ZCarriageReturn$)
  2635.       END SUB
  2636. 57001 ' $SUBTITLE: 'DispCall - subroutine to display callers file'
  2637. ' $PAGE
  2638. '
  2639. '  NAME    -- DispCall
  2640. '
  2641. '  INPUTS  --     PARAMETER           MEANING
  2642. '
  2643. '  OUTPUTS --  (NONE)
  2644. '
  2645. '  PURPOSE -- Displays callers file to sysops and callers
  2646. '
  2647.       SUB DispCall STATIC
  2648.       IF ZCallersFilePrefix$ = "" THEN _
  2649.          EXIT SUB
  2650.       CALL SkipLine (1)
  2651.       CallersFileIndexTemp! = ZCallersFileIndex!
  2652.       CLOSE 4
  2653.       IF ZShareIt THEN _
  2654.          OPEN ZCallersFile$ FOR RANDOM SHARED AS #4 LEN=64 _
  2655.       ELSE OPEN "R",4,ZCallersFile$,64
  2656.       FIELD 4,64 AS ZCallersRecord$
  2657. 57005 IF CallersFileIndexTemp! < 1 OR ZRet THEN _
  2658.          EXIT SUB
  2659. 57010 GET 4,CallersFileIndexTemp!
  2660.       ZOutTxt$ = ZCallersRecord$
  2661.       IF LEFT$(ZOutTxt$,3) = "   " OR _
  2662.          INSTR(ZOutTxt$,"on at") = 0 THEN _
  2663.          GOTO 57030
  2664. 57025 CallersFileIndexTemp! = CallersFileIndexTemp! - 1
  2665.       GET 4,CallersFileIndexTemp!
  2666.       WasZ = INSTR(ZCallersRecord$,"{")
  2667.       IF WasZ < 1 OR WasZ > 15 THEN _
  2668.          WasZ = 15
  2669.       IF ZSysop OR _
  2670.          LEFT$(ZOutTxt$,3) <> "   " THEN _
  2671.          ZOutTxt$ = ZOutTxt$ + LEFT$(ZCallersRecord$,WasZ - 1)
  2672.       GOSUB 57100
  2673.       IF ZSysop THEN _
  2674.          ZOutTxt$ = MID$(ZCallersRecord$,WasZ) : _
  2675.          GOSUB 57100
  2676.       GOTO 57045
  2677. 57030 IF ZSysop THEN _
  2678.          GOSUB 57100
  2679. 57045 CallersFileIndexTemp! = CallersFileIndexTemp! -1
  2680.       GOTO 57005
  2681. 57100 IF INSTR(ZOutTxt$,"LOGON DENIED") THEN _
  2682.          IF NOT ZSysop THEN _
  2683.             RETURN
  2684.       CALL QuickTPut1 (ZOutTxt$)
  2685.       CALL AskMore ("",ZTrue,ZTrue,WasX,ZFalse)
  2686.       IF ZNo OR ZSubParm = -1 THEN _
  2687.          EXIT SUB
  2688.       RETURN
  2689.       END SUB
  2690. 58050 ' $SUBTITLE: 'AllCaps - sub to convert string to upper case'
  2691. ' $PAGE
  2692. '
  2693. '  NAME    -- AllCaps
  2694. '
  2695. '  INPUTS  --     PARAMETER           MEANING
  2696. '              ConvertField$    STRING TO MAKE UPPER CASE
  2697. '
  2698. '  OUTPUTS --  ConvertField$    CONVERTED STRINGS
  2699. '
  2700. '  PURPOSE -- Subroutine to convert a string to upper case
  2701. '
  2702.       SUB AllCaps (ConvertField$) STATIC
  2703.       IF ZTurboRBBS THEN _
  2704.          CALL RBBSULC (ConvertField$) : _
  2705.          EXIT SUB
  2706.       FOR WasZ = 1 TO LEN(ConvertField$)
  2707.          IF MID$(ConvertField$,WasZ,1) > "@" THEN _
  2708.             MID$(ConvertField$,WasZ,1) = CHR$(ASC(MID$(ConvertField$,WasZ,1)) AND 223)
  2709.       NEXT
  2710.       END SUB
  2711. 58060 ' $SUBTITLE: 'NameCaps - sub to convert name string to Proper Case'
  2712. ' $PAGE
  2713. '
  2714. '  NAME    -- NameCaps
  2715. '
  2716. '  INPUTS  --     PARAMETER           MEANING
  2717. '              ConvertField$    STRING TO CONVERT
  2718. '
  2719. '  OUTPUTS --  ConvertField$    CONVERTED STRINGS
  2720. '
  2721. '  PURPOSE -- Subroutine to convert a string to Proper Case (1st char upper)
  2722. '
  2723.       SUB NameCaps (ConvertField$) STATIC
  2724.       CALL AllCaps(ConvertField$)
  2725.       FOR WasZ = 2 TO LEN(ConvertField$)
  2726.          IF MID$(ConvertField$,WasZ,1) > "@" AND _
  2727.             MID$(ConvertField$,WasZ,1) < "[" AND _
  2728.             MID$(ConvertField$,WasZ-1,1) <> " " THEN _
  2729.             MID$(ConvertField$,WasZ,1) = CHR$(ASC(MID$(ConvertField$,WasZ,1)) OR 32)
  2730.       NEXT
  2731.       END SUB
  2732. 58070 ' $SUBTITLE: 'CheckTime - sub to see how much time is remaining'
  2733. ' $PAGE
  2734. '
  2735. '  NAME    -- CheckTime
  2736. '
  2737. '  INPUTS  -- PARAMETER               MEANING
  2738. '             TargetTime              TARGET TIME
  2739. '             ChectimeOption      1 = TELL US TIME REMAINING BETWEEN CURRENT
  2740. '                                     TIME AND TargetTime
  2741. '                                 2 = TELL US TIME ELAPSED BETWEEN TargetTime
  2742. '                                     AND CURRENT TIME
  2743. '
  2744. '  OUTPUTS -- PARAMETER               MEANING
  2745. '             TimeRemaining!      POSITIVE OR NEGATIVE NUMBER INDICATING
  2746. '                                 TIME REMAINING OR ELAPSED.  VALUE MAY BE
  2747. '                                 TESTED FOR "TIME EXPIRED".  NEGATIVE
  2748. '                                 OR ZERO, AND THE TIME HAS BEEN REACHED.
  2749. '                                 ELAPSED TIME CAN BE 0 TO 86400 (24 HRS)
  2750. '                                 TIME REMAINING CAN BE 0 TO 43200 OR
  2751. '                                  -43200 TO 0 (+ OR - 12 HRS)
  2752. '             ZSubParm (Option 1 ONLY!)
  2753. '                                 1 = Time REMAINING is > 0
  2754. '                                 2 = Time REMAINING is <= 0
  2755. '
  2756. '
  2757. '  PURPOSE -- Subroutine to provide time measurement functions.  Will
  2758. '             determine whether a target time has been reached, how much
  2759. '             time is remaining, or how much time has elapsed.
  2760. '
  2761.       SUB CheckTime (TargetTime!, TimeRemaining!, CkOption) STATIC
  2762.       IF TargetTime! > 86400 THEN _
  2763.          TestTime! = 86400 : _
  2764.          OverTime! = TargetTime! - 86400 _
  2765.       ELSE _
  2766.          TestTime! = TargetTime! : _
  2767.          OverTime! = 0
  2768.       TimeRemaining! = (TestTime! - TIMER) + OverTime!
  2769.       IF CkOption = 2 THEN GOTO 58072
  2770.       IF TimeRemaining! < -43200 THEN _
  2771.          TimeRemaining! = TimeRemaining! + 86400
  2772.       IF TimeRemaining! > 43200 THEN _
  2773.          TimeRemaining! = TimeRemaining! - 86400
  2774.       IF TimeRemaining! >= 0 THEN _
  2775.          ZSubParm = 1 _
  2776.       ELSE _
  2777.          ZSubParm = 2
  2778.       EXIT SUB
  2779. 58072 IF TimeRemaining! > 0 THEN _
  2780.          TimeRemaining! = 86400 - TimeRemaining! _
  2781.       ELSE _
  2782.          TimeRemaining! = -(TimeRemaining!)
  2783.       END SUB
  2784. 58080 ' $SUBTITLE: 'HashRBBS - sub to determine where to look for user'
  2785. ' $PAGE
  2786. '
  2787. '  NAME    -- HashRBBS
  2788. '
  2789. '  INPUTS  --     PARAMETER           MEANING
  2790. '               StringToHash$    USER NAME TO LOCATE
  2791. '               MaxPosition      MAXIMUM # USERS
  2792. '
  2793. '  OUTPUTS --     PrimeHash       WHERE TO LOOK First
  2794. '                SecondHash       LOOK THIS FAR AHEAD
  2795. '
  2796. '  PURPOSE -- Where to look for a user in users file
  2797. '             Look first at prime position, then add
  2798. '             SecondHash until find or find unused record
  2799. '
  2800.       SUB HashRBBS (StringToHash$,MaxPosition,PrimeHash,SecondHash) STATIC
  2801.       SecondHash = (ASC(MID$(StringToHash$,2,1)) * 10  + 7) MOD _
  2802.            MaxPosition
  2803.       PrimeHash = _
  2804.            ((ASC(StringToHash$) * 100  + _
  2805.              ASC(MID$(StringToHash$,(LEN(StringToHash$) / 2) + .1,1)) * _
  2806.              10  + _
  2807.              ASC(RIGHT$(StringToHash$,1))) _
  2808.              MOD MaxPosition) + 1
  2809.       END SUB
  2810. 58100 ' $SUBTITLE: 'SetOpts - sub to set prompts based on user security'
  2811. ' $PAGE
  2812. '
  2813. '  NAME    -- SetOpts
  2814. '
  2815. '  INPUTS  --     PARAMETER           MEANING
  2816. '                   First             POSITION WHERE START LOOKING
  2817. '                   Last              POSITION WHERE QUIT LOOKING
  2818. '                   ZUserSecLevel     SECURITY OF USER
  2819. '
  2820. '  OUTPUTS -- Options$              LIST OF COMMANDS USER CAN DO
  2821. '
  2822. '  PURPOSE -- String together what commands user can do in a section
  2823. '
  2824.       SUB SetOpts (Options$,InvalidOptions$,First,Last) STATIC
  2825.       Options$ = ""
  2826.       InvalidOptions$ = ""
  2827.       FOR WasI = First TO Last
  2828.          IF ZUserSecLevel < ZOptSec(WasI) THEN _
  2829.             InvalidOptions$ = InvalidOptions$ + _
  2830.                                MID$(ZAllOpts$,WasI,1) _
  2831.          ELSE IF MID$(ZAllOpts$,WasI,1) <> " " THEN _
  2832.                  Options$ = Options$ + _
  2833.                             MID$(ZAllOpts$,WasI,1)
  2834.       NEXT
  2835.       CALL SortString (Options$)
  2836.       CALL SortString (InvalidOptions$)
  2837.       END SUB
  2838. 58110 ' $SUBTITLE: 'CheckNewBul - sub to check whether got new bulletins'
  2839. ' $PAGE
  2840. '
  2841. '  NAME    -- CheckNewBul
  2842. '
  2843. '  INPUTS  --     PARAMETER           MEANING
  2844. '                 LastOn$             Last DATE OF LOGON
  2845. '                                   FORMAT MM/DD/YY
  2846. '                 ZActiveBulletins  # OF BULLETING
  2847. '                 ZBulletinPrefix$  FILESPEC FOR BULLETINS
  2848. '
  2849. '  OUTPUTS --     NumNewBullets   NUMBER OF NEW BULLETINS
  2850. '                 NewBullets$      LIST OF NEW BULLET #'S
  2851. '                 ZWasQ            WHERE Last BULLETIN STORED
  2852. '                                  IN ZUserIn$()
  2853. '                 ZUserIn$()       BULLETINS #'S THAT ARE NEW
  2854. '                                    (2,3,4,...)
  2855. '
  2856. '  PURPOSE -- Checks how many bulletins have system date
  2857. '             at or later than date caller last logged on
  2858. '
  2859.       SUB CheckNewBul (LastOn$,NumNewBullets,NewBullets$) STATIC
  2860.       IF ZExitToDoors OR ZBulletinPrefix$ = ZPrevPrefix$ THEN _
  2861.          EXIT SUB
  2862.       ZPrevPrefix$ = ZBulletinPrefix$
  2863.       NumNewBullets = 0
  2864.       NewBullets$ = ":  "
  2865.       BaseDate# = VAL(MID$(LastOn$,4,2)) + (100 * VAL(MID$(LastOn$,1,2))) + _
  2866.                    (10000# * (1900 + VAL(MID$(LastOn$,7,2))))
  2867.       CALL FindIt (ZBulletinPrefix$ + ".FCK")
  2868.       WasX = 0
  2869.       CALL QuickTPut ("Checking new bulletins",0)
  2870.       IF ZOK THEN _
  2871.          WHILE NOT EOF(2) : _
  2872.             LINE INPUT #2,WasBN$ : _
  2873.             GOSUB 58112 : _
  2874.          WEND _
  2875.       ELSE FOR WasI = 1 TO ZActiveBulletins : _
  2876.               WasBN$ = MID$(STR$(WasI),2) : _
  2877.               GOSUB 58112 : _
  2878.            NEXT
  2879.       ZWasQ = NumNewBullets + 1
  2880.       IF NumNewBullets < 1 THEN _
  2881.          NewBullets$ = ""
  2882.       CALL SkipLine (1)
  2883.       ZOutTxt$ = STR$(NumNewBullets) + _
  2884.            " NEW BULLETIN(S) since last call" + _
  2885.            NewBullets$
  2886.       CALL QuickTPut1 (ZOutTxt$)
  2887.       EXIT SUB
  2888. 58112 IF WasBN$ = "N" THEN _
  2889.          WasX$ = ZNewsFileName$ + CHR$(0) _
  2890.       ELSE WasX$ = ZBulletinPrefix$ + WasBN$ + CHR$(0)
  2891.       CALL MarkTime (WasX)
  2892.       CALL RBBSFind (WasX$,WasIX,Year,WasMM,WasDD)
  2893.       IF WasIX = 0 THEN _
  2894.          FDate# = WasDD + (100 * WasMM) + (10000# * (Year + 1980)) : _
  2895.          IF BaseDate# <= FDate# THEN _
  2896.             NumNewBullets = NumNewBullets + 1 : _
  2897.             ZUserIn$(NumNewBullets + 1) = WasBN$ : _
  2898.             NewBullets$ = NewBullets$ + _
  2899.             " " + _
  2900.             WasBN$
  2901.       RETURN
  2902.       END SUB
  2903. 58120 ' $SUBTITLE: 'SortString - sub to sort characters in a string'
  2904. ' $PAGE
  2905. '
  2906. '  NAME    -- SortString
  2907. '
  2908. '  INPUTS  --     PARAMETER           MEANING
  2909. '                 Strng$           STRING TO SORT
  2910. '
  2911. '  OUTPUTS --     Strng$           SORTED STRING
  2912. '
  2913. '  PURPOSE -- Sorts characters in passed string.
  2914. '
  2915.       SUB SortString (Strng$) STATIC
  2916.       Sort0 = LEN(Strng$)
  2917.       Sort1 = Sort0
  2918.       WasX$ = "!"
  2919. 58122 Sort1 = Sort1\2
  2920.       IF Sort1 = 0 THEN _
  2921.          EXIT SUB
  2922.       Sort2 = Sort0 - Sort1
  2923.       FOR Sort3 = 1 TO Sort2
  2924.          Sort4 = Sort3
  2925. 58124    Sort5 = Sort4 + Sort1
  2926.          IF MID$(Strng$,Sort4,1) > MID$(Strng$,Sort5,1) THEN _
  2927.             LSET WasX$ = MID$(Strng$,Sort4,1) : _
  2928.             MID$(Strng$,Sort4,1) = MID$(Strng$,Sort5,1) : _
  2929.             MID$(Strng$,Sort5,1) = WasX$ : _
  2930.             Sort4 = Sort4 - Sort1 : _
  2931.             IF Sort4 > 0 THEN _
  2932.                GOTO 58124
  2933.       NEXT
  2934.       GOTO 58122
  2935.       END SUB
  2936. 58130 ' $SUBTITLE: 'AddCommas - sub to format commands in command prompt'
  2937. ' $PAGE
  2938. '
  2939. '  NAME    -- AddCommas
  2940. '
  2941. '  INPUTS  --     PARAMETER           MEANING
  2942. '                 Strng$           STRING TO REPLACE
  2943. '
  2944. '  OUTPUTS --     Strng$           REPLACED STRING
  2945. '
  2946. '  PURPOSE -- Inserts commands between each letter in Strng$
  2947. '             and encloses in pointed brackets
  2948. '
  2949.       SUB AddCommas (Strng$) STATIC
  2950.       WasL = LEN(Strng$)
  2951.       IF WasL < 1 THEN _
  2952.          EXIT SUB
  2953.       LSET ZLineMes$ = " <" + _
  2954.                       LEFT$(Strng$,1)
  2955.       FOR WasK = 2 TO WasL
  2956.          MID$(ZLineMes$,2 * WasK,2) = "," + _
  2957.                                   MID$(Strng$,WasK,1)
  2958.       NEXT
  2959.       Strng$ = LEFT$(ZLineMes$,2 * WasL + 1) + _
  2960.                ">"
  2961.       END SUB
  2962. 58140 ' $SUBTITLE: 'LoadNew - subroutine to get latest uploads'
  2963. ' $PAGE
  2964. '
  2965. '  NAME    -- LoadNew
  2966. '
  2967. '  INPUTS  --     PARAMETER           MEANING
  2968. '               ZUpldDir$             LIST OF FILES UPLOADED
  2969. '
  2970. '  OUTPUTS --   ZOutTxt$              LATEST UPLOADS
  2971. '
  2972. '  PURPOSE -- Loads table of most recent number of uploads by date
  2973. '
  2974.       SUB LoadNew (Ara(2)) STATIC
  2975.       IF ZFMSDirectory$ = "" THEN _
  2976.          EXIT SUB
  2977.       ZPrevBase$ = ""
  2978.       IF PrevLoadNew$ = ZFMSDirectory$ THEN _
  2979.          Ara(1,1) = 0 : _
  2980.          EXIT SUB
  2981.       PrevLoadNew$ = ZFMSDirectory$
  2982.       CALL OpenFMS (LastRec)
  2983.       FIELD 2, 23 AS PreDate$, _
  2984.                 2 AS WasMM$, _
  2985.                 1 AS Fill1$, _
  2986.                 2 AS WasDD$, _
  2987.                 1 AS Fill2$, _
  2988.                 2 AS Year$, _
  2989.                 (2 + ZMaxDescLen) AS Fill3$, _
  2990.                 3 AS Category$, _
  2991.                 2 AS Fill4$
  2992.       MaxRecs = UBOUND(Ara,1)
  2993.       IF MaxRecs < 1 THEN _
  2994.          MaxRecs = 1 _
  2995.       ELSE IF MaxRecs > 23 THEN _
  2996.               MaxRecs = 23
  2997.       WasL = 0
  2998.       WasK = LastRec
  2999.       WHILE WasK > 0 AND WasL < MaxRecs
  3000.          GET #2,WasK
  3001.          IF INSTR("\= ",LEFT$(PreDate$,1)) > 0 THEN _
  3002.             GOTO 58142
  3003.          IF (ZCanDnldFromUp OR Category$ <> ZDefaultCatCode$) THEN _
  3004.             WasL = WasL + 1 : _
  3005.             Ara(WasL,1) = 372 * (VAL(Year$) - 80) + 31 * VAL(WasMM$) + VAL(WasDD$)
  3006.          IF NOT ZCanDnldFromUp THEN _
  3007.             WasX = ZMinSecToView _
  3008.          ELSE IF Category$ = "***" THEN _
  3009.                  WasX = ZSysopSecLevel _
  3010.               ELSE IF Category$ = ZDefaultCatCode$ THEN _
  3011.                       WasX = ZMinSecToView _
  3012.                    ELSE WasX = ZOptSec(19)
  3013.          Ara(WasL,2) = WasX
  3014. 58142    WasK = WasK - 1
  3015.       WEND
  3016.       CLOSE 2
  3017.       END SUB
  3018. 58150 ' $SUBTITLE: 'CountNewFiles - sub to count how many files new'
  3019. ' $PAGE
  3020. '
  3021. '  NAME    -- CountNewFiles
  3022. '
  3023. '  INPUTS  --     PARAMETER           MEANING
  3024. '                  LastOn$          Date of last logon
  3025. '                  UPLDS$            Latest uploads
  3026. '
  3027. '  OUTPUTS --    NumNewFiles       How many after last logon
  3028. '                RptPrefix$         Set to "At least " if
  3029. '                                    above is a minimum
  3030. '
  3031. '  PURPOSE -- Checks how many files in UPLDS$ were uploaded on or
  3032. '             after date of last logon that the user can download
  3033. '
  3034.       SUB CountNewFiles (LastOn$,Upld(2),NumUserFiles,RptPrefix$) STATIC
  3035.       BaseDate = 372 * (VAL(MID$(LastOn$,7,2)) - 80) + _
  3036.                   31 * (VAL(MID$(LastOn$,1,2))) + _
  3037.                   VAL(MID$(LastOn$,4,2))
  3038.       NumNewFiles = 1
  3039.       NumUserFiles = 0
  3040.       WHILE (BaseDate <= Upld(NumNewFiles,1) AND _
  3041.                 Upld(NumNewFiles,1) > 0 AND _
  3042.                 NumNewFiles < UBOUND(Upld,1))
  3043.          IF ZUserSecLevel => Upld(NumNewFiles,2) THEN _
  3044.             NumUserFiles = NumUserFiles + 1
  3045.          NumNewFiles = NumNewFiles + 1
  3046.       WEND
  3047.       IF Upld(NumNewFiles,1) < 1 THEN _
  3048.          NumNewFiles = NumNewFiles - 1
  3049.       IF BaseDate <= Upld(NumNewFiles,1) THEN _
  3050.          RptPrefix$ = "At least " _
  3051.       ELSE RptPrefix$ = ""
  3052.       END SUB
  3053. 58160 ' $SUBTITLE: 'CountLines - sub to determine file categories '
  3054. ' $PAGE
  3055. '
  3056. '  NAME    -- CountLines
  3057. '
  3058. '  INPUTS  -- PARAMETER             MEANING
  3059. '             ZDirCatFile$          NAME OF THE FILE THAT HAS THE
  3060. '                                   NUMBER OF CATEGORIES IN IT.
  3061. '
  3062. '  OUTPUTS -- MaxEntries           NUMBER OF FILE CATEGORIES
  3063. '
  3064. '  PURPOSE -- Subroutine to count the number of categories that a
  3065. '             file can be classified into.
  3066. '
  3067.       SUB CountLines (MaxEntries) STATIC
  3068.       CALL LinesInFile (ZDirCatFile$,MaxEntries)
  3069.       MaxEntries = MaxEntries + 3
  3070.       IF MaxEntries < 10 THEN _
  3071.          MaxEntries = 10
  3072.       END SUB
  3073. 58161 ' $SUBTITLE: 'CountLines - sub to determine file categories '
  3074. ' $PAGE
  3075. '
  3076. '  NAME    -- LinesInFile
  3077. '
  3078. '  INPUTS  -- PARAMETER             MEANING
  3079. '             FilName$              Name of file to use
  3080. '
  3081. '  OUTPUTS -- LineCount                  Count of # of lines in file
  3082. '
  3083. '  PURPOSE -- Subroutine to count the number of categories that a
  3084. '             file can be classified into.
  3085. '
  3086.       SUB LinesInFile (FilName$,LineCount) STATIC
  3087.       CALL FindIt (FilName$)
  3088.       LineCount = 0
  3089.       IF ZOK THEN _
  3090.          WHILE NOT EOF(2) : _
  3091.             LineCount = LineCount + 1 : _
  3092.             LINE INPUT #2,ZOutTxt$ : _
  3093.          WEND
  3094.       CLOSE 2
  3095.       END SUB
  3096. 58162 ' $SUBTITLE: 'InitFMS - sub to initialize file management system'
  3097. ' $PAGE
  3098. '
  3099. '  NAME    -- InitFMS
  3100. '
  3101. '  INPUTS  -- PARAMETER             MEANING
  3102. '             ZFMSDirectory$
  3103. '
  3104. '  OUTPUTS -- ZCategoryName$()  ELEMENTS 1,2, POSSIBLY MORE
  3105. '             ZCategoryCode$()  ELEMENTS 1,2, POSSIBLY MORE
  3106. '             ZCategoryDesc$()  ELEMENTS 1,2, POSSIBLY MORE
  3107. '             CategoryIndex     COUNT OF # ELEMENTS IN THE FILE
  3108. '                               MANAGMENT SYSTEM
  3109. '
  3110. '  PURPOSE -- Subroutine to initialize the RBBS-PC File Management System
  3111. '
  3112.      SUB InitFMS (ZCategoryName$(1),ZCategoryCode$(1), _
  3113.                    ZCategoryDesc$(1),CategoryIndex) STATIC
  3114.       Blank$ = " "
  3115.       CategoryIndex = 0
  3116.       IF ZFMSDirectory$ <> "" THEN _
  3117.          CategoryIndex = CategoryIndex + 1 : _
  3118.          CatN$ = ZCategoryName$(CategoryIndex) : _
  3119.          CALL BreakFileName (ZFMSDirectory$,DrvPath$,CatN$,Extension$,ZFalse) : _
  3120.          ZCategoryName$(CategoryIndex) = CatN$ : _
  3121.          ZCategoryCode$(CategoryIndex) = "" : _
  3122.          ZCategoryDesc$(CategoryIndex) = "All uploads"_
  3123.       ELSE ZLimitSearchToFMS = ZFalse : _
  3124.            EXIT SUB
  3125.       IF ZLimitSearchToFMS OR ZMasterDirName$ = ZMainFMSDir$ THEN _
  3126.          CategoryIndex = CategoryIndex + 1 : _
  3127.          ZCategoryName$(CategoryIndex) = "ALL" : _
  3128.          ZCategoryCode$(CategoryIndex) = "" : _
  3129.          ZCategoryDesc$(CategoryIndex) = "All files"
  3130.       CALL FindIt (ZDirCatFile$)
  3131.       IF NOT ZOK THEN _
  3132.          EXIT SUB
  3133.       WHILE NOT EOF(2)
  3134.          CALL ReadParms (ZWorkAra$(),3,1)
  3135.          IF ZErrCode > 0 THEN _
  3136.             ZErrCode = 0 : _
  3137.             CALL PScrn (ZDirCatFile$+" invalid.  Line" + STR$(CategoryIndex) + " needs 3 parms") : _
  3138.             CALL DelayTime (4) _
  3139.          ELSE CategoryIndex = CategoryIndex + 1 : _
  3140.               ZCategoryName$(CategoryIndex) = ZWorkAra$(1) : _
  3141.               ZCategoryCode$(CategoryIndex) = ZWorkAra$(2) : _
  3142.               ZCategoryDesc$(CategoryIndex) = ZWorkAra$(3) : _
  3143.               CatR$ = ZCategoryCode$(CategoryIndex) : _
  3144.               CALL Remove (CatR$,Blank$) : _
  3145.               ZCategoryCode$(CategoryIndex) = CatR$
  3146.       WEND
  3147.       CLOSE 2
  3148.       END SUB
  3149. 58165 ' $SUBTITLE: 'DispUpDir - sub to display upload direcotry'
  3150. ' $PAGE
  3151. '
  3152. '  NAME    -- DispUpDir
  3153. '
  3154. '  INPUTS  -- PARAMETER             MEANING
  3155. '             PassedCats$         FILE "CATEGORIES" TO BE INCLUDED IN
  3156. '                                 THE SEARCH.
  3157. '             SearchString$       STRING TO SEARCH ON WITHIN THE
  3158. '                                 FILE "CATEGORIES" SELECTED
  3159. '             SearchDate$         DATE EQUAL TO OR GREATER THAN TO BE
  3160. '                                 SEARCHED FOR WITH THE "CATEGORIES"
  3161. '                                 AND THE STRING TO SEARCH.
  3162. '             DnldFlag            SET TO RECORD # OF LINE TO BEGIN
  3163. '                                 VIEWING - 0 IF AT END
  3164. '
  3165. '  OUTPUTS -- DnldFlag            WHENEVER DOWNLOAD REQUESTED, SETS
  3166. '                                 TO NEXT RECORD TO VIEW.  OTHERWISE
  3167. '                                 LEAVES AT ZERO
  3168. '  PURPOSE -- Display the files that meet the criteria selected in
  3169. '             RBBS-PC upload management system on the users screen.
  3170. '
  3171.       SUB DispUpDir (PassedCats$,SearchString$, _
  3172.                     SearchDate$,DnldFlag,AbortIndex) STATIC
  3173.       CALL AllCaps (SearchString$)
  3174.       Blank$ = " "
  3175.       ZStopInterrupts = ZFalse
  3176.       ZLastIndex = 0
  3177.       Categories$ = "," + _
  3178.                     PassedCats$ + _
  3179.                     ","
  3180.       CanDnld = (ZUserSecLevel => ZOptSec(19))
  3181.       ZJumpSupported = ZTrue
  3182.       ZJumpSearching = ZFalse
  3183.       GOSUB 58185
  3184.       IF DnldFlag > 0 THEN _
  3185.          UpldIndex = DnldFlag : _
  3186.          DnldFlag = 0 : _
  3187.          GOTO 58180
  3188.       ZJumpLast$ = ""
  3189.       SearchFor$ = SearchString$
  3190.       ExtraPrompt$ = LEFT$(",V)iew",6+4*ZExpertUser)
  3191.       IF CanDnld THEN _
  3192.          IF ZTurboKeyUser THEN _
  3193.             ExtraPrompt$ = ExtraPrompt$ + ",D)ownload" _
  3194.          ELSE ExtraPrompt$ = ExtraPrompt$ + ", file(s) to dwnld"
  3195.       MaxPrint = ZPageLength - 1
  3196.       BelowMinSec = (ZUserSecLevel < ZMinSecToView)
  3197.       ZNonStop = ZNonStop OR (ZPageLength < 1)
  3198.       FMSCheckPoint = 0
  3199.       WildSearch = (INSTR(SearchString$,"?") > 0) _
  3200.                      OR (INSTR(SearchString$,"*") > 0)
  3201. 58168 UpldIndex = UpldIndex + ZUpInc
  3202.       IF UpldIndex = CutoffRec THEN _
  3203.          GOTO 58182
  3204.       GET #2,UpldIndex
  3205.       FMSCheckPoint = FMSCheckPoint + 1
  3206.       ON INSTR("\* =",LEFT$(PartToPrint$,1)) GOTO 58168,58171,58170,58169
  3207.       GOTO 58172
  3208. 58169 CALL CheckInt (MID$(PartToPrint$,34))
  3209.       IF ZUserSecLevel < ZTestedIntValue THEN _
  3210.          LastOK = ZFalse : _
  3211.          GOTO 58168
  3212.       MID$(PartToPrint$,1,13) = MID$(PartToPrint$,2,12) + " "
  3213.       ZWasA = LEN(STR$(ZTestedIntValue))
  3214.       MID$(PartToPrint$,34) = MID$(PartToPrint$,34 + ZWasA) + SPACE$(ZWasA)
  3215.       GOTO 58172
  3216. 58170 IF ZExtendedOff THEN _
  3217.          GOTO 58168 _
  3218.       ELSE IF LastOK THEN _
  3219.          GOTO 58175 _
  3220.       ELSE IF ZJumpSearching THEN _
  3221.               GOTO 58187 _
  3222.            ELSE IF SearchString$ <> "" AND (NOT WildSearch) AND FailedSearch THEN _
  3223.                    GOTO 58187 _
  3224.                 ELSE GOTO 58168
  3225. 58171 IF Category$ = "***" THEN _
  3226.          GOTO 58176 _
  3227.       ELSE HoldCat$ = "," + Category$ + "," : _
  3228.            IF INSTR(Categories$,HoldCat$) > 0 THEN _
  3229.               GOTO 58176 _
  3230.            ELSE GOTO 58168
  3231. 58172 LastOK = ZFalse
  3232.       FailedSearch = ZFalse
  3233.       LastFName = UpldIndex
  3234.       IF Category$ = "***" THEN _
  3235.          IF NOT ZSysop THEN _
  3236.             GOTO 58178
  3237.       IF Category$ = ZDefaultCatCode$ THEN _
  3238.          IF BelowMinSec THEN _
  3239.             GOTO 58178
  3240. 58173 IF LEN(Categories$) > 2 THEN _
  3241.          HoldCat$ = "," + _
  3242.                 Category$ + _
  3243.                 "," : _
  3244.          CALL Remove (HoldCat$,Blank$) : _
  3245.          IF INSTR(Categories$,HoldCat$) = 0 THEN _
  3246.             GOTO 58178
  3247.       IF ZJumpSearching OR SearchString$ <> "" THEN _
  3248.          ZOutTxt$ = PartToPrint$ : _
  3249.          IF WildSearch THEN _
  3250.             Temp$ = LEFT$(PartToPrint$,INSTR(PartToPrint$," ")-1) : _
  3251.             Temp$ = MID$(Temp$,1-(LEFT$(Temp$,1)="=")) : _
  3252.             CALL WildFile (SearchString$,Temp$,ZOK) : _
  3253.             IF ZOK THEN _
  3254.                FoundString$ = SearchString$ : _
  3255.                GOTO 58175 _
  3256.             ELSE GOTO 58178 _
  3257.          ELSE CALL AllCaps (ZOutTxt$) : _
  3258.               HiLitePos = INSTR(ZOutTxt$,SearchFor$) : _
  3259.               IF HiLitePos = 0 THEN _
  3260.                  FailedSearch = ZTrue : _
  3261.                  GOTO 58178 _
  3262.               ELSE HiLiteRec = UpldIndex : _
  3263.                    FoundString$ = SearchFor$ : _
  3264.                    IF ZJumpSearching THEN _
  3265.                       ZJumpSearching = ZFalse : _
  3266.                       SearchFor$ = PrevSearch$
  3267. 58174 IF SearchDate$ <> "" THEN _
  3268.          HoldCat$ = MID$(PartToPrint$,30,2) + _
  3269.                 MID$(PartToPrint$,24,2) + _
  3270.                 MID$(PartToPrint$,27,2) : _
  3271.          IF HoldCat$ < SearchDate$ THEN _
  3272.             IF ZDateOrderedFMS THEN _
  3273.                GOTO 58183 _
  3274.             ELSE GOTO 58168
  3275. '
  3276. '
  3277. ' * Allow the FMS to be both fast and interruptable if a local
  3278. ' * user or there is nothing in the input buffer by using QuickTPut.
  3279. '
  3280. '
  3281. 58175 LastOK = ZTrue
  3282. 58176 ZWasA = EndDesc
  3283.       IF LEFT$(PartToPrint$,5) = "     " THEN _
  3284.          GOTO 58178
  3285.       ZOutTxt$ = PartToPrint$
  3286.       CALL TrimTrail (ZOutTxt$," ")
  3287.       CALL ColorDir (ZOutTxt$,"Y")
  3288.       IF UpldIndex = HiLiteRec THEN _
  3289.          HiLiteRec = -1 : _
  3290.          HiLitePos = 0 : _
  3291.          CALL CheckColor (ZOutTxt$,FoundString$,"")
  3292. 58177 IF ZLocalUser THEN _
  3293.          CALL QuickTPut1 (ZOutTxt$) : _
  3294.          GOTO 58178
  3295.       CALL EofComm (Char)
  3296.       IF Char = -1 THEN _
  3297.          CALL QuickTPut1 (ZOutTxt$) _
  3298.       ELSE ZSubParm = 5 : _
  3299.            CALL TPut : _
  3300.            IF ZRet THEN _
  3301.               GOTO 58183
  3302. 58178 IF ZLinesPrinted <= MaxPrint AND FMSCheckPoint < 1000 THEN _
  3303.          GOTO 58168
  3304.       CALL CheckCarrier
  3305.       IF ZSubParm = -1 THEN _
  3306.          GOTO 58183
  3307.       CALL TimeRemain (MinsRemaining)
  3308.       IF MinsRemaining <= 0 THEN _
  3309.          ZSubParm = -1 : _
  3310.          GOTO 58183
  3311.       IF ZNonStop THEN _
  3312.          GOTO 58168
  3313.       IF ZLinesPrinted <= MaxPrint THEN _
  3314.          CALL QuickTPut1 (ZEmphasizeOff$ + "Files checked thru " + MID$(PartToPrint$,24,8))
  3315. 58180 ZTurboKey = -ZTurboKeyUser
  3316.       ZStackC = ZTrue
  3317.       CALL AskMore (ExtraPrompt$, ZTrue, ZFalse,AbortIndex,ZFalse)
  3318.       IF ZSubParm = -1 THEN _
  3319.          GOTO 58183
  3320.       IF ZNo THEN _
  3321.          GOTO 58183
  3322.       CALL AllCaps (ZUserIn$(1))
  3323.       IF ZUserIn$(1) = "V" THEN _
  3324.          ZLastIndex = ZWasQ : _
  3325.          ZAnsIndex = 1 : _
  3326.          CALL GetArc : _
  3327.          ZWasA = UpldIndex : _
  3328.          GOSUB 58185 : _
  3329.          UpldIndex = ZWasA : _
  3330.          GOTO 58180
  3331.       IF ZUserIn$(1) = "D" THEN _
  3332.          ZOutTxt$ = "Download what file(s)" : _
  3333.          ZStackC = ZTrue : _
  3334.          CALL PopCmdStack : _
  3335.          IF ZWasQ = 0 THEN _
  3336.             GOTO 58180
  3337.       IF ZJumpSearching THEN _
  3338.          PrevSearch$ = SearchFor$ : _
  3339.          SearchFor$ = ZJumpTo$ _
  3340.       ELSE SearchFor$ = SearchString$ : _
  3341.            IF LEN(ZUserIn$(1)) > 1 THEN _
  3342.            IF NOT ZYes AND CanDnld THEN _
  3343.               CALL SkipLine (1) : _
  3344.               DnldFlag = UpldIndex : _
  3345.               ZLastIndex = ZWasQ : _
  3346.               ZAnsIndex = 1 : _
  3347.               EXIT SUB
  3348.       IF ZNonStop THEN IF UpldIndex > 999 THEN _
  3349.          IF (SearchDate$ = "" OR NOT ZExpertUser) THEN _
  3350.             ZOutTxt$ = STR$(UpldIndex) + _
  3351.                " lines left to search.  Really go non-stop? (Y/[N])" : _
  3352.             ZNoAdvance = ZTrue : _
  3353.             ZTurboKey = -ZTurboKeyUser : _
  3354.             ZSubParm = 1 : _
  3355.             CALL TGet : _
  3356.             CALL WipeLine (79) : _
  3357.             ZNonStop = ZYes
  3358.       FMSCheckPoint = 0
  3359.       GOTO 58168
  3360. 58182 IF ZChainedDir$ <> "" THEN _
  3361.          ZActiveFMSDir$ = ZChainedDir$ : _
  3362.          GOSUB 58185 : _
  3363.          GOTO 58168
  3364. 58183 CLOSE 2
  3365.       ZNonStop = (ZPageLength < 1)
  3366.       ZStopInterrupts = ZFalse
  3367.       ZOutTxt$ = ""
  3368.       ZJumpSupported = ZFalse
  3369.       EXIT SUB
  3370. 58185 CALL OpenFMS (UpldIndex)
  3371.       EndDesc = 33 + ZMaxDescLen
  3372.       FIELD 2, EndDesc AS PartToPrint$, _
  3373.                3 AS Category$, _
  3374.                2 AS Filler$
  3375.       PrevFMS$ = ZActiveFMSDir$
  3376.       IF ZUpInc = -1 THEN _
  3377.          CutoffRec = 0 : _
  3378.          UpldIndex = UpldIndex + 1 _
  3379.       ELSE CutoffRec = UpldIndex + 1 : _
  3380.            UpldIndex = 0
  3381.       RETURN
  3382. 58187 ZOutTxt$ = PartToPrint$
  3383.       CALL AllCaps (ZOutTxt$)
  3384.       HiLitePos = INSTR(ZOutTxt$,SearchFor$)
  3385.       IF HiLitePos < 1 THEN _
  3386.          GOTO 58168
  3387.       HiLiteRec = UpldIndex
  3388.       UpldIndex = LastFName
  3389.       GET 2,UpldIndex
  3390.       FoundString$ = SearchFor$
  3391.       IF ZJumpSearching THEN _
  3392.          SearchFor$ = PrevSearch$
  3393.       GOTO 58175
  3394.       END SUB
  3395.