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