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