home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / MAPL0206.ZIP / MBS30206.MRG < prev    next >
Encoding:
Text File  |  1993-02-06  |  98.7 KB  |  2,584 lines
  1. * ------------[ BLED merge (c) Ken Goosens ]-------------
  2. * Merge this against E:\RBBS\STOCK\RBBSSUB3.BAS to produce E:\RBBS\CHAT\RBBSSUB3.BAS
  3. * E:\RBBS\STOCK\RBBSSUB3.BAS:  Date 6-20-1992  Size 129071 bytes
  4. * ------------[ Created 02-06-1993 06:07:19 ]------------
  5. * REPLACING old line(s) by new
  6. ' $linesize:132
  7. ' $title: 'RBBSSUB3.BAS 17.4, Copyright 1986 - 92 by D. Thomas Mack'
  8. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  9. '  Name ...............: RBBSSUB3.BAS
  10. '  First Released .....: June 21, 1992
  11. '  Subsequent Releases.: 
  12. '  Copyright ..........: 1986 - 1992
  13. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  14. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  15. '     require error trapping are incorporated within RBBSSUB 2-5 as
  16. '     separately callable subroutines in order to free up as much
  17. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  18. '  Parameters..........: Most parameters are passed via a COMMON statement.
  19. '
  20. ' Subroutine  Line               Function of Subroutine
  21. '   Name     Number
  22. '  AllCaps         58050 Convert a string to all upper case characters
  23. '  AMorPM          41498 Calculate the current time as AM or PM
  24. '  AskGraphics     43004 Determine users graphic default
  25. * ------[ first line different ]------
  26. '  BadFile         20841 Check for system crash attempt with bad device name 'Pe 09/11/91
  27. '  Carrier         42000 Test for whether to continue in RBBS
  28. '  CheckTime       58070 Test to insure that users don't exceed their time
  29. '  CheckCarrier    42005 Checks whether still have carrier
  30. '  CheckNewBul     58110 Check for new bulletins based on their file creation date
  31. '  CheckTimeRemain 41007 Set up to log off if time exceeded  'Lk 10/24/91
  32. '  CommInfo        44020 Get users baud rate and parity in a string format
  33. '  CountLines      58160 Count categories a file can be classified into
  34. '  CountNewFiles   58150 Check for number of files uploaded after a specific date
  35. '  DelayTime       50495 Wait number of seconds specified before returning
  36. '  DispCall        57001 Display callers file
  37. '  DispTimeRemain  41032 Compute and display time remaining
  38. '  DispUpDir       58165 Display the shared directory of the FMS mng. sys.
  39. '  FileLock        21993 Allow files to be shared among multiple RBBS-PC's
  40. '  FindFKey        30595 Handle local keyboard's function & ZSysop's keys
  41. '  FindLast        58600 Finds last occurence of a string in a string
  42. '  FlushKeys       35000  Completely flush all user input
  43. '  Graphic         43031 Determines if graphic ver of file exists, opens as #2
  44. '  GraphicX        43031 Determines if graphic ver of file exists, any file #
  45. '  HashRBBS        58080 "Hash" to a user's record in the USERS file
  46. '  InitFMS         58162 Initialize the RBBS-PC's File Management System
  47. '  InitIBM         30000 Open/create NetBIOS semaphore file
  48. '  AddCommas       58130 Format commands in the command prompt
  49. '  Library         21105 Provide support for "library" drives
  50. '  LinesInFile     58161 Counts lines in a file
  51. '  LoadNew         58140 Find the latest uploads
  52. '  ModemPut        52070 Write a modem command string to the modem
  53. '  NameCaps        58060 Convert a string to Proper Case (for name output)
  54. '  OpenMsg         30500 Open the messages file as file number 1
  55. '  PageUp          33202 Display user info. on local screen for ZSysop
  56. '  ReadProf        44000 Read user's profile on return from a "door"
  57. '  SaveProf        43068 Save the user's provile when exiting to "doors" or DOS
  58. '  SetOpts         58100 Set correct prompt line for each subsystem
  59. '  SortString      58120 Sort characters in a string
  60. '  TimeRemain      41010 Compute time remaining in minutes
  61. '  UpdtUpload      20705 Updates upload directory file
  62. '  WildFile        20290 Determines whether string matches a pattern
  63. '  XferType        21600 Identify the file transfer protocol
  64. '
  65. '  $INCLUDE: 'RBBS-VAR.BAS'
  66. '
  67. * REPLACING old line(s) by new
  68. 20290 ' $SUBTITLE: 'WildFile -- Matches file to a filespec'
  69. ' $PAGE
  70. '  NAME    -- WildFile
  71. '
  72. '  INPUTS  -- PARAMETER             MEANING
  73. '             Pattern$           PATTERN TO CHECK AGAINST
  74. '             ItemToMatch$       FILE NAME TO MATCH
  75. '
  76. '  OUTPUTS -- DoesMatch         WHETHER MATCHES
  77. '
  78. '  PURPOSE  Determine whether a file name is an instance of
  79. '    a file specification.  Exactly like DOS except that ? must have a
  80. '    character.
  81. '
  82.       SUB WildFile (Pattern$,ItemToMatch$,DoesMatch) STATIC
  83.       IF Pattern$ <> PrevPattern$ THEN _
  84.          CALL BreakFileName (Pattern$,PDrive$,PPrefix$,PExt$,ZFalse) : _
  85.          PrevPattern$ = Pattern$
  86.       CALL BreakFileName (ItemToMatch$,IDrive$,IPrefix$,IExt$,ZFalse)
  87.       DoesMatch = ZFalse
  88.       IF PDrive$ <> "" AND PDrive$ <> IDrive$ THEN _
  89.          EXIT SUB
  90.       CALL WildCard (PPrefix$,IPrefix$)
  91.       IF NOT ZOK THEN _
  92.          EXIT SUB
  93.       CALL WildCard (PExt$,IExt$)
  94.       DoesMatch = ZOK
  95.       END SUB
  96. * ------[ first line different ]------
  97. '
  98. ' Pe 02/03/90---- Removed SendName and Testuser subs
  99. '
  100. '
  101.  
  102. ' ********* Maple UPDTU... ******
  103. '
  104. '
  105. * DELETING old line(s)
  106. 20293
  107. 20295
  108. 20296
  109. 20298
  110. 20300
  111. 20305
  112. 20306
  113. 20310
  114. 20313
  115. 20315
  116. * REPLACING old line(s) by new
  117. 20705 ' $SUBTITLE: 'UpdtUpload -- Updates upload directory'
  118. ' $PAGE
  119. * ------[ first line different ]------
  120. '  SUBROUTINE NAME    -- UpdtUpload
  121. '
  122. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  123. '                        ZFileName$
  124. '                        ZUpldDir$
  125. '                        ZFileNameHold$
  126. '                        ZShareIt
  127. '                        ZFMSDirectory$
  128. '                        ZWasQ!
  129. '                        TCA!
  130. '
  131. '  OUTPut PARAMETERS  -- ZBytesInFile#
  132. '                        ZSecsPerSession!
  133. '
  134. '  SUBROUTINE PURPOSE -- UPON A SUCCESSFUL UPLOAD, ADD ENTRY TO THE UPLOAD
  135. '                        DIRECTORY AND GIVE ANY SESSION TIME CREDIT.
  136. '
  137.       SUB UpdtUpload (ZCategoryName$(1),ZCategoryCode$(1),LinesInDesc,WasFF) STATIC '<===
  138.       ON WasFF GOTO 20710,20724,20722   'Pe 11/20/89
  139. * DELETING old line(s)
  140. 20708
  141. 20709
  142. * REPLACING old line(s) by new
  143. * ------[ first line different ]------
  144. 20710 ZAlreadyGiven = ZFalse         'Pe BatchUp Mod
  145.       ZAbort = ZFalse    ' PE ZAbort MOD
  146.       X = 92
  147.       Gosub 20800
  148.       Call QuickTput1 ("Describe " + ZFileNameHold$ )
  149.       Call QuickTput1( OutTxt$)
  150.       X = 93
  151.       Gosub 20800
  152.       Call QuickTput1 ( LEFT$(OutTxt$,ZMaxDescLen - 4) + "Max>")    'JW03-20-92
  153.       ZOutTxt$ = ""
  154.       ZSubParm = 1
  155.       ZParseOff = ZTrue
  156.       CALL TGet
  157.       CALL Carrier
  158.       IF ZSubParm = -1 THEN _                'Pe 11/20/89
  159.          EXIT SUB                            'Pe 11/20/89
  160.       TempUserIn$ = ZUserIn$                 'Pe 02/17/90
  161.       CALL AllCaps (TempUserIn$)             'Pe 02/17/90
  162.       IF TempUserIn$ = "ABORT" THEN _        'Pe 02/17/90
  163.       ZAbort = ZTrue : _
  164.       TempUserIn$ = "" : _                    'Pe 02/17/90
  165.       EXIT SUB
  166.       IF LEN(ZUserIn$) > ZMaxDescLen OR LEN(ZUserIn$) < 7 THEN _
  167.       X = 94 : _
  168.       Gosub 20800 : _
  169.       CALL QuickTput1(OutTxt$ + STR$(ZMaxDescLen) + " chars max") : _
  170.       X = 95 : _
  171.       Gosub 20800 : _
  172.       Call QuickTput1 (OutTxt$) : _
  173.          GOTO 20710
  174. * REPLACING old line(s) by new
  175. * ------[ first line different ]------
  176. 20712 ZDesc$ = ZUserIn$
  177.       IF NOT ZLimitSearchToFMS THEN _
  178.          IF ZFMSDirectory$ <> ZUpldDir$ THEN _
  179.       IF LEFT$(ZUserIn$,1) = "/" OR LEFT$(ZUserIn$,1) = "\" THEN _
  180.              GOTO 20719_
  181.             ELSE GOTO 20716
  182. * REPLACING old line(s) by new
  183. * ------[ first line different ]------
  184. 20715  IF LEFT$(ZUserIn$,1) = "/" OR LEFT$(ZUserIn$,1) = "\" THEN _
  185.          ZUCat$ = "***" : _
  186.          GOTO 20719
  187. * INSERTING new line(s)
  188. 20716 ZUCat$ = ZDefaultCatCode$
  189.       IF ZSubParm = -1 OR _
  190.       ZUserSecLevel < ZSLCategorizeUplds THEN _
  191.       GOTO 20719
  192.      If ZMplPersUpload = Ztrue Then _                      'Pe 06/08/91
  193.                Goto 20719
  194. * REPLACING old line(s) by new
  195. * ------[ first line different ]------
  196. 20717 TempIndex = ZLastIndex             'Pe 09/14/91
  197.       CALL BufFile (ZUpcatHelp$,WasX)
  198.       ZLastIndex = TempIndex             'Pe 09/14/91
  199. * REPLACING old line(s) by new
  200. * ------[ first line different ]------
  201. 20718 X = 294       'Pe 01/27/93
  202.       Gosub 20800    'Pe 01/27/93
  203.       ZOutTxt$ = OutTxt$
  204.       ZSubParm = 1
  205.       CALL TGet
  206.       CALL AraAllCaps (ZUserIn$(),1)
  207.       IF ZSubParm = -1 THEN _
  208.        EXIT SUB                                   'Pe 11/20/89
  209.       IF ZWasQ = 0 THEN _
  210.          GOTO 20717
  211.       IF ZUserIn$(1) = "H" OR _
  212.          ZUserIn$(1) = "*" OR _
  213.          ZUserIn$(1) = "?" THEN _
  214.          GOTO 20717
  215.       CALL SearchArray (ZUserIn$(1),ZCategoryName$(),ZNumCategories,Found)
  216.       IF Found > 0 THEN _
  217.          ZUCat$ = ZCategoryCode$(Found) : _
  218.          IF LEN(ZUCat$) > 0 AND LEN(ZUCat$) < 4 AND INSTR(ZUCat$,",") = 0 THEN _
  219.             GOTO 20719
  220.       ZUCat$ = ""
  221.       IF NOT ZLimitSearchToFMS THEN _
  222.          StrewTo$ = ZDirPath$ + _
  223.                      ZUserIn$(1) + _
  224.                      "." + _
  225.                      ZDirExtension$ : _
  226.    CALL FindIt (StrewTo$) : _                  'Pe 11/21/89
  227.     IF ZOK THEN _
  228.             GOTO 20719 _
  229.          ELSE CALL WORDInFile (ZUpcatHelp$,ZUserIn$(1),ZOK) : _
  230.               IF ZOK THEN _
  231.                  GOTO 20719
  232.       StrewTo$ = ""
  233.       X = 96
  234.       Gosub 20800
  235.       CALL QuickTPut1 (OutTxt$ + " " + ZUserIn$(1)) 
  236.       Call MenuPlus (6)                               ' Pe Menu174
  237.       GOTO 20717                                      'Pe 11/21/89
  238. * REPLACING old line(s) by new
  239. * ------[ first line different ]------
  240. 20719 IF ZUpBatchTransfer Then _
  241.       CALL BatchUpLoad (ZDesc$,ZUCat$,1) : _
  242.          Goto 20720
  243.           IF ZMplPersUpload = ZTrue THEN _
  244.            ZMplPersUpload = ZFalse : _
  245.           GOTO 20720
  246.         IF ZUserSecLevel >= ZAskExtendedDesc AND _
  247.          ZMaxExtendedLines > 0 AND ZSubParm <> -1 THEN _
  248.       X = 97 : _      'Pe 01/19/93
  249.       Gosub 20800 : _ 'Pe 01/19/93
  250.          ZOutTxt$ = OutTxt$ + " " + ZFileNameHold$ + " (Y,[N])" : _
  251.          ZTurboKey = -ZTurboKeyUser : _
  252.          ZSubParm = 1 : _
  253.          CALL TGet : _
  254.      IF ZSubParm <> -1 THEN _
  255.         IF  ZYes THEN _
  256.        CALL SkipLine (2):_
  257.       X = 98 : _          'Pe 01/19/93
  258.       Gosub 20800 :_       'Pe 01/19/93
  259.       CALL QuickTPut (Chr$(7)+OutTxt$,2) : _
  260.     CALL DelayTime (2) :_
  261.    ZGetExtDesc = ZTrue
  262.   '
  263. * REPLACING old line(s) by new
  264. * ------[ first line different ]------
  265. 20720 CALL OpenOutW ("UPDESC" +ZNodeID$ +".LST")
  266.           Print #2, ZFileName$
  267.           Print #2, ZFileNameHold$
  268.           Print #2, ZDesc$
  269.           Print #2, ZUCat$
  270.           Print #2, ZActiveFMSDir$
  271.           Print #2, ZFMSDirectory$
  272.           Print #2, ZAbort
  273.           Print #2, ZGetExtDesc
  274.           Print #2, StrewTo$
  275.           Print #2, ZAllwaysStrewTo$
  276.           Print #2, ZUpldDir$
  277.           Close 2
  278.   EXIT SUB
  279. ' *********   routine AFTER the Upload is successfull and Extended = True *****
  280. '
  281. * REPLACING old line(s) by new
  282. * ------[ first line different ]------
  283. 20722 GOSUB 20760       'Pe 09/12/91
  284.       GOTO 20732        'Pe 09/12/91
  285. '
  286. '***** ENTRY POINT WHEN UPLOAD is Finished ***********
  287. '
  288. * DELETING old line(s)
  289. 20723
  290. * INSERTING new line(s)
  291.  20724 IF ZPrivateDoor THEN
  292.         CALL OpenWork (2,"UPDESC" +ZNodeID$ +".LST")
  293.          While Not EOF(2)
  294.           Input #2, ZFileName$
  295.           Input #2, ZFileNameHold$
  296.           Input #2, ZDesc$
  297.           Input #2, ZUCat$
  298.           Input #2, ZActiveFMSDir$
  299.           Input #2, ZFMSDirectory$
  300.           Input #2, ZAbort
  301.           Input #2, ZGetExtDesc
  302.           Input #2, StrewTo$
  303.           Input #2, ZAllwaysStrewTo$
  304.           InPut #2, ZUpldDir$
  305.          Wend
  306.         Close 2
  307.     END IF
  308.      CALL KillWork ("UPDESC" +ZNodeID$ +".LST")      'Pe 06/10/92
  309.          IF ZErrCode > 0 THEN _                      'Pe 06/10/92
  310.             ZErrCode = 0                             'Pe 06/10/92
  311.   GOSUB 20738        'find uploaded file
  312. '
  313. If Not ZAlreadyGiven THEN
  314.     CALL TimeRemain (MinsRemaining)
  315.       IF ZPrivateDoor THEN _
  316.          WasX! = ZUpldTimeFactor! * ZWasQ! _
  317.       ELSE WasX! = ZUpldTimeFactor! * (ZSecsUsedSession! - ZWasQ!)
  318. END IF
  319. '
  320. '************************ New Convert code begins here *******************
  321. ' added X2ZIP?.LST.......01/18/90
  322. '
  323. '      Zip Convert code.  Does the following:
  324. '     IF X2ZIP? (?=Node #) is found then any file extension
  325. '     Listed in this file is NOT touched any other file will
  326. '     Be converted to ZIP format. IF the file is NOT found then
  327. '     user is asked to convert file....!! 
  328. '     The First line determins weather to ask user to Convert or not
  329. '     This should either be a Yes or NO (in Upper case only) if Yes
  330. '     then  user has the option of converting the file the rest of the
  331. '     file should have one EXTENSION  per line including the "."
  332. '    ex: .ARC <CR> 
  333. '
  334. '      PKUNZIP, PKZIP, PKUNPAK, PAK, LHARC, ZOO.BAT, WHAT.EXE, and LOOZ.EXE
  335. '         should be in the DOS path or the RBBS directory.  WHAT is used by
  336. '         ZOO.BAT
  337. '
  338. '      The Library work path (Config parm # 304) is used for a work area !!!
  339. '
  340.   IF ZAbort = ZTrue THEN _     'Corrects aborted uploads
  341.     EXIT SUB                'corrects aborted uploads
  342.      CALL BreakFileName (ZFileName$, WDR$, WZZ$, WX$, ZTrue)    'Pe 11/26/89
  343. '
  344. ' Pe 09/25/91 to next comment
  345. '
  346. CALL BreakFileName (ZFileName$,Pre$,Body$,Ext$,ZFalse)
  347.   WasX$ = ZDiskForDos$ + "TESTUP.BAT"                     'Pe 12/25/92
  348.    CALL FindIt (WasX$)
  349.      IF ZOK THEN
  350.        IF ZSysop OR ZUserSecLevel >= ZAddDirSecurity THEN ' DD120201
  351.         ZSubParm = 1                                      ' DD120201
  352.          X = 295       'Pe 01/27/93
  353.          Gosub 20800    'Pe 01/27/93
  354.         ZOutTxt$ = OutTxt$ + _           ' DD120201     'Pe 12/05/92
  355.                    ZFileNameHold$ + "([Y],N)"       ' DD120201     'Pe 12/27/92
  356.         ZTurboKey = -ZTurboKeyUser                        ' DD120201
  357.         CALL TGet                                         ' DD120201
  358.         IF ZSubParm = -1 THEN _                           ' DD120201
  359.            EXIT SUB                                       ' DD120201
  360.           IF ZNO THEN _                                   ' DD120201
  361.              GOTO 20727                                   ' DD120201
  362.        END IF                                             ' DD120201
  363. '
  364.       X = 99 : _          'Pe 01/19/93
  365.       Gosub 20800 :_       'Pe 01/19/93
  366.      CALL QuickTPut1 (OutTxt$)
  367.       CALL ReadDir (2,1)
  368.        ZGSRAra$(2) = ZNodeWorkDrvPath$ + "VCHK" + ZNodeFileID$
  369.        IF EOF(2) THEN _
  370.         WasX$ = ZOutTxt$ : _
  371.         ZGSRAra$(1) = ZFileName$ _
  372.         ELSE _
  373.    WasX$ = WasX$ + " " + ZFileName$ + " " + Pre$ + _
  374.            " "+ Body$ + " " + Ext$ + " " + ZNodeId$
  375.    WasX$ = WasX$ +" " +  ZGSRAra$(2) + _  'Pe 12/25/92
  376.                  " " + ZComPort$ + " " + ZFirstName$ : _          'Pe 12/25/92
  377.           IF ZWasBatchTransfer THEN _                             'Pe 12/25/92
  378.            CALL TimeBack (1)                                      'Pe 12/25/92
  379.        CALL ShellExit (WasX$)
  380.        CALL FindIt (ZGSRAra$(2))
  381.        IF ZOK THEN _
  382.          IF LOF(2) > 2 THEN _
  383.             ZBytesInFile# = 0.0 : _
  384.              X = 100 : _          'Pe 01/19/93
  385.               Gosub 20800 :_       'Pe 01/19/93
  386.              WasX$ = OutTxt$ + " " + ZFileNameHold$ : _
  387.               CALL QuickTPut1 (WasX$) : _
  388.              CALL UpdtCalr (WasX$,2) : _
  389.             CALL KillWork (ZFileName$) : _
  390.             CALL KillWork (ZGSRAra$(2)) : _    ' Pe 02/04/92
  391.            ZGetExtDesc = ZFalse : _                               'Pe 12/25/92
  392.            EXIT SUB
  393.       IF ZWasBatchTransfer THEN _                                 'Pe 12/25/92
  394.          CALL TimeBack (2)                                        'Pe 12/25/92
  395.   END IF                                                          'Pe 12/26/92
  396.  
  397. Call FindIt (ZDiskForDos$ + "CNVT2"+ ZDefaultExtension$+ "." + ZNodeId$) 'Pe 12/26/92
  398.         If NOT ZOK THEN _                                         'Pe 12/26/92
  399.           GOTO 20727                                              'Pe 12/26/92
  400. * REPLACING old line(s) by new
  401. * ------[ first line different ]------
  402. 20726 CALL BreakFileName (ZFileName$,Pre$,Body$,Ext$,ZTrue)
  403.       ZFileNameHold$ = Body$ + "." + ZDefaultExtension$
  404.       ZUserIn$(0) = ZFileName$
  405.       ZFileName$ = Pre$ + ZFileNameHold$
  406.       CALL FindIt (ZFileName$)
  407.       WX$ = "." + ZDefaultExtension$               ' Pe 12/27/92
  408.       IF NOT ZOK THEN _
  409.       CALL UpdtCalr (ZFileName$ + " < ERROR in Cnvt >",2) : _
  410.          ZFileName$ = ZGSRAra$(1) : _
  411.          CALL FindIt (ZFileName$) : _
  412.          ZFileNameHold$ = Body$ + Ext$ : _
  413.          WX$ = + Ext$ : _                      ' Pe 12/27/92
  414.          IF ZOK THEN _
  415.            ZFileName$ = ZFileNameHold$
  416. '
  417. ' ***  adds BBS name , users name and description to Zip comment if succesfull
  418. '
  419. * REPLACING old line(s) by new
  420. * ------[ first line different ]------
  421. 20727 GOSUB 20738     'Pe 11/21/89 calls findit if ok add bytes and upload#
  422. '
  423. 'Pe 01/26/92  Changes to add Zip Comments via a BAT file
  424. '             ext$ = Extension of file to add comment  eg ARJCMT.BAT for Arj's
  425. '             ZIPCMT.BAT for Zips
  426. '             format of the ZIPCMT.BAT file is as follows
  427. '             PKZIP -z [1] < [2]
  428. '
  429. '             can also use %1 %2  were %1 = Drive/path/filename
  430. '                                      %2 = Drive/Path/CommentFileName 
  431. '                                      %3 = Commport ( don't ask Why) 
  432. '
  433. '    Here is a BAT file that will add an advertisment + the Comment
  434. '   created by Maple RBBS to the Zip header ( WHY ??)
  435. '
  436. '    @Echo off
  437. '    Copy c:\Upload\MyAd.txt+c:\upload\upload.cmt c:\upload\upload1.cmt
  438. '    copy c:\upload\upload1.cmt c:\upload\upload.cmt
  439. '    del c:\upload\upload1.cmt
  440. '    PKZIP -z %1 < %2
  441. '
  442.     IF ZBytesInFile# > 2.0 THEN
  443.       CALL BreakFileName (ZFileName$,Pre$,Body$,Ext$,ZTrue)  'Pe 11/30/92
  444.      WasX$ = ZDiskForDos$+Mid$(Ext$,2,3)+"CMT.BAT"
  445.       CALL FindIt (WasX$)
  446.         IF ZOK THEN
  447.           CLOSE 2
  448.          X = 101           'Pe 01/19/93
  449.           Gosub 20800       'Pe 01/19/93
  450.           CALL QuickTPut (OutTxt$ + " " + ZFileNameHold$ + " ..." ,2)
  451.            CommentName$ =ZUpldSubDir$ +"\UPLOAD.CMT
  452.           ADDCMT1$ =ZCrLf$ +"Uploaded to "+ ZRBBSName$ +" By: "+ZActiveUserName$
  453.          ADDCMT2$ = ZCrLf$ +"Description: " + ZDesc$
  454.         ADDCOMMENT$ =  ADDCMT1$ + ADDCMT2$ + ZCrLf$
  455.        CALL OpenOutW (CommentName$)
  456.       PRINT #2, ADDCOMMENT$
  457.      CLOSE 2
  458.  
  459.           ZGSRAra$(3) = MID$(RIGHT$(ZComPort$,1)+"0",1-ZLocalUser, 1)
  460.            CALL OpenWork (2,WasX$)
  461.            CALL ReadDir (2,1)
  462.                 IF EOF(2) THEN _
  463.                    ZWasZ$ = ZOutTxt$ : _
  464.                    ZGSRAra$(1) = ZFileName$ : _
  465.                    ZGSRAra$(2) = CommentName$ _
  466.                 ELSE ZWasZ$ = WasX$ + " " + ZFileName$ + _
  467.                               " " + CommentName$ + " " + ZGSRAra$(3)
  468.             CALL ShellExit (ZWasZ$)
  469.  
  470.          GOSUB 20738          ' Adjust Bytes in file make sure we got it
  471.      END IF
  472.    END IF
  473.   ZOK = 0
  474.    CALL CheckNovell (ZOK)
  475.     IF ZOK <> -1 THEN _
  476.       CALL SetSharedAttr (ZFileName$, ZOK) : _
  477.        IF ZOK <> 0 THEN _
  478.         CALL PScrn ("Error setting shared attribute")
  479.       IF ZGetExtDesc THEN _
  480.         EXIT SUB 
  481. GOSUB 20760                   'Pe 09/12/91
  482.  
  483. * DELETING old line(s)
  484. 20728
  485. 20729
  486. 20731
  487. * REPLACING old line(s) by new
  488. * ------[ first line different ]------
  489. 20732 If ZMusic = ZFalse Then                                       'Pe 03/13/92
  490.       IF LEFT$(ZUserIn$,1) = "/" OR LEFT$(ZUserIn$,1) = "\" OR NumPersonals > 0 THEN _
  491.       WX$ = WX$+"*"    'Pe 01/25/92
  492.       CALL AMorPM                                                  'Pe 11/25/89
  493.    IF ZActiveUserName$ = ZSysopPswd1$ + " " + ZSysopPswd2$ THEN _  'Pe 11/25/89
  494.            ULBYNAME$ = "Sysop" _                                   'Pe 06/05/91
  495.          ELSE ULBYNAME$ = ZActiveUserName$                         'Pe 11/25/89
  496.       ULXXX$ = WZZ$+WX$+SPACE$(13-(LEN(WZZ$)+LEN(WX$)))            'Pe 01/24/90
  497.       UPLOADLG$ = "{C1"+ ULXXX$ + _                                'Pe 01/24/90
  498.                   "{C2"+ ULBYNAME$+SPACE$(34-LEN(ULBYNAME$)) + _   'Pe 01/24/90
  499.                   "{C3"+ DATE$ + "   " + _                         'Pe 01/24/90
  500.                   "{C4"+ ZTime$+" {C0"                             'Pe 01/24/90
  501.          CALL OpenWorkA (ZDirPath$ +"UPLOADLG.DEF")                'Pe 03/13/92
  502.          CALL PrintWorkA (UPLOADLG$)                               'Pe 11/25/89
  503.          CLOSE 2                                                   'Pe 01/18/90
  504. End IF                                                             'Pe 03/13/92
  505.          IF ZFMSDirectory$ <> ZUpldDir$ THEN _ 
  506.         IF LEFT$(ZUserIn$,1) = "/" OR LEFT$(ZUserIn$,1) = "\" THEN _
  507.          CALL UpdtCalr (ZUserIn$,2): _
  508.        GOTO 20733
  509. IF NumPersonals <> 0 THEN _ 
  510.          GOTO 20733            
  511.       IF ZPrivateDoor THEN _   
  512.          ZWasEN$ = ZUpldDoor$ _
  513.       ELSE ZWasEN$ = ZUpldDir$ 
  514.       GOSUB 20734 
  515. * INSERTING new line(s)
  516. 20733 ZWasDF$ = " >> uploaded << "
  517.       CALL BreakFileName (ZFileName$,DR$,WasX$,Extension$,ZTrue)
  518.       ZWasZ$ = WasX$ + _
  519.            Extension$ + _
  520.            ZWasDF$ + _
  521.            " at " + _
  522.            ZTime$ + _
  523.            " using " + _
  524.            ZWasFT$ + _
  525.            STR$(ZBytesInFile#)
  526.       CALL UpdtCalr (ZWasZ$,2)
  527.       ZUplds = ZUplds + 1
  528.       ZGlobalUplds = ZGlobalUplds + 1
  529.       ZULBytes! = ZULBytes! + ZBytesInFile#
  530.       ZGlobalULBytes! = ZGlobalULBytes! + ZBytesInFile#
  531. '
  532. IF NOT ZAlreadyGiven THEN
  533.       CALL TimeRemain (MinsRemaining!)
  534.       MinsToAdd = WasX! / 60
  535.       CALL ChkAddedTime (MinsToAdd)
  536.       WasX! = MinsToAdd * 60!
  537.       ZTimeCredits! = ZTimeCredits! + WasX!
  538.       ZSecsPerSession! = ZSecsPerSession! + WasX!
  539.       IF ZPrivateDoor THEN _
  540.          WasX! = (WasX! - ZWasQ!) / 60.0 _
  541.       ELSE WasX! = (WasX! - ZSecsUsedSession! + ZWasQ!)/60.0
  542.       WasX$ = STR$(FIX(WasX!*10.0))
  543.       WasX$ = LEFT$(WasX$,LEN(WasX$)-1) + "." + RIGHT$(WasX$,1)
  544.         IF WasX! > 1.0 THEN _
  545.       X = 102 : _          'Pe 01/19/93
  546.       Gosub 20800 :_       'Pe 01/19/93
  547.        CALL QuickTPut1 (WasX$+" "+ OutTxt$)
  548. END IF
  549.       X = 103           'Pe 01/19/93
  550.       Gosub 20800       'Pe 01/19/93
  551.       CALL QuickTPut (OutTxt$ + " " + ZFirstName$ ,1)
  552.      CALL DelayTime (2)       'Pe 02/23/90
  553.     ZGetExtDesc = ZFalse
  554.   EXIT SUB
  555. * REPLACING old line(s) by new
  556. * ------[ first line different ]------
  557. 20734 '          ---[ lock file ]---
  558.       IF ZWasEN$ = "" THEN _
  559.          RETURN
  560.       IF NOT ZPrivateDoor THEN                                       ' DD120501
  561.          tempfile$ = ZNodeWorkDrvPath$ + "FILE_ID.DIZ"               ' DD120501
  562.          CALL FindItX (tempfile$,7)                                  ' DD120501
  563.      FileIDFound = ZFalse              ' Pe 02/04/92
  564.          IF ZOK THEN                                                 ' DD120501
  565.              FileIDFound = ZTrue       ' Pe 02/04/92
  566.             ZGetExtDesc = ZTrue                                      ' DD120501
  567. '         IF LEFT$(ZDesc$,1) <> "/" AND LEFT$(ZDesc$,1) <> "\" THEN _' DD120501
  568. '              ZDesc$ = "Description within Distribution Package:"   ' DD120501
  569.             WasLL = ZRightMargin                                     ' DD120501
  570.             ZRightMargin = 30 + ZMaxDescLen                          ' DD120501
  571.             IF ZRightMargin > 74 THEN _                              ' DD120501
  572.                ZRightMargin = 74                                     ' DD120501
  573.             LinesInDesc = 0                                          ' DD120501
  574.             WHILE NOT EOF(7) AND LinesInDesc < ZMaxExtendedLines     ' DD120501
  575.                LinesInDesc = LinesInDesc + 1                         ' DD120501
  576.                LINE INPUT #7,ZOutTxt$(LinesInDesc)                   ' DD120501
  577.                IF LEN(ZOutTxt$(LinesInDesc - 1)) < (ZRightMargin - 10) AND _' DD120501
  578.                   LinesInDesc > 1 THEN _                             ' DD120501
  579.                   ZOutTxt$(LinesInDesc - 1) = ZOutTxt$(LinesInDesc - 1) + _' DD120501
  580.                      " " + ZOutTxt$(LinesInDesc) : _                 ' DD120501
  581.                   ZOutTxt$(LinesInDesc) = "" : _                     ' DD120501
  582.                   ZOutTxt$(LinesInDesc + 1) = "" : _                 ' DD120501
  583.                   LinesInDesc = LinesInDesc - 1                      ' DD120501
  584.             WEND                                                     ' DD120501
  585.             CLOSE 7                                                  ' DD120501
  586.             CALL WordWrap (ZRightMargin,LinesInDesc,ZOutTxt$())      ' DD120501
  587.             X = 104          'Pe 01/19/93
  588.             Gosub 20800      'Pe 01/19/93
  589.           CALL QuickTPut1 (CHR$(7) + ZEmphasizeOn$ + OutTxt$ + _     ' DD120501
  590.                 ZEmphasizeOff$)                                      ' DD120501
  591.             CALL KillWork (tempfile$)                                ' DD120501
  592.             ZRightMargin = WasLL                                     ' DD120501
  593.          END IF                                                      ' DD120501
  594.       tempfile$ = ZNodeWorkDrvPath$ + "DESC.SDI"                  ' DD120801
  595.   IF FileIDFound <> ZTrue Then                       ' Pe 02/04/93
  596.          CALL FindItX (tempfile$,7)                                  ' DD120801
  597.          IF ZOK THEN                                                 ' DD120801
  598.             LINE INPUT #7,ZDesc$                                     ' DD120801
  599.             IF LEN(ZDesc$) > ZMaxDescLen THEN                        ' DD120801
  600.                LeftDesc$ = LEFT$(ZDesc$,ZMaxDescLen)                 ' DD120801
  601.                RightDesc$ = RIGHT$(ZDesc$,LEN(ZDesc$)-ZMaxDescLen)   ' DD120801
  602.             END IF                                                   ' DD120801
  603.             CLOSE 7                                                  ' DD120801
  604.             ZDesc$ = LeftDesc$                                       ' DD120801
  605.          END IF                                                      ' DD120801
  606.       END IF                                                         ' DD120501
  607. End IF                                               ' Pe 02/04/92
  608.    CALL KillWork (tempfile$)                         ' Pe 02/05/92
  609.     FileIdFound = ZFalse                                 ' Pe 02/05/92
  610.       FMSFormat = ZFalse
  611.       IF (ZWasEN$ = ZFMSDirectory$ OR ZLimitSearchToFMS _
  612.           OR NumPersonals > 0 OR (ZPrivateDoor AND ZFMSDoor)) THEN _
  613.              FMSFormat = ZTrue _
  614.       ELSE CALL FindIt (ZWasEN$) : _
  615.            IF ZOK THEN _
  616.               CALL ReadDir (2,1) : _       'Pe 11/22/89
  617.               IF ZErrCode = 0 THEN _
  618.                  FMSFormat = (LEFT$(ZOutTxt$,4) = "\FMS")
  619.       IF NOT FMSFormat THEN _
  620.          ReadBackwards = ZFalse : _
  621.          FixedLen = 0 : _
  622.          ZUserIn$ = ZDesc$ : _
  623.          GOTO 20735                                  'Pe 06/08/91
  624.       FixedLen = 34 + ZMaxDescLen 
  625.       IF NumPersonals > 0 THEN _
  626.          WasX$ = "*" : _                                             ' Pe060891
  627.          MaxLen = ZPersonalLen _
  628.       ELSE MaxLen = 3 : _
  629.            WasX$ = ""                                                ' Pe060891
  630.       ZUCat$ = LEFT$(ZUCat$,MaxLen)
  631.       ZUCat$ = ZUCat$ + SPACE$(MaxLen - LEN(ZUCat$))
  632.       ZUserIn$ = ZDesc$ + _
  633.                  SPACE$(ZMaxDescLen - LEN(ZDesc$)) + _
  634.                  ZUCat$ + WasX$                                       ' Pe060891
  635.            ReadBackwards = ZTrue : _
  636.            CALL FindIt (ZWasEN$) : _
  637.            IF ZOK THEN _
  638.               CALL ReadDir (2,1) : _
  639.               IF ZErrCode = 0 THEN _
  640.                  ReadBackwards = (INSTR(ZOutTxt$," TOP ") = 0)
  641. * INSERTING new line(s)
  642. 20735 CALL LockAppend      
  643.       IF ZErrCode <> 0 THEN _
  644.          GOTO  20736
  645.  
  646. IF ZVoiceType <> 0 THEN                                        ' Pe 05/29/92
  647.       IF ReadBackwards and NumPersonals = 0 THEN _                  'PE 10/27/91
  648.      PRINT #2, using LEFT$("\                             " _  'BH042091
  649.                              + "                              " _  'BH042091
  650.                              + "                    ", _           'BH042091
  651.                    ZMaxDescLen + 32) + "\  ."; _                   'BH042091
  652.                      "  Uploaded by "+ ZActiveUserName$              'BH042091
  653.      '          ---[ append ]---
  654.       IF ZGetExtDesc THEN _
  655.          IF ReadBackwards THEN _
  656.             FOR WasI = LinesInDesc TO 1 STEP -1 : _
  657.                GOSUB 20737 : _
  658.             NEXT
  659.       PRINT #2,USING "\           \########  &  &"; _
  660.                      ZFileNameHold$; _
  661.                      ZBytesInFile#; _
  662.                      ZWasZ$; _
  663.                      ZUserIn$
  664.       IF ZGetExtDesc THEN _
  665.          IF NOT ReadBackwards THEN _
  666.             FOR WasI = 1 TO LinesInDesc : _
  667.                GOSUB 20737 : _
  668.             NEXT
  669.       IF NOT ReadBackwards and NumPersonals = 0 THEN _              ,Pe 10/27/91
  670.      PRINT #2, using LEFT$("\                             " _  'BH042091
  671.                              + "                              " _  'BH042091
  672.                              + "                    ", _           'BH042091
  673.                    ZMaxDescLen + 32) + "\  ."; _                   'BH042091
  674.                      "  Uploaded by "+ ZActiveUserName$              'BH042091
  675.        GOTO 20736
  676.    End IF                                                  'Pe 05/29/92
  677.  
  678.       IF ZGetExtDesc THEN _
  679.          IF ReadBackwards THEN _
  680.             FOR WasI = LinesInDesc TO 1 STEP -1 : _
  681.                GOSUB 20737 : _
  682.             NEXT
  683.       PRINT #2,USING "\           \########  &  &"; _
  684.                      ZFileNameHold$; _
  685.                      ZBytesInFile#; _
  686.                      ZWasZ$; _
  687.                      ZUserIn$
  688.       IF ZGetExtDesc THEN _
  689.          IF NOT ReadBackwards THEN _
  690.             FOR WasI = 1 TO LinesInDesc : _
  691.                GOSUB 20737 : _
  692.             NEXT
  693. * REPLACING old line(s) by new
  694. * ------[ first line different ]------
  695. 20736 CALL UnLockAppend      'Pe 06/08/91
  696.       FixedLen = 0
  697.       RETURN
  698. * INSERTING new line(s)
  699. 20737 WasX$ = ZOutTxt$(WasI)   'Pe 06/08/91
  700.       CALL Trim (WasX$)
  701.       IF WasX$ = "" THEN _
  702.          RETURN
  703.       IF NOT FMSFormat THEN _
  704.          PRINT #2,"  ";ZOutTxt$(WasI) : _
  705.          RETURN
  706.       IF FixedLen > LEN(ZOutTxt$(WasI)) THEN _
  707.          WasX$ = SPACE$(FixedLen - 1 - LEN(ZOutTxt$(WasI))) + "." _
  708.       ELSE WasX$ = ""
  709.       PRINT #2, "  ";LEFT$(ZOutTxt$(WasI),FixedLen);WasX$
  710.       RETURN
  711. 20738 CALL FindIt (ZFileName$)
  712. 20739 IF NOT ZOK THEN _                         'Pe 06/08/91
  713.          ZBytesInFile# = 0.0_
  714.       ELSE ZBytesInFile# = LOF(2)
  715.       IF ZBytesInFile# < 2.0 THEN _
  716.        ZAutoLogOffReq = ZFalse : _           'Pe 10/20/91     
  717.          EXIT SUB
  718.       RETURN
  719. '20747 CALL CheckInt (ZUCat$)                                          ' KG082201
  720. '      IF ZTestedIntValue > 0 THEN _                                  ' KG082201
  721. '        ZUCat$ = " " + ZUCat$                                         ' KG082201
  722. '      RETURN                                                         ' KG082201
  723. * DELETING old line(s)
  724. 20741
  725. 20742
  726. * INSERTING new line(s)
  727. 20760 CALL FindItX (ZNodeWorkFile$,7)
  728.       ZUserIn$ = ZDesc$
  729.       WasX$ = DATE$
  730.       ZWasZ$ = LEFT$(WasX$,6) + _
  731.            RIGHT$(WasX$,2)
  732.       ZWasEN$ = ZPersonalDir$
  733.       NumPersonals = 0
  734.       IF NOT ZOK THEN _                                            'Pe 06/10/92
  735.          GOTO 20781                                                'Pe 06/10/92
  736.       UserFileIndexSave = ZUserFileIndex
  737.       UserRecordHold$ = ZUserRecord$
  738.       WHILE NOT EOF(7)
  739.          CALL ReadParmsX (7,ZWorkAra$(),2,1)
  740. IF LEFT$(ZWorkAra$(1),4) <> "ALL " AND _
  741.            ZWorkAra$(1) <> "ALL" AND VAL (ZWorkAra$(2)) > 0 THEN _ 'Pe 06/10/92
  742.             NumPersonals = NumPersonals + 1 : _
  743.             ZUCat$ = ZWorkAra$(1) : _ ' GOSUB 20747  'Pe 01/31/93 don't work
  744.             GOSUB 20734 : _ 
  745.             RcvrRecNum = VAL (ZWorkAra$(2)) : _
  746.             CALL SetUserFlag (RcvrRecNum,4096,"file")
  747.       WEND
  748.       CLOSE 7
  749.       IF NumPersonals > 0 THEN _
  750.          ZUserFileIndex = UserFileIndexSave : _
  751.          LSET ZUserRecord$ = UserRecordHold$
  752. 20781 ZUserIn$ = ZDesc$
  753.       WasX$ = DATE$
  754.       ZWasZ$ = LEFT$(WasX$,6) + _
  755.                RIGHT$(WasX$,2)
  756.       ZWasEN$ = StrewTo$
  757.       GOSUB 20734
  758.       ZWasEN$ = ZAllwaysStrewTo$
  759.       GOSUB 20734
  760.       RETURN
  761. 20800 Call GetRBBSString(X,RBBSString$)      'Pe 01/16/93
  762.       OutTxt$ = RBBSString$                 'Pe 01/16/93
  763.       Return
  764.       END SUB
  765. 20841 ' $SUBTITLE: 'BadFile - subroutine to find bad file names'  'Pe 09/12/91
  766. ' $PAGE
  767. '
  768. '  NAME    -- BadFile
  769. '
  770. '  INPUTS  --     PARAMETER                    MEANING
  771. '               ZViolation$
  772. '               ZViolationsThisSession
  773. '               FilName$                      NAME OF FILE
  774. '
  775. '  OUTPUTS -- Result                      1 = FILE NAME IS OK
  776. '                                         2 = CHARACTER NOT ALLOWED
  777. '                                         3 = SYSTEM CRASH ATTEMPT
  778. '             ZViolationsThisSession     NUMBER OF VIOLATIONS
  779. '             FilName$                    Gets capitalized
  780. '
  781. '  PURPOSE -- To protect RBBS-PC against the use of bad file names
  782. '             to either crash the system or to breach RBBS-PC's security.
  783. '
  784.       SUB BadFile (FilName$,Result) STATIC
  785. '
  786. '
  787. ' *  TEST FOR INVALID CHARACTERS IN FILENAME
  788. '
  789. '
  790.       Result = 2
  791.       IF LEN(FilName$) < 1 THEN _
  792.          EXIT SUB
  793.       CALL BadFileChar (FilName$,ZOK)
  794.       IF NOT ZOK THEN _
  795.          EXIT SUB
  796.       CALL AllCaps (FilName$)
  797.       WasXX = INSTR(FilName$,".")
  798.       IF WasXX > 0 THEN _
  799.          IF WasXX < LEN(FilName$) THEN _
  800.             WasXX = INSTR(WasXX + 1,FilName$,".") : _
  801.             IF WasXX > 0 THEN _
  802.                EXIT SUB
  803.       WasXX = LEN(FilName$)
  804.       IF WasXX => 3 THEN _
  805.          IF INSTR("PRN:CON:AUX:NUL:",FilName$) THEN _
  806.             GOTO 20842
  807.       IF WasXX => 4 THEN _
  808.          IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:CLOCK$:",FilName$) THEN _ ' DD081501
  809.             GOTO 20842
  810.       CALL BreakFileName (FilName$,Pre$,Body$,Ext$,ZFalse)
  811.       IF LEN(Pre$) > 64 OR LEN(Body$) > 8 OR LEN(Body$) < 1 OR LEN(Ext$) > 3 THEN _
  812.          EXIT SUB
  813.       WasXX = LEN(Body$)
  814.       IF WasXX => 3 THEN _
  815.          IF INSTR("PRN:CON:AUX:NUL:",Body$) THEN _
  816.             GOTO 20842
  817.       IF WasXX => 4 THEN _
  818.          IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:CLOCK$:",Body$) THEN _ ' DD081501
  819.             GOTO 20842
  820.       Result = 1
  821.       EXIT SUB
  822. 20842 ZViolationsThisSession = ZMaxViolations   'Pe 09/12/91
  823.       ZViolation$ = ZViolation$ + _
  824.                    FilName$
  825.       Result = 3
  826.       END SUB
  827. '
  828. * DELETING old line(s)
  829. 21105
  830. 21110
  831. 21115
  832. 21117
  833. 21120
  834. 21121
  835. 21122
  836. 21126
  837. 21130
  838. 21140
  839. 21145
  840. 21150
  841. 21151
  842. 21152
  843. 21153
  844. 21155
  845. 21156
  846. 21157
  847. 21158
  848. 21159
  849. * REPLACING old line(s) by new
  850. 21993 ' $SUBTITLE: 'FileLock - subroutine to share RBBS-PC files'
  851. ' $PAGE
  852. '
  853. '  NAME    -- FileLock
  854. '
  855. '  INPUTS  --     PARAMETER                    MEANING
  856. '             ZSubParm               = 1 UNLOCK USERS AND MESSAGES
  857. '                                      2 FLUSH MESSAGE RECORD TO DISK
  858. '                                        AND UNLOCK MESSAGES
  859. '                                      3 LOCK MESSAGE FILE
  860. '                                      4 UNLOCK MESSAGE FILE
  861. '                                      5 LOCK USER FILE
  862. '                                      6 LOCK 4 RECORD BLOCK IN USER
  863. '                                        FILE
  864. '                                      7 UNLOCK USER FILE
  865. '                                      8 UNLOCK 4 RECORD BLOCK IN USER
  866. '                                        FILE
  867. '                                      9 LOCK UPLOAD DIRECTORY OR
  868. '                                        COMMENTS FILE
  869. '                                     10 UNLOCK UPLOAD DIRECTORY OR
  870. '                                        COMMENTS FILE
  871. '               ACTIVE.MESSAGE FILE$     NAME OF MESSAGE FILE
  872. '               ZActiveUserFile$         NAME OF USER FILE
  873. '               CONFIG.FILE.NAME$        FILE NAME TO FLUSH RECORD FROM
  874. '               ZWasEN$                  UPLOAD DIRECTORY OR COMMENTS
  875. '                                        FILE NAME TO LOCK/UNLOCK
  876. '               ZNetworkType             TYPE OF NETWORK LOCKING TO USE
  877. '
  878. '  OUTPUTS -- ZSubParm = -1 TERMINATE RBBS-PC IMMEDATELY
  879. '             ZBlk
  880. '             ZLockDrive
  881. '             ZLockFileName$
  882. '             ZLockStatus$
  883. '             ZMsgFileLock
  884. '             ZUserBlockLock
  885. '             ZUserFileLock
  886. '             ZUserFileIndex
  887. '
  888. '  PURPOSE -- To lock and unlock the shared RBBS-PC files when
  889. '             multiple copies of RBBS-PC are sharing the same
  890. '             files in either a multi-tasking DOS environment or
  891. '             in a local area network environment
  892. '
  893.       SUB FileLock STATIC
  894. * ------[ first line different ]------
  895. If ZNetworkType = 0 THEN _                          'Pe 06/26/92
  896.     Exit Sub                                        'Pe 06/26/92
  897.       ON ZSubParm GOSUB 21995,21996,22000,25000,26000, _
  898.                                     26500,27000,27500,29000,29500
  899.       EXIT SUB
  900. '
  901. '
  902. ' *  UNLOCK USERS AND MESSAGES
  903. '
  904. '
  905. * REPLACING old line(s) by new
  906. 22000 IF ZMsgFileLock = ZTrue THEN _
  907.          RETURN
  908.       ZMsgFileLock = ZTrue
  909.       MID$(ZLockStatus$,1,2) = "LM"
  910.       ZSubParm = 2
  911.       CALL Line25
  912.       ZLockFileName$ = ZActiveMessageFile$
  913.       ON ZNetworkType GOTO 22100,22200,22300,22400,22500,29700
  914.       RETURN
  915. '
  916. '
  917. * ------[ first line different ]------
  918. ' *  LOCK MESSAGE FILE (MULTI-LINK) removed in Maple code
  919. '
  920. '
  921. * REPLACING old line(s) by new
  922. * ------[ first line different ]------
  923. 22100   RETURN
  924. '
  925. '
  926. ' *  LOCK MESSAGE FILE (OMNINET)
  927. '
  928. '
  929. * REPLACING old line(s) by new
  930. 25000 IF NOT ZMsgFileLock THEN _
  931.          RETURN
  932.       ZMsgFileLock = ZFalse
  933.       MID$(ZLockStatus$,1,2) = "UM"
  934.       ZSubParm = 2
  935.       CALL Line25
  936.       ZLockFileName$ = ZActiveMessageFile$
  937.       ON ZNetworkType GOTO 25100,25200,25300,25400,25500,29800
  938.       RETURN
  939. '
  940. '
  941. * ------[ first line different ]------
  942. ' *  UNLOCK MESSAGE FILE (MULTI-LINK) removed in maple code
  943. '
  944. '
  945. * REPLACING old line(s) by new
  946. * ------[ first line different ]------
  947. 25100  RETURN
  948. '
  949. '
  950. ' *  UNLOCK MESSAGE FILE (OMNINET)
  951. '
  952. '
  953. * REPLACING old line(s) by new
  954. 26000 IF ZUserFileLock = ZTrue THEN _
  955.          RETURN
  956.       ZUserFileLock = ZTrue
  957.       MID$(ZLockStatus$,4,2) = "LU"
  958.       ZSubParm = 2
  959.       CALL Line25
  960.       ZLockFileName$ = ZActiveUserFile$
  961.       ON ZNetworkType GOTO 26100,26200,22300,26300,22500,29720
  962.       RETURN
  963. '
  964. '
  965. * ------[ first line different ]------
  966. ' *  LOCK USER FILE (MULTI-LINK) removed in maple code
  967. '
  968. '
  969. * REPLACING old line(s) by new
  970. * ------[ first line different ]------
  971. 26100  RETURN
  972. '
  973. '
  974. ' *  LOCK USER FILE (OMNINET)
  975. '
  976. '
  977. * REPLACING old line(s) by new
  978. 26500 IF ZUserBlockLock = ZTrue THEN _
  979.          RETURN
  980.       ZUserBlockLock = ZTrue
  981.       ZBlk = (ZUserFileIndex / 4) + .26
  982.       MID$(ZLockStatus$,7,2) = "LB"
  983.       ZSubParm = 2
  984.       CALL Line25
  985.       ON ZNetworkType GOTO 26600,26700,26800,26750,26900,29730
  986.       RETURN
  987. '
  988. '
  989. * ------[ first line different ]------
  990. ' *  LOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)  removed in maple code
  991. '
  992. '
  993. * REPLACING old line(s) by new
  994. * ------[ first line different ]------
  995. 26600  RETURN
  996. '
  997. '
  998. ' *  LOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
  999. '
  1000. '
  1001. * REPLACING old line(s) by new
  1002. 27000 IF NOT ZUserFileLock THEN _
  1003.          RETURN
  1004.       ZUserFileLock = ZFalse
  1005.       MID$(ZLockStatus$,4,2) = "UU"
  1006.       ZSubParm = 2
  1007.       CALL Line25
  1008.       ZLockFileName$ = ZActiveUserFile$
  1009.       ON ZNetworkType GOTO 27100,27200,25300,27300,25500,29820
  1010.       RETURN
  1011. '
  1012. '
  1013. * ------[ first line different ]------
  1014. ' *  UNLOCK USER FILE (MULTI-LINK) removed in maple code
  1015. '
  1016. '
  1017. * REPLACING old line(s) by new
  1018. * ------[ first line different ]------
  1019. 27100  RETURN
  1020. '
  1021. '
  1022. ' *  UNLOCK USER FILE (OMNINET)
  1023. '
  1024. '
  1025. * REPLACING old line(s) by new
  1026. 27500 IF NOT ZUserBlockLock THEN _
  1027.          RETURN
  1028.       ZUserBlockLock = ZFalse
  1029.       ZBlk = (ZUserFileIndex / 4) + .26
  1030.       MID$(ZLockStatus$,7,2) = "UB"
  1031.       ZSubParm = 2
  1032.       CALL Line25
  1033.       ON ZNetworkType GOTO 27600,27700,27800,27750,27900,29830
  1034.       RETURN
  1035. '
  1036. '
  1037. * ------[ first line different ]------
  1038. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK) removed in maple code
  1039. '
  1040. '
  1041. * REPLACING old line(s) by new
  1042. * ------[ first line different ]------
  1043. 27600  RETURN
  1044. '
  1045. '
  1046. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
  1047. '
  1048. '
  1049. * REPLACING old line(s) by new
  1050. 29010 RETURN
  1051. '
  1052. '
  1053. * ------[ first line different ]------
  1054. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS (MULTI-LINK) removed in mpl code
  1055. '
  1056. '
  1057. * REPLACING old line(s) by new
  1058. * ------[ first line different ]------
  1059. 29100 RETURN
  1060. '
  1061. '
  1062. ' *  LOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
  1063. '
  1064. '
  1065. * REPLACING old line(s) by new
  1066. 29510 RETURN
  1067. '
  1068. '
  1069. * ------[ first line different ]------
  1070. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS  (MULTI-LINK) remove in maple code
  1071. '
  1072. '
  1073. * REPLACING old line(s) by new
  1074. * ------[ first line different ]------
  1075. 29600  EXIT SUB
  1076. '
  1077. '
  1078. ' *  UNLOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
  1079. '
  1080. '
  1081. * REPLACING old line(s) by new
  1082. 30500 ' $SUBTITLE: 'OpenMsg - open the MESSAGES file'
  1083. ' $PAGE
  1084. '
  1085. '  NAME    -- OpenMsg
  1086. '
  1087. '  INPUTS  --     PARAMETER                    MEANING
  1088. '              ZActiveMessageFile$
  1089. '              ZShareIt
  1090. '
  1091. '  OUTPUTS --  ZMsgRec$
  1092. '
  1093.       SUB OpenMsg STATIC
  1094. '
  1095. '
  1096. ' *  OPEN AND DEFINE MESSAGE FILE
  1097. '
  1098. '
  1099. * ------[ first line different ]------
  1100.      CLOSE 1
  1101.       IF ZShareIt THEN _
  1102.          OPEN ZActiveMessageFile$ ACCESS READ WRITE SHARED AS #1 _
  1103.       ELSE OPEN "R",1,ZActiveMessageFile$
  1104.       FIELD 1,128 AS ZMsgRec$
  1105.       END SUB
  1106. * REPLACING old line(s) by new
  1107. 30595 ' $SUBTITLE: 'FindFKey - sub to handle local keyboard functions'
  1108. ' $PAGE
  1109. '
  1110. '  NAME    -- FindFKey
  1111. '
  1112. '  INPUTS  --  PARAMETER                 MEANING
  1113. '             ZActiveMenu$              INDICATOR OF ACTIVE MENU
  1114. '             ZAdjustedSecurity         Switch INDICATING TEMP. SECURITY CHANGE
  1115. * ------[ first line different ]------
  1116. '             ZFullScreenEditor         USER'S PREFERENCE FOR ANSIed
  1117. '             ZCallersFile$             NAME OF CALLERS FILE
  1118. '             ZChatAvail                Toggle INDICATING IF Sysop WILL CHAT
  1119. '             ZCheckBulletLogon         USER'S PREFERENCE FOR BULLETIN CHECK
  1120. '             ZConfMode                 INDICATOR THAT USER IS IN A CONFERENCE
  1121. '             ZCursorLine               LINE THAT THE CURSOR IS AT
  1122. '             ZCursorRow                ROW THAT THE CURSOR IS AT
  1123. '             ZDiskForDos$              DISK TO LOAD COMMAND.COM FROM
  1124. '             ZDiskFullGoOffline        INDICATOR OF WHAT TO DO WHEN DISK FULL
  1125. '             ZExitToDoors              FLAG INDICATING EXITING TO DOORS
  1126. '             ZExpertUser               FLAG FOR EXPERT/NOVICE USER MODE
  1127. '             ZFirstName$               LOGGED ON USER'S First NAME
  1128. '             ZF1Key                    FUNCTION KEY ONE VALUE
  1129. '             ZF10Key                   FUNCTION KEY TEN VALUE
  1130. '             ZWasGR                    GRAPHICS PREFERENCE OF USER
  1131. '             ZLineFeeds                SWTICH FOR USER'S LINE FEED PREFERENCE
  1132. '             ZLocalUser                FLAG INDICATING USER IS LOCAL
  1133. '             ZMinLogonSec              MINIMUM SECURITY TO LOGON
  1134. '             ZModemGoOffHookCmd$       COMMAND TO TAKE MODEM OFF-HOOK
  1135. '             ZModemInitBaud$           BAUD TO INITIALIZE MODEM AT
  1136. '             ZNodeID$                  NODE IDENTIFIER
  1137. '             ZNodeRecIndex             NODE RECORD Index FOR THIS NODE
  1138. '             ZNulls                    Switch FOR USER'S PREFERENCE FOR Nulls
  1139. '             ZPrinter                  Toggle INDICATING Printer IS AVAILABLE
  1140. '             ZPromptBell               USER'S PREFERENCE FOR BELLS ON PROMPTS
  1141. '             SECONDS.PER.SESSION       TIME LEFT IN CURRENT USER SESSION
  1142. '             ZSkipFilesLogon           USER'S LOGON NOTIFICIATION PREFERENCE
  1143. '             ZSnoop                    Toggle INDICATING Snoop STATUS
  1144. '             ZSubParm                  -8  = Sysop'S OPTION 6 REMOTELY
  1145. '                                       -9  = GOT TO DOS
  1146. '                                       -10 = Sysop GET'S SYSTEM NEXT
  1147. '             ZSysop                    INDICATOR THAT USER IS Sysop
  1148. '             ZSysopAnnoy               Toggle INDICATING Sysop IS AVAILABLE
  1149. '             ZSysopNext                Toggle SO Sysop GETS SYSTEM NEXT
  1150. '             ZUpperCase                USER'S PREFERENCE FOR UPPER/LOWER CASE
  1151. '             ZUserFileIndex            Index INTO THE USER FILE FOR CALLER
  1152. '             ZUserSecLevel             USER'S SECURITY LEVEL
  1153. '             USERT.TRANSFER.DEFAULT    USER'S FILE Transfer DEFAULT PREFERENCE
  1154. '
  1155. '  OUTPUTS --
  1156. '             ZAdjustedSecurity         Switch INDICATING TEMP. SECURITY CHANGE
  1157. '             ZChatAvail                Toggle INDICATING IF Sysop WILL CHAT
  1158. '             ZFunctionKey              VALUE 1 TO 10 CORRESPONDING TO
  1159. '                                       THE FUNCTION KEY THAT WAS PRESSED
  1160. '             ZKeyPressed$              CHARACTER STRING GENERATED BY KEY
  1161. '             ZPrinter                  TOGGLE INDICATING Printer IS AVAILABLE
  1162. '             ZSnoop                    Toggle INDICATING Snoop STATUS
  1163. '             ZSysop                    INDICATOR THAT USER IS Sysop
  1164. '             ZSysopAnnoy               Toggle INDICATING Sysop IS AVAILABLE
  1165. '             ZSysopNext                Toggle SO Sysop GETS SYSTEM NEXT
  1166. '             ZSubParm                  -1 Carrier LOST
  1167. '                                       -2 CHAT MODE ACTIVATED
  1168. '                                       -3 FORCE CALLER ON-LINE
  1169. '                                       -4 EXIT TO SYSTEM IMMEDIATELY
  1170. '                                       -5 EXIT TO SYSTEM AFTER MULTI-LINK CALL
  1171. '                                       -6 TELL USER ACCESS IS DENIED
  1172. '                                       -7 UPDATE CALLERS FILE AND DENY ACCESS
  1173. '                                       -8 Force caller OFFLINE     'Pe 01/31/93
  1174. '             ZUserSecLevel      USER'S SECURITY LEVEL
  1175. '
  1176. '  PURPOSE -- To determine if a function has been pressed on
  1177. '             the PC'S keyboard that is running RBBS-PC.
  1178. '
  1179.       SUB FindFKey STATIC
  1180.       LookUp = ZSubParm
  1181.       IF ZSubParm < -1 THEN _
  1182.          ZSubParm = 0 : _
  1183.          IF LookUp = - 8 THEN _
  1184.             GOTO 33070 _
  1185.          ELSE IF LookUp = - 9 THEN _
  1186.                  GOTO 31000 _
  1187.               ELSE IF LookUp = - 10 THEN _
  1188.                       GOTO 33090
  1189. '
  1190. '
  1191. ' *  TEST FOR FUNCTION KEY PRESSED
  1192. '
  1193. '
  1194. * REPLACING old line(s) by new
  1195. 31398 IF NOT ZLocalUser THEN _
  1196.          CALL Carrier : _
  1197.          IF ZSubParm = -1 THEN _
  1198.             GOTO 33970
  1199. * ------[ first line different ]------
  1200.        GOTO 31399                                'Pe 01/31/93
  1201. '      IF INSTR("MUF",ZActiveMenu$) > 0 THEN 
  1202.       IF INSTR("|@",ZActiveMenu$) = 0 THEN _      'Pe\05\30\91
  1203.          GOTO 31399
  1204.       ZCursorLine = CSRLIN
  1205.       ZCursorRow = POS(0)
  1206.       LOCATE 25,1
  1207.       WasD$ = SPACE$(79)
  1208.       GOSUB 33210
  1209.       LOCATE 25,1
  1210.       Call GetRBBSString(296,RBBSString$)      'Pe 01/16/93
  1211.       WasD$ = RBBSString$                 'Pe 01/16/93
  1212.       GOSUB 33210
  1213.       CALL DelayTime (1)
  1214.       LOCATE ZCursorLine,ZCursorRow
  1215.       ZSubParm = 1
  1216.       CALL Line25
  1217.       GOTO 33970
  1218. * REPLACING old line(s) by new
  1219. 31399 IF ZFunctionKey = 22 THEN _
  1220.          CALL SkipLine (2) : _
  1221. * ------[ first line different ]------
  1222.          Call GetRBBSString(105,RBBSString$): _      'Pe 01/16/93
  1223.          OutTxt$ = RBBSString$: _                 'Pe 01/16/93
  1224.          CALL QuickTPut1 ( ZFirstName$ +OutTxt$) : _
  1225.          CALL DelayTime (8 + ZBPS) : _
  1226.          ZSubParm = -8 : _   'Pe 01/30/93 was a -6
  1227.          GOTO 33970
  1228.       Call GetRBBSString(106,RBBSString$)      'Pe 01/16/93
  1229.       OutTxt$ = RBBSString$                 'Pe 01/16/93
  1230.       CALL QuickTPut1 (ZFirstName$ + OutTxt$)
  1231.       CALL DelayTime (8 + ZBPS)
  1232.       IF ZUserFileIndex < 1 THEN _
  1233.          ZSubParm = -6 : _                'Pe 07/11/91
  1234.          GOTO 33970
  1235.       ZUserSecLevel = ZMinLogonSec - 1
  1236.       CALL DenyAccess
  1237.       ZSubParm = -7                       'Pe 07/11/91
  1238.       GOTO 33970
  1239. '
  1240. '
  1241. ' * F2 - COMMAND FROM LOCAL KEYBOARD (SYSOP EXIT TO DOS AND RETURN)
  1242. '
  1243. '
  1244.  
  1245. * REPLACING old line(s) by new
  1246. 32000 IF NOT ZLocalUser THEN _
  1247.          CALL SkipLine (1) : _
  1248. * ------[ first line different ]------
  1249.     Call GetRBBSString(107,RBBSString$) : _      'Pe 01/16/93
  1250.       OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  1251.          CALL QuickTPut1 (OutTxt$) : _
  1252.          ZFunctionKey = 0 : _
  1253.          CALL DelayTime (3)
  1254.       CALL ShellExit (ZDiskForDos$ + "COMMAND")
  1255.       'SHELL ZDiskForDos$ + _
  1256.       '      "COMMAND"
  1257.       CLS
  1258.       IF NOT ZLocalUser THEN _
  1259.          CALL Carrier : _
  1260.          IF ZSubParm = -1 THEN _
  1261.             GOTO 33970
  1262.       ZSubParm = 2
  1263.       CALL Line25
  1264.     Call GetRBBSString(108,RBBSString$)       'Pe 01/16/93
  1265.       OutTxt$ = RBBSString$                 'Pe 01/16/93
  1266.       CALL QuickTPut1 (OutTxt$)
  1267.       ZCommPortStack$ = ZCarriageReturn$
  1268.       ZWasCM = 0                                                     ' DD062901/ANSICHAT
  1269.       GOTO 33970
  1270. '
  1271. '
  1272. ' * F3 - COMMAND FROM LOCAL KEYBOARD (Printer Toggle)
  1273. '
  1274. '
  1275. * REPLACING old line(s) by new
  1276. * ------[ first line different ]------
  1277. 33150 IF ZWasCM = ZTrue THEN _                                       ' DD070401/ANSICHAT
  1278.          GOTO 33970                                                  ' DD070401/ANSICHAT
  1279.       GOTO 33160
  1280. * REPLACING old line(s) by new
  1281. 33160 CALL UpdtCalr ("Sysop began chat",1)
  1282.       ZPageStatus$ = ""
  1283. * ------[ first line different ]------
  1284.       ZSysopGreeting$ = "Hi " + ZFirstName$ + ", this is " + _       ' DD062801/ANSICHAT
  1285.                         ZSysopFirstName$ + " " + ZSysopLastName$ + _ ' DD062801/ANSICHAT
  1286.                         ".  Sorry to break in and CHAT but..."       ' DD062801/ANSICHAT
  1287.  
  1288.       IF NOT ZLimitMinsPerSession THEN _                       ' LK 08/17/91
  1289.       CALL TimeBack (1)
  1290.  
  1291.       IF ZCanANSIChat = ZTrue THEN                                   ' DD071301/ANSICHAT
  1292.          CALL ANSIChat                                               ' DD062801/ANSICHAT
  1293.       ELSE
  1294.          CALL SkipLine (1)
  1295.          CALL QuickTPut1 (ZSysopGreeting$)
  1296.          CALL SysopChat
  1297.       END IF
  1298. 'Sysop chat allows overstay of Scheduled Events- no way to control giveback
  1299.       IF NOT ZLimitMinsPerSession THEN _                       ' LK 08/17/91
  1300.       CALL TimeBack (2)
  1301.       ZCommPortStack$ = CHR$(13)
  1302.       GOTO 33155
  1303. '
  1304. '
  1305. ' * UP / CTRL-UP: INCREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE
  1306. '
  1307. '
  1308. * REPLACING old line(s) by new
  1309. 33190 ZAdjustedSecurity = ZTrue
  1310.       ZUserSecSave = ZUserSecLevel
  1311.       IF (NOT ZConfMode) AND (NOT ZSubBoard) THEN _
  1312.          ZOrigSec = ZUserSecLevel
  1313.       ZSubParm = 2
  1314.       CALL Line25
  1315.       CALL SetPrompt
  1316.       GOTO 33970
  1317. '
  1318. * ------[ first line different ]------
  1319. '
  1320. ' * PGUP DISPLAY USER PROFILE
  1321. '
  1322. '
  1323. * REPLACING old line(s) by new
  1324. 33200 IF NOT ZLocalUser THEN _
  1325.          CALL Carrier : _
  1326.          IF ZSubParm = -1 THEN _
  1327.             GOTO 33970
  1328. * ------[ first line different ]------
  1329.       CALL PageUp
  1330.       WasD$ = MID$("NoviceExPERT",1 -6 * ZExpertUser,6)
  1331.       GOSUB 33210
  1332.       WasD$ = "GRAPHICS: " + _
  1333.            MID$("None AsciiColor",ZWasGR * 5 + 1,5)
  1334.       GOSUB 33210
  1335.       WasD$ = "Protocol : " + _
  1336.            ZUserXferDefault$
  1337.       GOSUB 33210
  1338.       WasD$ = "UPPER CASE " + _
  1339.            MID$("and lowerONLY", 1 - 9 * ZUpperCase,9)
  1340.       GOSUB 33210
  1341.       WasD$ = "Line Feeds " + FNOffOn$(ZLineFeeds)
  1342.       GOSUB 33210
  1343.       WasD$ = "Nulls " + FNOffOn$(ZNulls)
  1344.       GOSUB 33210
  1345.       WasD$ = "Prompt Bell " + FNOffOn$(ZPromptBell)
  1346.       GOSUB 33210
  1347.       WasD$ = MID$("SKIP CHECK",1 -5 * ZCheckBulletLogon,5) + _
  1348.            " old BULLETINS on logon."
  1349.       GOSUB 33210
  1350.       WasD$ = MID$("CHECKSKIP ",1 -5 * ZSkipFilesLogon,5) + _
  1351.            " new files on logon."
  1352.       GOSUB 33210
  1353.       WasD$ = "AnsiEditor " + FNOffOn$(ZFullScreenEditor)
  1354.       GOSUB 33210
  1355.       ZTalkAll = ZFalse
  1356.       GOTO 33970
  1357. * REPLACING old line(s) by new
  1358. 33220 IF NOT ZLocalUser THEN _
  1359.          CALL Carrier : _
  1360.          IF ZSubParm = -1 THEN _
  1361.             GOTO 33970
  1362.       CLS
  1363. * ------[ first line different ]------
  1364.       ZWasCM = 0                                                     ' DD070401/ANSICHAT
  1365.       GOTO 33155
  1366. '
  1367. '
  1368. ' * LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY ONE MINUTE
  1369. '
  1370. '
  1371. * REPLACING old line(s) by new
  1372. 33960 IF ZConfMode = ZTrue THEN _
  1373.          IF ZLocalUser THEN _
  1374.             GOTO 33970 _
  1375. * ------[ first line different ]------
  1376.          ELSE Call GetRBBSString(297,RBBSString$): _      'Pe 01/16/93
  1377.          WasD$ = RBBSString$: _                 'Pe 01/16/93
  1378.               GOSUB 33210 : _
  1379.               GOTO 33970
  1380.       ZSubParm = 3
  1381.       CALL FileLock
  1382.       IF ZSubParm = -1 THEN _
  1383.          GOTO 33970
  1384.       CALL OpenMsg
  1385.       FIELD 1,128 AS ZMsgRec$
  1386.       GET 1,ZNodeRecIndex
  1387.       MID$(ZMsgRec$,FieldPosition,2) = STR$(ChangeValue)
  1388.       CALL SaveProf (2)
  1389.       FIELD 1, 128 AS ZMsgRec$
  1390. * REPLACING old line(s) by new
  1391. * ------[ first line different ]------
  1392. 33970 IF ZFunctionKey < 22 AND ZFunctionKey > 15 THEN _           'DGS-L25MOD
  1393.          MinsRemaining = (ZSecsPerSession! - ZSecsUsedSession!) / 60 : _ 'DGS-L25
  1394.          CALL Line25                                              'DGS-L25
  1395.       END SUB                                                     'DGS-L25MOD
  1396. * REPLACING old line(s) by new
  1397. 33990 ' $SUBTITLE: 'PageUp - Display user profile to Sysop'
  1398. ' $PAGE
  1399. '
  1400. '  NAME    -- PageUp
  1401. '
  1402. '  INPUTS  --     PARAMETER                    MEANING
  1403. '                 ZActiveUserName$       CURRENT USER NAME
  1404. '                 ZDnlds                 # OF FILES DOWNLOADED
  1405. '                 ZExpirationDate$       REGISTRATION EXPIRATION
  1406. '                 ZLastDateTimeOnSave$   Last DATE & TIME ON SYSTEM
  1407. '                 ZLastMsgRead           Last MESSAGE READ BY USER
  1408. '                 ZPswdSave$             USERS PASSWORD
  1409. '                 ZTimesLoggedOn         TIMES USER HAS LOGGED ON
  1410. '                 ZUplds                 # OF FILES UPLOADED
  1411. '                 ZUserSecSave           USERS SECURITY LEVEL
  1412. '
  1413. '  OUTPUTS -- ZMsgRec$
  1414. '
  1415.       SUB PageUp STATIC
  1416.       CALL LPrnt (" ",1)
  1417.       CALL LPrnt ("USER NAME : " + ZActiveUserName$,1)
  1418.       CALL LPrnt ("SECURITY  :" + STR$(ZUserSecSave),1)
  1419. * ------[ first line different ]------
  1420.       CALL LPrnt ("PASSWORD  : " + ZPswdSave$,1)
  1421.       CALL LPrnt ("BAUD RATE : "+  ZCBaud$ + " Bps",1)       'Pe 06/01/92
  1422.       CALL LPrnt ("READ MSG. :" + STR$(ZLastMsgRead),1)
  1423.       CALL LPrnt ("TIMES ON  :" + STR$(ZTimesLoggedOn),1)
  1424.       CALL LPrnt ("LAST ON   : " + ZLastDateTimeOnSave$,1)
  1425.       CALL LPrnt ("DOWNLOADS :" + STR$(ZDnlds),1)
  1426.       CALL LPrnt ("UPLOADS   :" + STR$(ZUplds),1)
  1427.       IF ZEnforceRatios THEN _
  1428.          CALL LPrnt ("DL-BYTES  :" + STR$(ZDLBytes!),1) : _
  1429.          CALL LPrnt ("UL-BYTES  :" + STR$(ZULBytes!),1)
  1430.       IF ZRestrictByDate THEN _
  1431.          CALL LPrnt ("EXPIRATION: " + ZExpirationDate$,1)
  1432.       CALL LPrnt ("User's Profile",1)
  1433.       END SUB
  1434. * INSERTING new line(s)
  1435. 41005 ' $SUBTITLE: 'CheckTimeRemain - Kicks off if no time remaining'
  1436. ' $PAGE
  1437. '
  1438. '  NAME    -- CheckTimeRemain
  1439. '
  1440. '  INPUTS  -- PARAMETER                 MEANING
  1441. '
  1442. '  OUTPUTS -- PARAMETER                 MEANING
  1443. '             MinsRemaining         TIME IN MINUTES LEFT IN SESSION
  1444. '             ZSecsUsedSession!     TIME USED IN SECONDS
  1445. '             ZSubParm              -1 IF No TIME LEFT
  1446. '
  1447.       SUB CheckTimeRemain (MinsRemaining) STATIC
  1448.       CALL TimeRemain (MinsRemaining)
  1449.       IF ZBypassTimeCheck THEN _
  1450.          EXIT SUB
  1451.      GOTO 41009
  1452. 41007 IF MinsRemaining < 1 AND ZBankTime < 1  THEN _
  1453.         ZSubParm = -1 : _
  1454.          Return 
  1455.        ZOutTxt$ = ZFG1$+" Your Time has Expired"+ZFG2$+" - "+ZFG3$+ _
  1456.                     " Access The Time Bank  ([Y],N) "
  1457.        ZTurboKey = -ZTurboKeyUser
  1458.        CALL TGet
  1459.        IF ZSubParm = -1 THEN _
  1460.         Return
  1461.          IF ZNO THEN _
  1462.           ZSubParm = -1 : _
  1463.          return
  1464.         CALL BankTime
  1465.        IF MinsRemaining <= 0 THEN _
  1466.       ZSubParm = -1 : _
  1467.       return
  1468. * DELETING old line(s)
  1469. 41008
  1470. * INSERTING new line(s)
  1471. 41009  IF MinsRemaining < 1 THEN _
  1472.           GOSUB 41007
  1473.        IF ZSubParm = -1 Then _
  1474.           EXIT SUB
  1475.         END SUB
  1476. * REPLACING old line(s) by new
  1477. 41032 ' $SUBTITLE: 'DispTimeRemain - Display users time remaining'
  1478. ' $PAGE
  1479. '
  1480. '  NAME    -- DispTimeRemain
  1481. '
  1482. '  INPUTS  --     PARAMETER                    MEANING
  1483. '              MinsRemaining
  1484. '
  1485. '  OUTPUTS --     PARAMETER                    MEANING
  1486. '                MinsRemaining               TIME IN MINUTES LEFT IN SESSION
  1487. '
  1488.       SUB DispTimeRemain (MinsRemaining) STATIC
  1489.       CALL TimeRemain (MinsRemaining)
  1490.       CALL QuickTPut1 (ZEmphasizeOff$ + STR$(MinsRemaining) + " min left")
  1491. * ------[ first line different ]------
  1492.       Call Line25            'Pe 05/30/91
  1493.       END SUB
  1494. * REPLACING old line(s) by new
  1495. 42000 ' $SUBTITLE: 'Carrier - sub to monitor carrier on comm. port'
  1496. ' $PAGE
  1497. '
  1498. '  NAME    -- Carrier
  1499. '
  1500. '  INPUTS  --     PARAMETER                    MEANING
  1501. '              ZAutoLogoffReq                  -1 if in autologoff request
  1502. '
  1503. '  OUTPUTS --  ZSubParm = 0                    CONTINUE
  1504. '              ZSubParm = -1                   TERMINATE (No Carrier)
  1505. '
  1506. '  PURPOSE --  To test whether should continue in RBBS.  Reasons
  1507. '              NOT to continue are:  autologoff, out of time, or
  1508. '              carrier dropped.
  1509. '
  1510. * ------[ first line different ]------
  1511.       SUB Carrier STATIC                                             ' KG010902
  1512.       'IF ZAutoLogoffReq THEN _
  1513.       '   IF NOT ZSuspendAutologoff THEN _
  1514.       '      ZSubParm = -1 : _
  1515.       '      EXIT SUB
  1516.       CALL CheckCarrier
  1517.       END SUB
  1518. * REPLACING old line(s) by new
  1519. 42020 ZSubParm = -1
  1520.       IF Speedy < -8 THEN _
  1521.          EXIT SUB
  1522.       IF AlreadyWritten = -9 THEN _
  1523.          EXIT SUB
  1524.       CALL TakeOffHook
  1525.       ZModemOffHook = -1
  1526.       AlreadyWritten = -9
  1527. * ------[ first line different ]------
  1528.       IF ZDoorCarrierDropOK$ = "Y" THEN _                             ' DD011801/DOORCARRIERDROP
  1529.          CALL UpdtCalr ("Logged Off from Door",1) : _                 ' DD011801/DOORCARRIERDROP
  1530.          EXIT SUB                                                     ' DD011801/DOORCARRIERDROP
  1531.       CALL UpdtCalr ("Carrier dropped",1)
  1532.       END SUB
  1533. * REPLACING old line(s) by new
  1534. * ------[ first line different ]------
  1535. 43007 Call GetRBBSString(109,RBBSString$)      'Pe 01/16/93
  1536.       OutTxt$ = RBBSString$                 'Pe 01/16/93
  1537.       CALL QuickTPut1 (OutTxt$)
  1538.       ZOutTxt$ = "Change from " + MID$("NAC",ZWasGR+1,1) + " to N)one, A)scii-IBM, C)olor-IBM, H)elp" + ZPressEnterExpert$
  1539.       ZSubParm = 1
  1540.       ZTurboKey = -ZTurboKeyUser
  1541.       CALL TGet
  1542.       IF ZSubParm = -1 THEN _
  1543.          EXIT SUB
  1544.       IF ZWasQ = 0 THEN _
  1545.          CALL QuickTPut1 ("Unchanged") : _
  1546.          EXIT SUB
  1547.       CALL AraAllCaps (ZUserIn$(),1)
  1548.       ZWasGR = INSTR("NAC",ZUserIn$(1))
  1549.       IF ZWasGR = 2 AND NOT ZEightBit THEN _
  1550.     Call GetRBBSString(110,RBBSString$) : _      'Pe 01/16/93
  1551.       OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  1552.          CALL QuickTPut1 (OutTxt$) : _
  1553.          GOTO 43007
  1554.       IF ZWasGR = 0 THEN _
  1555.          GOTO 43006
  1556.       ZWasGR = ZWasGR - 1
  1557.       CALL SetGraphic (ZWasGR)
  1558.       END SUB
  1559. '
  1560. * REPLACING old line(s) by new
  1561. 43068 ' $SUBTITLE: 'SaveProf - subroutine to read a user profile'
  1562. ' $PAGE
  1563. '
  1564. '  NAME    -- SaveProf
  1565. '
  1566. '  INPUTS  --     PARAMETER                    MEANING
  1567. '              ZBPS
  1568. '              ZEightBit
  1569. '              ZExitToDoors
  1570. '              ZWasGR
  1571. '              ZMsgRec$
  1572. '              ZNodeRecIndex
  1573. '              ZSysop
  1574. '              ZUpperCase
  1575. '              ZTimeLoggedOn$
  1576. '              ZPrivateDoor
  1577. '              ZReliableMode
  1578. '
  1579. '  OUTPUTS -- NONE
  1580. '
  1581. '  PURPOSE -- Saves a user's options and communications parameters
  1582. '             in the node record when a user exits to a "door" so
  1583. '             that he is in the same status as when he exited.
  1584. '
  1585.       SUB SaveProf (IParm) STATIC
  1586. * ------[ first line different ]------
  1587.       ON IParm GOTO 43070,43080,43075
  1588. * REPLACING old line(s) by new
  1589. 43070 ZActiveMessageFile$ = ZOrigMsgFile$
  1590.       ZSubParm = 3
  1591.       CALL FileLock
  1592.       CALL OpenMsg
  1593.       FIELD 1, 128 AS ZMsgRec$
  1594.       GET 1,ZNodeRecIndex
  1595.       IF ZGlobalSysop THEN _
  1596.          MID$(ZMsgRec$,1,30) = "SYSOP" + SPACE$(25)
  1597.       MID$(ZMsgRec$,40,2) = STR$(ZExitToDoors)
  1598.       MID$(ZMsgRec$,42,2) = STR$(ZEightBit)
  1599. * ------[ first line different ]------
  1600.       MID$(ZMsgRec$,44,2) = RIGHT$(STR$(-ZBPS),2)    ' KG032604 ' MID$(ZMsgRec$,44,2) = STR$(ZBPS)
  1601.       MID$(ZMsgRec$,46,2) = STR$(ZUpperCase)
  1602.       MID$(ZMsgRec$,48,5) = MKS$(ZNumDnldBytes!) + MID$(STR$(-ZBatchTransfer),2)
  1603.       MID$(ZMsgRec$,53,2) = STR$(ZWasGR)
  1604.       MID$(ZMsgRec$,55,2) = STR$(ZSysop)
  1605.       MID$(ZMsgRec$,65,3) = CHR$(VAL(LEFT$(ZOrigTimeLoggedOn$,2))) + _
  1606.                             CHR$(VAL(MID$(ZOrigTimeLoggedOn$,4,2))) + _
  1607.                             CHR$(VAL(MID$(ZOrigTimeLoggedOn$,7,2)))
  1608.       MID$(ZMsgRec$,72,2) = STR$(ZPrivateDoor)
  1609.       MID$(ZMsgRec$,74,1) = MID$(STR$(ZTransferFunction),2,1)
  1610.       MID$(ZMsgRec$,75,1) = ZWasFT$
  1611.       MID$(ZMsgRec$,113,2) = MKI$(CINT(ZTimeCredits!)/60)
  1612.       MID$(ZMsgRec$,79,8) = LEFT$(ZDooredTo$+"        ",8)
  1613.       MID$(ZMsgRec$,91,2) = STR$(ZReliableMode)
  1614.       CALL BreakFileName (ZCurPUI$,ZOutTxt$,ZUserIn$,ZWasZ$,ZFalse)
  1615.       MID$(ZMsgRec$,93,8) = ZUserIn$ + SPACE$(8 - LEN(ZUserIn$))
  1616.       IF ZLocalUser THEN _
  1617.          ZWasZ$ = ZCarriageReturn$ + ZCarriageReturn$ _
  1618.       ELSE ZWasZ$ = " 0"
  1619.       MID$(ZMsgRec$,101,2) = ZWasZ$
  1620.       MID$(ZMsgRec$,103,2) = STR$(ZLocalUserMode)
  1621.       ZConfName$ = LEFT$(ZConfName$,INSTR(ZConfName$ + " "," ") - 1)
  1622.       MID$(ZMsgRec$,105,8) = ZConfName$ + SPACE$(8 - LEN(ZConfName$))
  1623.       MID$(ZMsgRec$,115,1) = MID$(STR$(ZAutoLogoffReq),2,1)
  1624.       MID$(ZMsgRec$,117,2) = STR$(ZMenuIndex)
  1625.       MID$(ZMsgRec$,119,2) = LEFT$(DATE$,2)
  1626.       MID$(ZMsgRec$,121,2) = MID$(DATE$,4,2)
  1627.       MID$(ZMsgRec$,123,2) = RIGHT$(DATE$,2)
  1628.       MID$(ZMsgRec$,125,2) = LEFT$(TIME$,2)
  1629.       MID$(ZMsgRec$,127,2) = MID$(TIME$,4,2)
  1630. ' ***   Save additional parameters for door restoral
  1631. * INSERTING new line(s)
  1632. 43075 CALL OpenOutW (ZNodeWorkDrvPath$+"DRST"+ZNodeFileID$+".DEF")
  1633.       CALL PrintWorkA (STR$(ZLimitMinsPerSession))
  1634.       CALL PrintWorkA (ZWasNG$)
  1635.       CALL PrintWorkA (ZIndivValue$)
  1636.       CALL PrintWorkA (ZOrigDateTimeOn$)
  1637.       CALL PrintWorkA (ZOrigTimeLoggedOn$)
  1638.       CALL PrintWorkA (STR$(ZUserFileIndex))
  1639.       CALL PrintWorkA (ZUpldDir$)
  1640.       ZOutTxt$ = STR$(ZUpldDir$ = ZFMSDirectory$ OR ZLimitSearchToFMS)
  1641.       CALL PrintWorkA (ZOutTxt$)
  1642.       CALL PrintWorkA (ZCBaud$)
  1643.       CALL PrintWorkA (STR$(ZCanANSIChat))                           ' DD071901/ANSICHAT
  1644.       CALL PrintWorkA (STR$(ZBankTime))        'lk 08/17/91 Save for Xpress
  1645.       CALL PrintWorkA (STR$(ZBPS))                   'Pe 07/11/92
  1646.       Call PrintWorkA (STR$(ZCBPS))                  'Pe 07/11/92
  1647.       Call PrintWorkA (ZLastDateTimeOn$)             'Pe 12/20/92
  1648.       Call PrintWorkA (ZCityState$)                  'Pe 12/23/92
  1649.       Call PrintWorkA (ZListNewDate$)                'Pe 12/23/92
  1650.       CALL PrintWorkA (STR$(ZLastMsgRead))           'Pe 01/30/93
  1651.       Call PrintWorkA (ZBankTime$)                   'Pe 01/30/93
  1652.       Call PrintWorkA (ZDoorDropFile$)               'Pe 02/02/93
  1653.       CLOSE 2
  1654. Call MenuPlus (7)            ' Pe Menu174
  1655.  
  1656. If IPARM = 3 Then Exit Sub       'Pe 07/12/92
  1657. * REPLACING old line(s) by new
  1658. 44000 ' $SUBTITLE: 'ReadProf - subroutine to restore a user profile'
  1659. ' $PAGE
  1660. '
  1661. '  NAME    -- ReadProf
  1662. '
  1663. '  INPUTS  --     PARAMETER                    MEANING
  1664. '              ZNodeRecIndex               NODE RECORD TO USE
  1665. '              ZSysopPswd1$               Sysop'S PSEUDONYM 1
  1666. '              ZSysopPswd2$               Sysop'S PSEUDONYM 2
  1667. '
  1668. '  OUTPUTS -- USER'S OPTIONS AND COMMUNICATIONS PARAMETERS
  1669. '             UPON EXITING RBBS-PC TO A "DOOR"
  1670. '
  1671. '  PURPOSE -- Reset a user's options and communications parameters
  1672. '             that were saved in the node record when a user exited
  1673. '             to a "door" so that he is in the same status as when
  1674. '             he exited.
  1675. '
  1676. * ------[ first line different ]------
  1677.       SUB ReadProf (Iparm)STATIC
  1678. On Iparm Goto 44001,44005
  1679. * INSERTING new line(s)
  1680. 44001  FIELD 1, 128 AS ZMsgRec$
  1681.       GET 1,ZNodeRecIndex
  1682.       ZReliableMode = VAL(MID$(ZMsgRec$,91,2))
  1683.       MID$(ZMsgRec$,40,2) = "00"
  1684.       ZEightBit = VAL(MID$(ZMsgRec$,42,2))
  1685.       ZBPS = -VAL(MID$(ZMsgRec$,44,2))        ' ZBPS = VAL(MID$(ZMsgRec$,44,2))
  1686.       CALL CommInfo
  1687.       ZBaudTest! = VAL(MID$(ZBaudRates$,(-5 * ZBPS),5))
  1688.       ZUpperCase = VAL(MID$(ZMsgRec$,46,2))
  1689.       ZNumDnldBytes! = CVS(MID$(ZMsgRec$,48,4))
  1690.       ZBatchTransfer = (MID$(ZMsgRec$,52,1) = "1")
  1691.       ZWasGR = VAL(MID$(ZMsgRec$,53,2))
  1692.       HourLoggedOn$ = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,65,1))),2),2)
  1693.       MinLoggedOn$  = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,66,1))),2),2)
  1694.       SecLoggedOn$  = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,67,1))),2),2)
  1695.       ZTimeLoggedOn$ = HourLoggedOn$ + _
  1696.                         ":" + _
  1697.                         MinLoggedOn$ + _
  1698.                         ":" + _
  1699.                         SecLoggedOn$
  1700.       ZTransferFunction = VAL(MID$(ZMsgRec$,74,1))
  1701.       ZWasFT$ = MID$(ZMsgRec$,75,1)
  1702.       ZTimeCredits! = 60!*CVI(MID$(ZMsgRec$,113,2))
  1703.       ZDooredTo$ = MID$(ZMsgRec$,79,8)
  1704.       CALL Trim (ZDooredTo$)
  1705. '      IF ZExitToDoors AND ZDooredTo$ <> "" THEN 
  1706.       IF ZDooredTo$ <> "" Then _                     'Pe 01/30/93
  1707.          CALL OpenWork (2,ZDoorsDef$) : _
  1708.          IF ZErrCode = 0 THEN _
  1709.             CALL ReadParms (ZOutTxt$(),10,1) : _           'Pe 01/30/93     ' DD011801/DOORCARRIERDROP
  1710.             WHILE ZErrCode = 0 AND ZOutTxt$(1) <> ZDooredTo$ : _
  1711.                CALL ReadParms (ZOutTxt$(),10,1) : _          'Pe 01/30/93         ' DD011801/DOORCARRIERDROP
  1712.             WEND : _
  1713.             IF ZOutTxt$(1) = ZDooredTo$ THEN _
  1714.                ZDoorSkipsPswd = (ZOutTxt$(6) <> "Y")
  1715.             ZDoorDropFile$ = ZOutTxt$(9)                             ' Pe 01/30/93
  1716.             ZDoorCarrierDropOK$ = ZOutTxt$(10)                       ' DD011801/DOORCARRIERDROP
  1717.       ZErrCode = 0
  1718.       ZMenuIndex = VAL(MID$(ZMsgRec$,117,2))
  1719.       ZCurPUI$ = MID$(ZMsgRec$,93,8)
  1720.       CALL Remove (ZCurPUI$," ")
  1721.       IF ZCurPUI$ <> "" THEN _
  1722.          CALL BreakFileName (ZMainPUI$,ZOutTxt$,ZUserIn$,ZWasZ$,ZTrue) : _
  1723.          ZCurPUI$ = ZOutTxt$ + ZCurPUI$ + ZWasZ$
  1724.       ZCustomPUI = (ZCurPUI$ <> "")
  1725.       ZLocalUser = (MID$(ZMsgRec$,101,2) = ZCarriageReturn$ + ZCarriageReturn$)
  1726.       ZLocalUserMode = VAL(MID$(ZMsgRec$,103,2))
  1727.       ZHomeConf$ = MID$(ZMsgRec$,105,8)
  1728.       ZAutoLogoffReq = (VAL(MID$(ZMsgRec$,115,1)) <> 0)
  1729.       CALL Trim (ZHomeConf$)
  1730.       IF ZHomeConf$ = "MAIN" THEN _
  1731.          ZHomeConf$ = ""
  1732.       IF ZRequiredRings > 0 AND _
  1733.          INSTR(ZModemInitCmd$,"S0=255") THEN _
  1734.          COLOR 7,0,0 _
  1735.       ELSE COLOR ZFG,ZBG,ZBorder
  1736.       IF ZLocalUserMode THEN _
  1737.          GOTO 44003
  1738.       CALL SetBaud
  1739. * REPLACING old line(s) by new
  1740. 44003 ZUserLogonTime! = VAL(HourLoggedOn$) * 3600! + _
  1741.                         VAL(MinLoggedOn$) * 60! + _
  1742.                         VAL(SecLoggedOn$)
  1743.       HourLoggedOn$ = ""
  1744.       MinLoggedOn$ = ""
  1745.       SecLoggedOn$ = ""
  1746.       IF ZMinsPerSession < 1 THEN _
  1747.          ZMinsPerSession = 3
  1748.       IF NOT ZEightBit THEN _
  1749.          OUT ZLineCntlReg,&H1A
  1750.       IF LEFT$(ZMsgRec$,7) = "SYSOP  " THEN _
  1751.          ZFirstName$ = ZSysopPswd1$ : _
  1752. * ------[ first line different ]------
  1753.          ZActiveUserName$ = ZSysopPswd1$ + " " + ZSysopPswd2$ _
  1754.       ELSE ZFirstNameEnd = INSTR(ZMsgRec$," ") : _
  1755.            ZLastNameEnd = INSTR(ZFirstNameEnd + 1,ZMsgRec$ + " ","  ") : _
  1756.            ZFirstName$ = LEFT$(ZMsgRec$,ZFirstNameEnd-1) : _
  1757.            ZLastName$ = MID$(ZMsgRec$,ZFirstNameEnd + 1,ZLastNameEnd - (ZFirstNameEnd + 1)) : _
  1758.            ZActiveUserName$ = MID$(ZFirstName$ + " " + ZLastName$,1,31)
  1759.       ZWasZ$ = ZFirstName$
  1760. * INSERTING new line(s)
  1761. 44005 CALL OpenWork (2,ZNodeWorkDrvPath$+"DRST"+ZNodeFileID$+".DEF")
  1762.       CALL ReadDir (2,1)
  1763.       ZLimitMinsPerSession = VAL (ZOutTxt$)
  1764.       CALL ReadDir (2,1)
  1765.       ZWasNG$ = ZOutTxt$
  1766.       CALL ReadDir (2,1)
  1767.       ZIndivValue$ = ZOutTxt$
  1768.       CALL ReadDir (2,1)
  1769.       ZOrigDateTimeOn$ = ZOutTxt$
  1770.       CALL ReadDir (2,1)
  1771.       ZOrigTimeLoggedOn$ = ZOutTxt$
  1772.       CALL ReadDir (2,1)
  1773.       ZUserFileIndex = VAL(ZOutTxt$)
  1774.       CALL ReadDir (2,1)
  1775.       ZUpldDoor$ = ZOutTxt$
  1776.       CALL ReadDir (2,1)
  1777.       ZFMSDoor = VAL(ZOutTxt$)
  1778.       CALL ReadDir (2,1)
  1779.       ZCBaud$ = ZOutTxt$
  1780.       CALL ReadDir (2,1)                                             ' DD071901/ANSICHAT
  1781.       ZCanANSIChat = VAL(ZOutTxt$)
  1782.       CALL ReadDir (2,1)                          'lk 08/17/91  Xpress
  1783.       ZTempBankTime = VAL(ZOutTxt$)              'lk 08/17/91 for Xpress
  1784.       CALL ReadDir (2,1)                          'Pe 07/11/92
  1785.       ZBPS = Val(ZOutTxt$)                        'Pe 07/11/92
  1786.       CALL ReadDir (2,1)                          'Pe 07/11/92
  1787.       ZCBPS = Val(ZOutTxt$)                       'Pe 07/11/92
  1788.       CALL ReadDir (2,1)                          'Pe 12/20/92
  1789.       ZLastDateTimeOn$ = ZOutTxt$                 'Pe 12/20/92
  1790.       Call ReadDir (2,1)                          'Pe 12/23/92
  1791.       ZCityState$ = ZOutTxt$                      'Pe 12/23/92
  1792.       Call ReadDir (2,1)                          'Pe 12/23/92
  1793.       ZListNewDate$ = ZOutTxt$                    'Pe 12/23/92
  1794.       CALL ReadDir (2,1)                          'Pe 01/30/93
  1795.       ZLastMsgRead = VAL(ZOutTxt$)                'Pe 01/30/93
  1796.       Call ReadDir (2,1)                          'Pe 01/30/93
  1797.       ZBankTime$ = ZOutTxt$                     'Pe 01/30/93
  1798.       CALL ReadDir (2,1)                        'Pe 02/02/93
  1799.       ZDoorDropFile$ = ZOutTxt$                 'Pe 02/02/93
  1800.       CLOSE 2
  1801.       Call MenuPlus(8)                          ' Pe Menu174
  1802.       CALL DoorReturn
  1803.       END SUB
  1804. * REPLACING old line(s) by new
  1805. 44020 ' $SUBTITLE: 'CommInfo - sub for variable of users baud/parity'
  1806. ' $PAGE
  1807. '
  1808. '  NAME    -- CommInfo
  1809. '
  1810. '  INPUTS  --     PARAMETER                    MEANING
  1811. '                 ZBPS                BAUD RATE INDICATOR
  1812. '                 ZEightBit           INDICATE FOR N/8/1
  1813. '
  1814. '  OUTPUTS -- ZBaudParity$
  1815. '
  1816. '  PURPOSE -- Create a string that shows a users baud rate and parity
  1817. '
  1818.       SUB CommInfo STATIC
  1819. '
  1820. '
  1821. ' *  DETERMINE BAUD AND PARITY
  1822. '
  1823. '
  1824.   IF ZReliableMode THEN _
  1825.      ReliableMode$ = "-R," _
  1826.   ELSE ReliableMode$ = ","
  1827.   ZBaudParity$ = MID$(ZBaudRates$,(-5 * ZBPS),5) + _
  1828. * ------[ first line different ]------
  1829.                  " BAUD" + _                             'Pe 07/18/91
  1830.                  ReliableMode$ + _
  1831.                  MID$("N,8,1E,7,1",6 + 5 * ZEightBit,5)
  1832.   ZBaudTest! = VAL(ZBaudParity$)
  1833.   END SUB
  1834. * REPLACING old line(s) by new
  1835. 57001 ' $SUBTITLE: 'DispCall - subroutine to display callers file'
  1836. ' $PAGE
  1837. '
  1838. '  NAME    -- DispCall
  1839. '
  1840. '  INPUTS  --     PARAMETER           MEANING
  1841. '
  1842. '  OUTPUTS --  (NONE)
  1843. '
  1844. '  PURPOSE -- Displays callers file to sysops and callers
  1845. '
  1846.       SUB DispCall STATIC
  1847.       IF ZCallersFilePrefix$ = "" THEN _
  1848.          EXIT SUB
  1849.       PrevCal$ = ZCallersFile$
  1850.       OrigCal$ = ZCallersFile$
  1851. * ------[ first line different ]------
  1852.       IF (ZUserSecLevel < ZSysopSecLevel) THEN _
  1853.          GOTO 57004
  1854.       CALL LinesInFile (ZCallersLst$,NumItems)
  1855.       IF NumItems < 1 THEN _
  1856.          GOTO 57004
  1857.       IF ZAnsIndex < ZLastIndex THEN _
  1858.          GOTO 57003
  1859. * REPLACING old line(s) by new
  1860. * ------[ first line different ]------
  1861. 57002 Call GetRBBSString(111,RBBSString$)      'Pe 01/16/93
  1862.       OutTxt$ = RBBSString$                'Pe 01/16/93
  1863.       CALL QuickTPut1 (OutTxt$)
  1864.       ZNo = ZFalse
  1865.       LineCt = 0
  1866.       CALL OpenWork (2, ZCallersLst$)
  1867.       WHILE (NOT ZNo) AND (NOT EOF(2))
  1868.          LineCt = LineCt + 1
  1869.          CALL ReadDir (2,1)
  1870.          Temp = INSTR(ZOutTxt$," ")
  1871.          IF Temp = 0 THEN _
  1872.             ZOutTxt$ = " ???" _
  1873.          ELSE ZOutTxt$ = MID$(ZOutTxt$,Temp)
  1874.          ZOutTxt$ = "  " + STR$(LineCt) + "  - " + ZOutTxt$
  1875.          ZSubParm = 5
  1876.          CALL TPut
  1877.          CALL AskMore ("",ZTrue,ZTrue,WasX,ZFalse)
  1878.       WEND
  1879. * REPLACING old line(s) by new
  1880. * ------[ first line different ]------
  1881. 57003   Call GetRBBSString(298,RBBSString$)      'Pe 01/16/93
  1882.       ZOutTxt$ = RBBSString$ + MID$(STR$(NumItems),2) + ")"
  1883.       CALL PopCmdStack
  1884.       WasDF$ = ZUserIn$(ZAnsIndex)
  1885.       CALL AllCaps (WasDF$)
  1886.       IF WasDF$ = "L" THEN _
  1887.          GOTO 57002
  1888.       CALL CheckInt (WasDF$)
  1889.       IF ZTestedIntValue <= 0 THEN _
  1890.          GOTO 57102
  1891.       IF ZTestedIntValue > NumItems THEN _
  1892.             GOTO 57003
  1893.       CALL OpenWork (2,ZCallersLst$)
  1894.       CALL ReadDir (2, ZTestedIntValue)
  1895.       ZCallersFile$ = LEFT$(ZOutTxt$,INSTR(ZOutTxt$+" "," ")-1)
  1896.       CALL FindIt (ZCallersFile$)
  1897.       CLOSE 2
  1898.       IF NOT ZOK THEN _
  1899.     Call GetRBBSString(112,RBBSString$) : _      'Pe 01/16/93
  1900.       OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  1901.          Call QuickTPut1 (OutTxt$ + ZCallersFile$+"> found") : _
  1902.          ZCallersFile$ = PrevCal$ : _
  1903.          GOTO 57003
  1904.       IF PrevCal$ <> ZCallersFile$ THEN _
  1905.          CALL SetCall
  1906. * REPLACING old line(s) by new
  1907. 57005 IF CallersFileIndexTemp! < 1 OR ZRet THEN _
  1908. * ------[ first line different ]------
  1909.          CLOSE 4 : _                                ' Pe 07/09/92
  1910.          GOTO 57101
  1911. * REPLACING old line(s) by new
  1912. 57025 CallersFileIndexTemp! = CallersFileIndexTemp! - 1
  1913.       GET 4,CallersFileIndexTemp!
  1914.       WasZ = INSTR(ZCallersRecord$,"{")
  1915.       IF WasZ < 1 OR WasZ > 15 THEN _
  1916.          WasZ = 15
  1917. * ------[ first line different ]------
  1918.       IF ZSysop OR _
  1919.          LEFT$(ZOutTxt$,3) <> "   " THEN _
  1920.          ZOutTxt$ = ZOutTxt$ + LEFT$(ZCallersRecord$,WasZ - 1)
  1921.       GOSUB 57100
  1922.       IF ZSysop THEN _
  1923.          ZOutTxt$ = MID$(ZCallersRecord$,WasZ) : _
  1924.          GOSUB 57100
  1925.       GOTO 57045
  1926. * REPLACING old line(s) by new
  1927. * ------[ first line different ]------
  1928. 57030 IF ZSysop THEN _
  1929.          GOSUB 57100
  1930. * REPLACING old line(s) by new
  1931. * ------[ first line different ]------
  1932. 57100 IF INSTR(ZOutTxt$,"LOGON DENIED") THEN _
  1933.          IF NOT ZSysop THEN _
  1934.             RETURN
  1935.       IF ZJumpSearching THEN _
  1936.          ZWasDF$ = ZOutTxt$ : _
  1937.          CALL AllCaps (ZWasDF$) : _
  1938.          IF INSTR(ZWasDF$,ZJumpTo$) = 0 THEN _
  1939.             RETURN _
  1940.          ELSE CALL CheckColor (ZOutTxt$,ZJumpTo$,"") : _
  1941.               ZJumpSearching = ZFalse
  1942.       ZSubParm = 5
  1943.       CALL TPut
  1944.       WasX = 1
  1945.       CALL AskMore ("",ZTrue,ZTrue,WasX,ZFalse)
  1946.       IF ZSubParm = -1 THEN _                                        ' RH070402
  1947.          GOTO 57102 _                                                ' RH070402
  1948.       ELSE IF ZNo THEN _                                             ' RH070402
  1949.          GOTO 57101                                                  ' RH070402
  1950.       RETURN
  1951. * REPLACING old line(s) by new
  1952. * ------[ first line different ]------
  1953. 57101 IF WasX < 999 AND ZSysOp AND NumItems > 1 THEN _
  1954.          PrevCal$ = ZCallersFile$ : _
  1955.          GOTO 57003
  1956. * REPLACING old line(s) by new
  1957. 57102 ZJumpSupported = ZFalse
  1958. * ------[ first line different ]------
  1959.       IF OrigCal$ <> ZCallersFile$ THEN _                            ' RH070401
  1960.          ZCallersFile$ = OrigCal$ : _
  1961.          CALL SetCall
  1962.       END SUB
  1963. * REPLACING old line(s) by new
  1964. 58110 ' $SUBTITLE: 'CheckNewBul - sub to check whether got new bulletins'
  1965. ' $PAGE
  1966. '
  1967. '  NAME    -- CheckNewBul
  1968. '
  1969. '  INPUTS  --     PARAMETER           MEANING
  1970. '                 LastOn$             Last DATE OF LOGON
  1971. '                                   FORMAT MM/DD/YY
  1972. '                 ZActiveBulletins  # OF BULLETING
  1973. '                 ZBulletinPrefix$  FILESPEC FOR BULLETINS
  1974. '
  1975. '  OUTPUTS --     NumNewBullets   NUMBER OF NEW BULLETINS
  1976. '                 NewBullets$      LIST OF NEW BULLET #'S
  1977. '                 ZWasQ            WHERE Last BULLETIN STORED
  1978. '                                  IN ZUserIn$()
  1979. '                 ZOutTxt$()       BULLETINS #'S THAT ARE NEW
  1980. '                                    (2,3,4,...)
  1981. '
  1982. '  PURPOSE -- Checks how many bulletins have system date
  1983. '             at or later than date caller last logged on
  1984. '
  1985.       SUB CheckNewBul (LastOn$,NumNewBullets,NewBullets$) STATIC
  1986.       IF ZExitToDoors OR ZBulletinPrefix$ = ZPrevPrefix$ THEN _
  1987.          EXIT SUB
  1988.       ZPrevPrefix$ = ZBulletinPrefix$
  1989.       NumNewBullets = 0
  1990.       NewBullets$ = ""
  1991.       BaseDate# = VAL(MID$(LastOn$,4,2)) + (100 * VAL(MID$(LastOn$,1,2))) + _
  1992.                    (10000# * (1900 + VAL(MID$(LastOn$,7,2))))
  1993.       CALL FindIt (ZBulletinPrefix$ + ".FCK")
  1994.       WasX = 0
  1995. * ------[ first line different ]------
  1996.     Call GetRBBSString(113,RBBSString$)      'Pe 01/16/93
  1997.       OutTxt$ = RBBSString$                 'Pe 01/16/93
  1998.       CALL QuickTPut (OutTxt$,0)
  1999.       IF ZOK THEN _
  2000.          WHILE NOT EOF(2) : _
  2001.             INPUT #2,WasBN$ : _
  2002.             GOSUB 58112 : _
  2003.          WEND _
  2004.       ELSE FOR WasI = 1 TO ZActiveBulletins : _
  2005.               WasBN$ = MID$(STR$(WasI),2) : _
  2006.               GOSUB 58112 : _
  2007.            NEXT
  2008.       ZWasQ = NumNewBullets + 1
  2009.       IF NumNewBullets < 1 THEN _
  2010.          NewBullets$ = ""
  2011.       CALL SkipLine (1)
  2012.     Call GetRBBSString(114,RBBSString$) : _      'Pe 01/16/93
  2013.       OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  2014.       ZOutTxt$ = STR$(NumNewBullets) + OutTxt$
  2015.       CALL QuickTPut1 (ZOutTxt$)
  2016.       CALL BufString (NewBullets$,4096,WasX)
  2017.       CALL SkipLine (1)
  2018.       EXIT SUB
  2019. * REPLACING old line(s) by new
  2020. 58141 PrevLoadNew$ = ZFMSDirectory$
  2021.       CALL OpenFMS (LastRec,WasL)
  2022.       FIELD 2, 23 AS PreDate$, _
  2023.                 2 AS WasMM$, _
  2024.                 1 AS Fill1$, _
  2025.                 2 AS WasDD$, _
  2026.                 1 AS Fill2$, _
  2027.                 2 AS Year$, _
  2028. * ------[ first line different ]------
  2029.                 (2 + ZMaxDescLen) AS ZDesc$, _
  2030.                 3 AS Category$, _
  2031.                 2 AS Fill4$
  2032.       MaxRecs = UBOUND(Ara,1)
  2033.       IF MaxRecs < 1 THEN _
  2034.          MaxRecs = 1 _
  2035.       ELSE IF MaxRecs > 23 THEN _
  2036.               MaxRecs = 23
  2037.       WasL = 0
  2038.       WasK = LastRec
  2039.       WHILE WasK > 0 AND WasL < MaxRecs
  2040.          GET #2,WasK
  2041.          IF INSTR("*\ ",LEFT$(PreDate$,1)) > 0 THEN _
  2042.             GOTO 58142
  2043.          IF (ZCanDnldFromUp OR Category$ <> ZDefaultCatCode$) THEN _
  2044.             IF VAL(Year$) > 79 THEN _
  2045.                WasL = WasL + 1 : _
  2046.                Ara(WasL,1) = 372! * (VAL(Year$) - 80!) + 31! * VAL(WasMM$) + VAL(WasDD$) _
  2047.             ELSE IF FirstWarning THEN _
  2048.                     FirstWarning = ZFalse : _
  2049.                     ZWasZ$ = "Invalid FMS format " + ZFMSDirectory$ : _
  2050.                     ZSnoop = ZTrue : _
  2051.                     CALL LPrnt (ZWasZ$,1) : _
  2052.                     CALL UpdtCalr (ZWasZ$,2)
  2053.          IF NOT ZCanDnldFromUp THEN _
  2054.             WasX = ZMinSecToView _
  2055.          ELSE IF Category$ = "***" THEN _
  2056.                  WasX = ZSysopSecLevel _
  2057.               ELSE IF Category$ = ZDefaultCatCode$ THEN _
  2058.                       WasX = ZMinSecToView _
  2059.               ELSE IF LEFT$(PreDate$,1) = "=" THEN _
  2060.                       CALL CheckInt (ZDesc$) : _
  2061.                       WasX = ZTestedIntValue _
  2062.               ELSE WasX = ZOptSec(19)
  2063.          Ara(WasL,2) = WasX
  2064. * REPLACING old line(s) by new
  2065. 58165 ' $SUBTITLE: 'DispUpDir - sub to display FMS directory'
  2066. ' $PAGE
  2067. '
  2068. '  NAME    -- DispUpDir
  2069. '
  2070. '  INPUTS  -- PARAMETER             MEANING
  2071. '             PassedCats$         FILE "CATEGORIES" TO BE INCLUDED IN
  2072. '                                 THE SEARCH.
  2073. '             SearchString$       STRING TO SEARCH ON WITHIN THE
  2074. '                                 FILE "CATEGORIES" SELECTED
  2075. '             SearchDate$         DATE EQUAL TO OR GREATER THAN TO BE
  2076. '                                 SEARCHED FOR WITH THE "CATEGORIES"
  2077. '                                 AND THE STRING TO SEARCH.
  2078. '             DnldFlag            SET TO RECORD # OF LINE TO BEGIN
  2079. '                                 VIEWING - 0 IF AT END
  2080. '
  2081. '  OUTPUTS -- DnldFlag            WHENEVER DOWNLOAD REQUESTED, SETS
  2082. '                                 TO 1.  OTHERWISE LEAVES AT ZERO
  2083. '  PURPOSE -- Display the files that meet the criteria selected in
  2084. '             RBBS-PC upload management system on the users screen.
  2085. '
  2086.       SUB DispUpDir (PassedCats$,SearchString$, _
  2087.                     SearchDate$,DnldFlag,AbortIndex) STATIC
  2088.       IF AtEndList THEN _
  2089.          AtEndList = ZFalse : _
  2090.          IF DnldFlag > 0 THEN _
  2091.             GOSUB 58185 : _
  2092.             GOTO 58184
  2093.       CALL AllCaps (SearchString$)
  2094.       Blank$ = " "
  2095.       ZStopInterrupts = ZFalse
  2096.       Categories$ = "," + _
  2097.                     PassedCats$ + _
  2098.                     ","
  2099.       CanDnld = (ZUserSecLevel => ZOptSec(19))
  2100.       CanView = (ZUserSecLevel => ZOptSec(26))
  2101.       ZJumpSupported = ZTrue
  2102.       ZJumpSearching = ZFalse
  2103.       GOSUB 58185
  2104.       OrigDir$ = ZActiveFMSDir$
  2105.       InList = (RelistAt > 0 AND ReListAt <= LastRec)
  2106.       IF InList AND DnldFlag > 0 THEN _
  2107.          UpldIndex = RelistAt : _
  2108.          DnldFlag = 0 : _
  2109.          GOTO 58179
  2110.       ZJumpLast$ = ""
  2111.       SearchFor$ = SearchString$
  2112. * ------[ first line different ]------
  2113.       ExtraPrompt$ = LEFT$(",T)ype",6+4*ZExpertUser)                 'Pe 10/21/89
  2114.       ExtraPrompt$ = ExtraPrompt$ + LEFT$(",V)iew",6+4*ZExpertUser)  'Pe 10/21/89
  2115.       IF ZPersonalDnld THEN _
  2116.          ExtraPrompt$ = ExtraPrompt$ + ",*)new"
  2117.       IF CanDnld THEN _
  2118.          ExtraPrompt$ = ExtraPrompt$ + ",E)xtra,M)ark,D)nld"    'Pe 11/07/91
  2119.       MaxPrint = ZPageLength - 1
  2120.       BelowMinSec = (ZUserSecLevel < ZMinSecToView)
  2121.       ZNonStop = ZNonStop OR (ZPageLength < 1)
  2122.       FMSCheckPoint = 0
  2123.       WildSearch = (INSTR(SearchString$,"?") > 0) _
  2124.                      OR (INSTR(SearchString$,"*") > 0)
  2125.       CALL AraAllCaps (ZUserIn$(),ZAnsIndex)
  2126.       IF ZAnsIndex > 0 THEN _
  2127.         IF ZLastCommand$ = "FP" AND INSTR("Ll",ZUserIn$(ZLastIndex)) = 0 THEN _
  2128.             ZUserIn$(ZAnsIndex) = "D" : _
  2129.             IF (UpldIndex > 0 AND UpldIndex <= LastRec) THEN _
  2130.                GOTO 58180 _
  2131.             ELSE Temp$ = "" : _
  2132.                  GOTO 58196
  2133. * REPLACING old line(s) by new
  2134. 58174 IF SearchDate$ <> "" THEN _
  2135.          HoldCat$ = MID$(PartToPrint$,30,2) + _
  2136.                 MID$(PartToPrint$,24,2) + _
  2137.                 MID$(PartToPrint$,27,2) : _
  2138.          IF HoldCat$ < SearchDate$ THEN _
  2139.             IF ZDateOrderedFMS THEN _
  2140. * ------[ first line different ]------
  2141.                GOTO 58184 _
  2142.             ELSE GOTO 58168
  2143. '
  2144. '
  2145. ' * Allow the FMS to be both fast and interruptable if a local
  2146. ' * user or there is nothing in the input buffer by using QuickTPut.
  2147. '
  2148. '
  2149. * REPLACING old line(s) by new
  2150. 58178 IF ZLinesPrinted <= MaxPrint AND (FMSCheckPoint MOD 1000 <> 0) THEN _
  2151.          GOTO 58168
  2152.       CALL CheckCarrier
  2153.       IF ZSubParm = -1 THEN _
  2154.          GOTO 58198
  2155.       CALL TimeRemain (MinsRemaining)
  2156.       IF MinsRemaining <= 0 THEN _
  2157.          ZSubParm = -1 : _
  2158.          GOTO 58198
  2159.       IF ZNonStop THEN _
  2160.          GOTO 58168
  2161.       IF ZLinesPrinted <= MaxPrint THEN _
  2162.          IF ZDateOrderedFMS THEN _
  2163. * ------[ first line different ]------
  2164.     Call GetRBBSString(115,RBBSString$) : _      'Pe 01/16/93
  2165.       OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  2166.             CALL QuickTPut1 (ZEmphasizeOff$ + _
  2167.                OutTxt$ + " " + MID$(PartToPrint$,24,8)) _
  2168.          ELSE _
  2169.             CALL QuickTPut1 (ZEmphasizeOff$ + STR$(FMSCheckPoint) + _
  2170.                " files checked")
  2171. * REPLACING old line(s) by new
  2172. 58180 WasX$ = ZUserIn$(ZAnsIndex)
  2173.       CALL AllCaps (WasX$)
  2174.       IF InList AND (ZAnsIndex >= ZLastIndex OR WasX$ <> "D") THEN _
  2175.          ZTurboKey = -ZTurboKeyUser : _
  2176.          ZStackC = ZTrue : _
  2177.          CALL AskMore (ExtraPrompt$, ZTrue, ZFalse,AbortIndex,ZFalse) : _
  2178.          IF ZSubParm = -1 THEN _
  2179.             EXIT SUB _
  2180.          ELSE ZLastIndex = ZWasQ :_
  2181. * ------[ first line different ]------
  2182.          IF NOT ZNo THEN _
  2183.             ZAnsIndex = 1
  2184.       IF ZSubParm = -1 THEN _
  2185.          GOTO 58198
  2186.       IF ZNo THEN _
  2187.          ZLastIndex = 0 : _
  2188.          GOTO 58198
  2189.       WasX$ = ZUserIn$(ZAnsIndex)
  2190.       CALL AllCaps (WasX$)
  2191. '
  2192. 'Type TXT file mod  Pe 10/21/89
  2193. '
  2194.       IF WasX$ = "T" THEN _
  2195.          CALL TypeFile : _
  2196.          ZwasA = UpldIndex : _
  2197.          GOSUB 58185 : _
  2198.          UpldIndex = ZwasA : _
  2199.          GOTO 58180
  2200. '
  2201. '
  2202.       IF WasX$ = "V" THEN IF CanView THEN _
  2203.          CALL GetArc : _
  2204.          ZJumpSupported = ZTrue : _
  2205.          ZWasA = UpldIndex : _
  2206.          GOSUB 58185 : _
  2207.          UpldIndex = ZWasA : _
  2208.          GOTO 58180
  2209. '
  2210. '   
  2211.      IF WasX$ = "E" THEN _                  'Pe 11/07/91
  2212.       ZExtendedOff=NOT ZExtendedOff: _       'Pe 11/07/91
  2213.     Call GetRBBSString(116,RBBSString$) : _      'Pe 01/16/93
  2214.       OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  2215.       CALL QuickTPut1 (OutTxt$ + " "+FNOffOn$(NOT ZExtendedOff)) : _
  2216.       GOTO 58168
  2217. '
  2218. '
  2219. * REPLACING old line(s) by new
  2220. 58181 MarkingFiles = ZFalse
  2221. * ------[ first line different ]------
  2222.       IF ((WasX$ = "D" OR WasX$ = "M") AND CanDnld) OR (WasX$ = "V" AND CanView) THEN _ ' KG091001
  2223.  MarkingFiles = (WasX$ = "M") : _
  2224.          AtEndList = ZFalse : _                                  'PE 08/04/91
  2225.          CALL AskItems ("DMV",WasX$,ZTrue,"file",ZMarkedFiles$) ': _   ' KG091001
  2226.          IF ZWasQ = 0 THEN _
  2227.             GOTO 58183
  2228.       IF WasX$ = "*" THEN IF ZPersonalDnld THEN _
  2229.          GOTO 58193
  2230. * REPLACING old line(s) by new
  2231. 58183 IF ZJumpSearching THEN _
  2232.          PrevSearch$ = SearchFor$ : _
  2233.          SearchFor$ = ZJumpTo$ _
  2234.       ELSE SearchFor$ = SearchString$ : _
  2235.            IF NOT ZYes AND CanDnld THEN _
  2236.               GOSUB 58188 : _
  2237. * ------[ first line different ]------
  2238.               IF WasX$ = "V" AND CanView AND ZLastIndex >= ZAnsIndex THEN _ ' KG091001
  2239.                  ZAnsIndex = ZAnsIndex - 1 : _                       ' KG091001
  2240.                  CALL GetArc : _                                     ' KG091001
  2241.                  ZJumpSupported = ZTrue : _                          ' KG091001
  2242.                  ZWasA = UpldIndex : _                               ' KG091001
  2243.                  GOSUB 58185 : _                                     ' KG091001
  2244.                  UpldIndex = ZWasA : _                               ' KG091001
  2245.                  GOTO 58180 _                                        ' KG091001
  2246.  ELSE IF WasX$ <> "L" AND ZLastIndex >= ZAnsIndex AND NOT MarkingFiles AND NOT AtEndList THEN _ ' Pe 080391
  2247.                  CALL SkipLine (1) : _
  2248.                  DnldFlag = 1 : _
  2249.                  ReListAt = UpldIndex : _
  2250.                  EXIT SUB _
  2251.               ELSE IF UpldIndex = CutoffRec THEN _
  2252.                       GOTO 58184
  2253.       IF ZNonStop THEN IF UpldIndex > 999 THEN _
  2254.          IF (SearchDate$ = "" OR NOT ZExpertUser) THEN _
  2255.          Call GetRBBSString(299,RBBSString$): _      'Pe 01/16/93
  2256.             ZOutTxt$ = STR$(UpldIndex) + RBBSString$ : _
  2257.             ZNoAdvance = ZTrue : _
  2258.             ZTurboKey = -ZTurboKeyUser : _
  2259.             ZSubParm = 1 : _
  2260.             CALL TGet : _
  2261.             CALL WipeLine (79) : _
  2262.             ZNonStop = ZYes
  2263.       GOTO 58168
  2264. * REPLACING old line(s) by new
  2265. 58184 IF ZChainedDir$ <> "" THEN _
  2266.          ZActiveFMSDir$ = ZChainedDir$ : _
  2267.          GOSUB 58185 : _
  2268.          LastFName = 0 : _
  2269.          GOTO 58168
  2270. * ------[ first line different ]------
  2271.       IF ZNo THEN _
  2272.          GOTO 58198
  2273.       Temp$ = "End list. "
  2274.       AtEndList = ZTrue
  2275.       UpldIndex = CutOffRec - ZUpInc
  2276.       ZLastIndex = 0
  2277.       GOTO 58196
  2278. * REPLACING old line(s) by new
  2279. 58185 IF PassedCats$ = "P" THEN _
  2280.          ZActiveFMSDir$ = ZPersonalDir$
  2281.       CALL OpenFMS (UpldIndex,CatLen)
  2282.       LastRec = UpldIndex
  2283.       EndDesc = 33 + ZMaxDescLen
  2284.       IF CatLen > 3 THEN _
  2285.          Categories$ = ZActiveUserName$ : _
  2286.          CALL Trim (Categories$) : _
  2287.          Categories$ = "," + Categories$ + "," + LEFT$(",SYSOP,",-7*ZSysOp) : _
  2288.          CanDnld = ZTrue : _
  2289.          StatLen = 1 _
  2290.       ELSE StatLen = 0
  2291. * ------[ first line different ]------
  2292.       FIELD 2, EndDesc AS PartToPrint$, _
  2293.                CatLen AS Category$, _
  2294.                StatLen AS PersonalStatus$, _
  2295.                2 AS Filler$
  2296.       PrevFMS$ = ZActiveFMSDir$
  2297. * REPLACING old line(s) by new
  2298. 58188 IF ProcessedNew OR MarkingFiles OR NOT ZListOnly THEN _
  2299.          ProcessedNew = ZFalse : _
  2300.          RETURN
  2301.       ZUserIn$(0) = ""
  2302.       WasI = ZAnsIndex              ' check whether in dir
  2303.       WHILE WasI <= ZLastIndex
  2304.          CALL AraAllCaps (ZUserIn$(),WasI)
  2305.          ZWasZ$ = ZUserIn$(WasI)
  2306.          CALL UnMarkItems (ZMarkedFiles$,WasI,ZLastIndex,WasX,ZTrue)
  2307.          Temp$ = ZUserIn$(WasI)
  2308. * ------[ first line different ]------
  2309.          CALL AllCaps (Temp$)                                        ' KG062401
  2310.          IsProto = (LEN(Temp$) = 1 AND _
  2311.                     INSTR(ZDefaultXfer$,Temp$) > 0)
  2312.          ZOK = IsProto
  2313.          WasJ = LastRec + 1
  2314.          WasX = INSTR(Temp$,".")
  2315.          AltTemp$ = ""
  2316.          IF NOT IsProto THEN _
  2317.             IF WasX = 0 THEN _
  2318.                AltTemp$ = Temp$ + "." + ZDefaultExtension$ _
  2319.             ELSE IF WasX = LEN(Temp$) THEN _
  2320.                     AltTemp$ = LEFT$(Temp$,WasX-1)
  2321.          WHILE WasJ > 1 AND NOT ZOK
  2322.             WasJ = WasJ - 1
  2323.             GET #2,WasJ
  2324.             GOSUB 58191
  2325.             IF CanGet THEN _
  2326.                MID$(PartToPrint$,13,1) = " " : _
  2327.                ZWasY$ = LEFT$(PartToPrint$,INSTR(PartToPrint$," ") - 1) : _ ' KG091001
  2328.                ZOK = (Temp$ = ZWasY$) : _                            ' KG091001
  2329.                IF NOT ZOK THEN _
  2330.                   IF AltTemp$ <> "" THEN _
  2331.                      ZOK = (AltTemp$ = ZWasY$)                       ' KG091001
  2332.          WEND
  2333.          IF ZOK THEN _
  2334.             GOSUB 58189 : _
  2335.             IF ZOK OR IsProto THEN _
  2336.                ZWasY$ = MID$(STR$(WasJ),2) : _                       ' KG091001
  2337.                ZUserIn$(0) = ZUserIn$(0) + _
  2338.                        ZWasY$ + _                                    ' KG091001
  2339.                        SPACE$(5 - LEN(ZWasY$))                       ' KG091001
  2340.          IF NOT ZOK AND NOT IsProto THEN _
  2341.     Call GetRBBSString(70,RBBSString$) : _      'Pe 01/16/93
  2342.       OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  2343.             CALL QuickTPut1 (ZWasZ$ + OutTxt$ + " - omitted") : _
  2344.             FOR WasK = WasI + 1 TO ZLastIndex : _
  2345.                ZUserIn$(WasK - 1) = ZUserIn$(WasK) : _
  2346.             NEXT : _
  2347.             ZLastIndex = ZLastIndex - 1 : _
  2348.             WasI = WasI - 1
  2349.          WasI = WasI + 1
  2350.       WEND
  2351.       ZWasQ = ZLastIndex
  2352.       RETURN
  2353. * REPLACING old line(s) by new
  2354. 58189 IF IsProto THEN _
  2355.          RETURN
  2356.       ZUserIn$(WasI) = LEFT$(PartToPrint$,INSTR(PartToPrint$," ") - 1)
  2357.       CALL FindFile (ZPersonalDrvPath$ + ZUserIn$(WasI),ZOK)
  2358.       IF ZOK THEN _
  2359.          ZUserIn$(WasI) = ZPersonalDrvPath$ + ZUserIn$(WasI) _
  2360. * ------[ first line different ]------
  2361.      ELSE CALL RotorsDir (ZUserIn$(WasI),ZSubDir$(),ZSubDirCount + _
  2362.                       ((ZUserSecLevel < ZMinSecToView) OR _
  2363.                        NOT ZCanDnldFromUp),ZTrue,"D") : _
  2364.            GOSUB 58185
  2365.       RETURN
  2366. * REPLACING old line(s) by new
  2367. 58196 CALL QuickTPut (ZEmphasizeOff$,0)
  2368. * ------[ first line different ]------
  2369.       ZOutTxt$ = Temp$ + "L)ist,A)bort,T)ype,V)iew," + _             ' Pe 03/30/92
  2370.                  LEFT$("*)dnld new,",-11*ZPersonalDnld) + _
  2371.                  "M)ark" + LEFT$(",D)ownload",-10*CanDnld) + ZPressEnterExpert$
  2372.       ZTurboKey = -ZTurboKeyUser
  2373. If ZDnldCompleted and ZAutoEnd = 1 THEN _   'Pe 10/22/91
  2374.          ZNonStop = ZTrue : _                            ' DD092501
  2375.          ZStopInterrupts = ZTrue : _                     ' DD092501
  2376.          ZAutoLogOffReq = ZTrue : _                      ' DD092501
  2377.          GOTO 58199                                      ' DD092501
  2378.       CALL PopCmdStack
  2379.       WasX$ = ZUserIn$(ZAnsIndex)
  2380.       CALL AllCaps (WasX$)
  2381.            IF WasX$ = "A" THEN _                         ' DD012304
  2382.          ZLastIndex = 0 : _                              ' DD012304
  2383.          ZRet = ZTrue                                    ' DD012304
  2384.       IF ZWasQ = 0 OR ZRet OR ZSubParm < 0 THEN _
  2385.          GOTO 58198
  2386. '
  2387.       IF WasX$ = "L" THEN _
  2388.          ZActiveFMSDir$ = OrigDir$ : _
  2389.          GOSUB 58185 : _
  2390.          AtEndList = ZFalse : _
  2391.          GOTO 58168   
  2392. '
  2393. 'Type TXT file mod  Pe 10/21/89
  2394. '
  2395.       IF WasX$ = "T" THEN _
  2396.          CALL TypeFile : _
  2397.          ZwasA = UpldIndex : _
  2398.          GOSUB 58185 : _
  2399.          UpldIndex = ZwasA : _
  2400.          GOTO 58180
  2401. '
  2402. '
  2403.       IF WasX$ = "V" THEN IF CanView THEN _
  2404.          CALL GetArc : _
  2405.          ZJumpSupported = ZTrue : _
  2406.          ZWasA = UpldIndex : _
  2407.          GOSUB 58185 : _
  2408.          UpldIndex = ZWasA : _
  2409.          GOTO 58180
  2410.          ZYes = ZFalse 
  2411.          Goto 58181
  2412. * REPLACING old line(s) by new
  2413. 58198 CLOSE 2
  2414.       ZNonStop = (ZPageLength < 1)
  2415.       ZStopInterrupts = ZFalse
  2416. * ------[ first line different ]------
  2417. * INSERTING new line(s)
  2418. 58199 ZOutTxt$ = ""                                      ' DD092501
  2419.       ZActiveFMSDir$ = ""
  2420.       ZJumpSupported = ZFalse
  2421.       DnldFlag = 0
  2422.       EXIT SUB
  2423.       END SUB
  2424. '
  2425. ' $SUBTITLE: 'TypeFile - subroutine to TYPE an ASCII FILE'
  2426. ' $PAGE
  2427. '
  2428. '  NAME    -- TYPEAFILE
  2429. '
  2430. '  PARAMETERs          
  2431. '                      
  2432. '                      
  2433. '                      
  2434. '
  2435. '  PURPOSE -- Type a ASCII file to screen
  2436. '
  2437.       SUB TypeFile STATIC
  2438. 59141 CALL SkipLine (1)
  2439.          Call GetRBBSString(300,RBBSString$)     'Pe 01/16/93
  2440.        ZOutTxt$ = RBBSString$+ZPressEnterExpert$
  2441.         CALL PopCmdStack
  2442.        IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  2443.       EXIT SUB
  2444. 59142 ZViolation$ = "TYPE File"
  2445.       WasX = ZAnsIndex
  2446.      FOR ZAnsIndex = WasX TO ZLastIndex
  2447.       GOSUB 59143
  2448.         IF ZSubParm < 0 THEN _
  2449.        ZAnsIndex = ZLastIndex + 1
  2450.       NEXT ZAnsIndex
  2451.       IF ZLastIndex > 1 THEN _
  2452.          EXIT SUB _
  2453.       ELSE GOTO 59141
  2454. 59143  WasZ$ = ZUserIn$(ZAnsIndex)
  2455.        CALL AllCaps (WasZ$)
  2456.     IF INSTR(WasZ$,"*") OR INSTR(WasZ$,"?") THEN _
  2457.     Call GetRBBSString(51,RBBSString$) : _      'Pe 01/16/93
  2458.       OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  2459.    CALL QuickTPut (OutTxt$,1) : _
  2460.     RETURN
  2461.        ZFileName$ = WasZ$
  2462.         ZFileNameHold$ = WasZ$
  2463.          CALL BadFile (ZFileNameHold$,BadFileNameIndex)
  2464.         ON BadFileNameIndex GOTO 59145,59148,59150
  2465. 59145 CALL BadName (BadFileNameIndex,ZTrue)          'Pe 06/03/91
  2466.       ON BadFileNameIndex GOTO 59146,59150
  2467. 59146 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount + (NOT ZSysop),ZTrue,"V") 'Pe 02/25/90
  2468.        IF ZOK THEN _        ' Pe 02/06/90
  2469.         GOTO 59158
  2470. '
  2471. '**********************8 Pe 08/12/91 next 5 lines *********
  2472. If ZPersonalDnld Then _
  2473.   ZFileName$ = ZPersonalDrvPath$ + WasZ$ : _
  2474. CALL FindFile (ZFileName$,ZOK)
  2475.  IF ZOK THEN _
  2476.     GOTO 59158
  2477. '************************************************************
  2478. 59148 WasZ$ = ZUserIn$(ZAnsIndex) + _
  2479.            " not found!"
  2480.       CALL UpdtCalr (WasZ$,2)
  2481.       ZOutTxt$ = WasZ$ + _
  2482.            " Type correct filename" + ZPressEnterExpert$
  2483.       ZSubParm = 1
  2484.       CALL TGet
  2485.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  2486.          RETURN
  2487.       ZUserIn$(ZAnsIndex) = ZUserIn$(1) 
  2488.       GOTO 59143
  2489. 59150 CALL SecViolation
  2490.       IF ZDenyAccess THEN _
  2491.          EXIT SUB
  2492.       GOTO 59148
  2493. 59158 CALL BreakFileName (WasZ$,Drive$,Prefix$,Ext$,ZFalse)
  2494.       IF Ext$ = "" THEN _
  2495.         GOTO 59160
  2496.       IF INSTR("DWC,COM,EXE,GIF,PIC,DAT,BIN,ZIP,ARC,LZH,ZOO,PAK,ARJ,",Ext$+",") > 0 THEN _
  2497.     Call GetRBBSString(117,RBBSString$) : _      'Pe 01/16/93
  2498.       OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  2499.  CALL QuickTPut (OutTxt$ + " " +Ext$ ,1) : _
  2500.          RETURN
  2501. 59160  CALL BufFile (ZFileName$,WasX) 
  2502.        RETURN
  2503.        END SUB
  2504. '************************ Pe 01/25/92  to end of file **************
  2505. '
  2506. ' $SUBTITLE: 'WhoDidIt - subroutine to Display Who Uploaded that file'
  2507. ' $PAGE
  2508. '
  2509. '  NAME    -- WhoDidIt
  2510. '
  2511. '  PARAMETERs None
  2512. '                      
  2513. '                      
  2514. '                      
  2515. '
  2516. 'PURPOSE - Maple Version of RBBS creates a file Called Uploadlg.def
  2517. '          this file keeps track of who Uploaded what file
  2518. '          File location is Drive/Path were *.DIR files are stored 'Pe 03/13/92
  2519. '          Allows reading UPLOADLG.DEF file in reverse order
  2520. '
  2521.       SUB WhoDidIt STATIC
  2522. 59500 CALL SkipLine (3)
  2523.     Call GetRBBSString(118,RBBSString$)      'Pe 01/16/93
  2524.       OutTxt$ = RBBSString$                 'Pe 01/16/93
  2525. Call QuickTput1 (OutTxt$)
  2526.     Call GetRBBSString (119,RBBSString$)
  2527.       OutTxt$ = RBBSString$
  2528.     Call Quicktput1 (OutTxt$)
  2529.     Call GetRBBSString(118,RBBSString$)      'Pe 01/16/93
  2530.       OutTxt$ = RBBSString$                 'Pe 01/16/93
  2531. Call QuickTput1(OutTxt$)
  2532.     Close 8
  2533.    IF ZShareIt THEN _
  2534.      OPEN ZDirPath$ +"UPLOADLG.DEF" FOR RANDOM SHARED AS #8 LEN=86 _  'Pe 03/13/92
  2535.         ELSE OPEN "R",8,ZDirPAth$ +"UPLOADLG.DEF",86                  'Pe 03/13/92
  2536.                    FIELD 8,84 AS ShowUp$, _
  2537.                    2 AS fill$
  2538.          RecordNum! = FIX(LOF(8) / 86)
  2539.         ZJumpSupported = ZTrue
  2540.        ZJumpSearching = ZFalse
  2541.       ZJumpLast$ = ""
  2542. 59502 If RecordNum! < 1 OR ZRet THEN  _
  2543.        GOTO 59560
  2544.         Get #8, RecordNum!
  2545.          ZOutTxt$ = ShowUp$
  2546.           RecordNum! = RecordNum! - 1
  2547.  
  2548. ' Do Not display Sysop only and Personall Uploads
  2549.  
  2550.  IF INSTR(ZOutTxt$,"*") > 0 and NOT ZSysop THEN _
  2551.           GOTO 59502
  2552.  
  2553.          GOSUB 59550
  2554.         GOTO 59502      
  2555.  
  2556. 59550   IF ZJumpSearching THEN _
  2557.           ZWasDF$ = ZOutTxt$ : _
  2558.            CALL AllCaps (ZWasDF$) : _
  2559.             IF INSTR(ZWasDF$,ZJumpTo$) = 0 THEN _
  2560.                Return _
  2561.              ELSE CALL CheckColor (ZOutTxt$,ZJumpTo$,"") : _
  2562.               ZJumpSearching = ZFalse
  2563.              ZSubParm = 5
  2564.             CALL SmartText (ZOutTxt$,ZTrue,ZFalse,ZFalse)
  2565.            CALL Tput
  2566.           WasX=1
  2567.         CALL AskMore ("",ZTrue,ZTrue,WasX,ZFalse)
  2568.          IF ZNo OR ZSubParm = -1 THEN _
  2569.             ZJumpSupported = ZFalse : _
  2570.               ZJumpSearching = ZFalse : _
  2571.                ZJumpLast$ = "" : _
  2572.               Close 8 : _
  2573.            Exit Sub 
  2574.       Return
  2575. 59560 IF ZJumpSearching Then _
  2576.     Call GetRBBSString(120,RBBSString$) : _      'Pe 01/16/93
  2577.       OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  2578.       Call QuickTput1 (OutTxt$)
  2579.       ZJumpSupported = ZFalse
  2580.       ZJumpSearching = ZFalse
  2581.       ZJumpLast$ = ""
  2582.       Close 8
  2583.      End Sub
  2584.