home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / comm / rbbs2.zip / RSB41028.MRG < prev    next >
Text File  |  1990-10-28  |  14KB  |  281 lines
  1. * ------------[ BLED merge (c) Ken Goosens ]-------------
  2. * Merge this against 17.3A\RBBSSUB4.BAS to produce 17.3B\RBBSSUB4.BAS
  3. * 17.3A\RBBSSUB4.BAS:  Date 9-25-1990  Size 127433 bytes
  4. * ------------[ Created 10-28-1990 12:00:02 ]------------
  5. * REPLACING old line(s) by new
  6. ' $linesize:132
  7. * ------[ first line different ]------
  8. ' $title: 'RBBSSUB4.BAS 17.3B, Copyright 1986 - 90 by D. Thomas Mack'  ' DA081003
  9. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  10. '  Name ...............: RBBSSUB4.BAS
  11. '  First Released .....: February 11, 1990
  12. '  Subsequent Releases.: August 26, 1990; October 28, 1990
  13. '  Copyright ..........: 1986 - 1990
  14. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  15. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  16. '     require error trapping are incorporated within RBBSSUB 2-5 as
  17. '     separately callable subroutines in order to free up as much
  18. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  19. '  Parameters..........: Most parameters are passed via a COMMON statement.
  20. '
  21. ' Subroutine  Line               Function of Subroutine
  22. '   Name     Number
  23. '  AnyBut         59760  Determine where a "word" begins
  24. '  AskUsers       64003  Ask users questions based on a script and save answers
  25. '  AskMore        59858  Check whether screen full
  26. '  AutoPage       60300  Check whether to notify sysop caller is on
  27. ' BadFileChar     59800  Check file name for bad character
  28. '  Bracket        59960  Puts strings around a substring
  29. '  BufFile        58400  Write a file to the user quickly
  30. '  BufString      58300  Write a string with imbedded CR/LF to the user quickly
  31. '  CheckColor     59930  Highlighting based on search string
  32. '  SearchArray    58190  Check for the occurance of a string in an array
  33. '  ColorDir       59920  Adds colorization to FMS directory entry
  34. '  ColorPrompt    59940  Colorizes prompts
  35. '  CompDate       59880+ Produces a computational data from YY, MM, DD
  36. '  ConfMail       59854  Check conference mail waiting
  37. '  ConvertDir     58950  Checks for U & A (shorthand) and converts appropriately
  38. '  PackDate       59201  Compress date in string format to 2 characters
  39. '  EofComm        60000  Determine whether any chars in comm port buffer
  40. '  ExpireDate     59890  Calculate registration expiration date
  41. '  FakeXRpt       62650  Write out file transfer report for protocols that don't
  42. '  FindEnd        58770  Find where a "word" ends
  43. '  FindFile       58790  Determine whether a file exists without opening it
  44. '  FindLast       58600  Find last occurence of a string
  45. '  FMS            58200  Search the upload management system for entries
  46. '  GetAll         59780  Get list of all directories to display
  47. '  GetDirs        58895  Prompts for directories for file list/new/search cmds
  48. '  GetMsgAttr     62530  Restore attributes of original message
  49. '  GetYMD         59204  Pulls YY, MM, or DD from a 2 byte stored date
  50. '  GlobalSrchRepl 60100  Global search and replace
  51. '  LogPDown       59400  Records download in private directory
  52. '  MarkTime       60200  Give visual feedback during lengthy process
  53. '  MetaGSR        60130  Meta statement global search and replace
  54. '  MsgImport      59698  Allow local user to import a text file to a message
  55. '  Muzak          59100  Play musical themes for different RBBS functions
  56. '  NewPassword    60668  Get a new password
  57. '  PersFile       59300  View and select personal files for downloading
  58. '  Protocol       62600  Determine if external protocols are available
  59. '  PutMsgAttr     62520  Save attributes of original message
  60. '  Remove         58210  Remove characters from within strings
  61. '  RotorsDir      58700  Searches for a file using list of subdirs
  62. '  RptTime        62540  Report date/time and time on
  63. '  SetEcho        59600  Set RBBS properly for who is to echo
  64. '  SetHiLite      59934  Set user preference on highlighting
  65. '  SetGraphic     59980  Sets graphic preference for text file display
  66. '  SmartText      58250  Process SMART TEXT control strings
  67. '  SubMenu        59500  Processes options that have sub-menus
  68. '  TimedOut       63000  Write timed exit semaphore file
  69. '  TimeLock       60180  Check for TIME LOCK on certain features
  70. '  Transfer       62624  RBBS-PC support for external protocols for file transfer
  71. '  Toggle         57000  Toggles or views user options
  72. ' TwoByteDate     59200  Reduces a data to 2 byte string for space compression
  73. '  UnPackDate     59902  Uncompresses a 2 byte date
  74. '  UserColor      59965  Lets user set color for text and whether bold
  75. '  UserFace       59450  Processes programmable user interface
  76. '  ViewArc        64600  Display .ARC file contents to user
  77. '  PrivDoorRtn    62629  Private door exit routine
  78. '  WipeLine       58800  Wipes away a line so next prints in its place
  79. '  WordWrap       59710  Adjust a msg -- wrap lines and perserve paragraphs
  80. '
  81. '  $INCLUDE: 'RBBS-VAR.BAS'
  82. '
  83. * REPLACING old line(s) by new
  84. 59400 ' $SUBTITLE: 'LogPDown -- subroutine to record private downloads'
  85. ' $PAGE
  86. '
  87. '  NAME    -- LogPDown
  88. '
  89. '  INPUTS  --   PARAMETER     MEANING
  90. '
  91. '  OUTPUTS --
  92. '
  93. '  PURPOSE -- Puts a "!" in place of an "*" in private directory
  94. '             after downloaded
  95. '
  96.       SUB LogPDown (PrivateDnld,DwnIndex) STATIC                     ' RH021501
  97.       IF NOT PrivateDnld THEN _
  98.          EXIT SUB
  99.       ZWasEN$ = ZPersonalDir$
  100.       WasBX = &H4
  101.       ZSubParm = 9
  102.       CALL FileLock
  103.       WasL = 36 + ZMaxDescLen + ZPersonalLen
  104.       CLOSE 2
  105.       IF ZShareIt THEN _
  106.          OPEN ZWasEN$ FOR RANDOM SHARED AS #2 LEN=WasL _
  107.       ELSE OPEN "R",2,ZPersonalDir$,WasL
  108.       FIELD #2,WasL AS PersonalRec$
  109. * ------[ first line different ]------
  110.       FOR Temp = 1 TO ZDownFiles                                     ' KG102702
  111.          ZWasA = VAL(MID$(ZUserIn$(0),5 * (DwnIndex - Temp) + 1,5))  ' KG102702
  112.          GET #2,ZWasA                                                ' KG102702
  113.          MID$(PersonalRec$,WasL-2,1) = "!"                           ' KG102702
  114.          PUT #2,ZWasA                                                ' KG102702
  115.       NEXT                                                           ' KG102702
  116.       CALL UnLockAppend
  117.       END SUB
  118. * REPLACING old line(s) by new
  119. 59510 ZFileName$ = CurMenu$
  120.       InMenu = ZTrue                                                 ' KG041701
  121. * ------[ first line different ]------
  122.       CALL BreakFileName (FrontOpt$,WasX$,FrontPre$,ZWasDF$,ZTrue)   ' KG101101
  123.       CALL BreakFileName (CurMenu$,MenuDrv$,WasX$,ZWasDF$,ZTrue)
  124.       MenuFront$ = MenuDrv$ + LEFT$(WasX$,LEN(WasX$)-LEN(PreSuf$))   ' KG090801
  125.       IF CurMenu$ = LastSubMenu$ THEN _                              ' KG090801
  126.          MenuFront$ = LEFT$(MenuFront$,LEN(MenuFront$)-1)            ' KG090801
  127.       CALL Graphic (GRDefault$,ZFileName$)
  128.       CurMenuVer$ = ZFileName$
  129.       ZStopInterrupts = ZFalse
  130.       IF ZAnsIndex < ZLastIndex OR ZExpertUser THEN _
  131.          GOTO 59520
  132. * REPLACING old line(s) by new
  133. 59530 ZWasZ$ = ZUserIn$(ZAnsIndex)
  134.       CALL AllCaps (ZWasZ$)
  135.       IF INSTR(ReturnOn$,ZWasZ$) THEN _  'check whether calling pgm wants
  136.          EXIT SUB
  137.       IF INSTR("LH?",ZWasZ$) THEN _       'check whether caller wants help
  138.          GOTO 59515
  139.       IF INSTR(ZWasZ$,".") > 0 THEN _
  140.          GOTO 59532
  141.       CALL BadFile (ZWasZ$,WasBF)                                    ' KG081705
  142.       IF WasBF > 1 THEN _                                            ' KG081705
  143.          GOTO 59532                                                  ' KG081705
  144.       FPre$ = MenuFront$   ' check for sub-option                    ' KG081603
  145.       PreSuf$ = "-"                                                  ' KG090801
  146.       CALL BadFile (FPRE$ + ZWasZ$ + "-",WasBF)                      ' KG090801
  147.       ZOK = ZFalse                                                   ' KG082401
  148.       IF WasBF < 2 THEN _                                            ' KG082401
  149.          VerifyInMenu = ZFalse : _                                   ' KG082401
  150.          GOSUB 59538
  151.       PreSuf$ = ""                                                   ' KG090801
  152.       VerifyInMenu = PassedVerifyInMenu                              ' KG082005
  153.       IF NOT ZOK THEN _                                              ' KG081603
  154.          FPre$ = FrontOpt$ : _    ' check standard option            ' KG081603
  155.          GOSUB 59538 : _
  156.          IF NOT ZOK THEN _    ' check option where menu is           ' KG081603
  157. * ------[ first line different ]------
  158.             FPre$ = MenuDrv$ + FrontPre$ : _                         ' KG101101
  159.             IF FrontOpt$ <> FPre$ THEN _                             ' KG101101
  160.                GOSUB 59538                                           ' KG101101
  161.       IF NewMenu THEN _
  162.          NewMenu = ZFalse : _
  163.          GOTO 59515
  164.       IF ZOK THEN _
  165.          EXIT SUB
  166. * REPLACING old line(s) by new
  167. * ------[ first line different ]------
  168. 59532 IF INSTR(ReturnOn$,LEFT$(ZWasZ$,1)) > 0 THEN _                 ' KG102202
  169.          ZWasZ$ = LEFT$(ZWasZ$,1) : _                                ' KG102202
  170.          EXIT SUB
  171.       GOSUB 59547
  172.       GOTO 59515
  173. * REPLACING old line(s) by new
  174. 59538 FilName$ = FPre$ + ZWasZ$ + PreSuf$                            ' KG090801
  175.       ZFileName$ = FilName$ + BackOpt$                               ' KG090801
  176. * ------[ first line different ]------
  177.       GOSUB 59543                                                    ' KG101201
  178.       IF WasBF > 1 THEN _                                            ' KG101201
  179.          ZOK = ZFalse : _                                            ' KG101201
  180.          RETURN                                                      ' KG101201
  181.       CALL Graphic (GRDefault$,ZFileName$)
  182.       IF NOT ZOK THEN _
  183.          IF BackOpt2$ <> "" THEN _
  184.             ZFileName$ = FilName$ + _
  185.                          BackOpt2$ : _
  186.          GOSUB 59543 : _                                             ' KG101201
  187.          IF WasBF > 1 THEN _                                         ' KG101201
  188.             ZOK = ZFalse : _                                         ' KG101201
  189.             RETURN _                                                 ' KG101201
  190.          ELSE CALL Graphic (GRDefault$,ZFileName$)                   ' KG101201
  191.       IF ZOK THEN _                                                  ' KG092301
  192.          CALL WordInFile (CurMenu$,ZWasZ$,InMenu) : _                ' KG092301
  193.          IF ZSysop OR InMenu OR (NOT RequireInMenu) THEN _           ' KG092301
  194.             RETURN _
  195.          ELSE GOTO 59540
  196.       IF (NOT VerifyInMenu) THEN _
  197.          GOTO 59540
  198.       CALL WordInFile (CurMenu$,ZWasZ$,InMenu)  'verify against menu itself ' KG032502
  199.       IF InMenu THEN _                                               ' KG032502
  200.          IF AllMenuOK THEN _
  201.             RETURN
  202. * INSERTING new line(s)
  203. 59543 WasZ$ = ZWasZ$                                                 ' KG101201
  204.       CALL BadName (WasBF,ZFalse)                                    ' KG101201
  205.       ZWasZ$ = WasZ$                                                 ' KG101201
  206.       RETURN                                                         ' KG101201
  207. * REPLACING old line(s) by new
  208. 60300 ' $SUBTITLE: 'AutoPage - NOTIFIES ZSysop WHEN SPECIFIC USER CALLS'
  209. ' $PAGE
  210. '
  211. '  NAME    --  AutoPage   'Contributed  by Gregg and Bob Snyder
  212. '                        'and RoseMarie Siddiqui
  213. '
  214. '  INPUTS  --  ZAutoPageDef$  List of conditions that trigger
  215. '                                       notification and how
  216. '
  217. '  OUTPUTS -- NONE
  218. '
  219. '  PURPOSE -- Search ZAutoPageDef$ for match on whether
  220. '             on name, security level, whether new user.
  221. '             Also controls whether caller notified and
  222. '             number of times sysop has bell rung.
  223. '             And what tune to play (if any).
  224. '
  225.       SUB AutoPage STATIC
  226.       CALL FindIt (ZAutoPageDef$)
  227.       IF NOT ZOK THEN _
  228.          EXIT SUB
  229.       ZErrCode = 0
  230.       ZOK = ZFalse
  231.       WHILE NOT EOF(2) AND ZOK = ZFalse AND ZErrCode = 0
  232.          CALL ReadParms (ZWorkAra$(),4,1)
  233.          IF ZErrCode = 0 THEN _
  234.             ZOK = (ZWorkAra$(1) = ZActiveUserName$) : _
  235.             IF NOT ZOK THEN _
  236.                IF ZNewUser AND ZWorkAra$(1) = "NEWUSER" THEN _
  237.                   ZOK = ZTrue _
  238.                ELSE IF LEFT$(ZWorkAra$(1),1) = "/" AND LEN(ZWorkAra$(1)) > 2 THEN _
  239.                        ZWasB = INSTR (2,ZWorkAra$(1),"/") : _
  240.                        IF ZWasB > 0 AND LEN(ZWorkAra$(1)) > ZWasB THEN _
  241.                           IF ZUserSecLevel <= VAL(MID$(ZWorkAra$(1),ZWasB+1)) AND _
  242.                              ZUserSecLevel >= VAL(MID$(ZWorkAra$(1),2)) THEN _
  243.                                 ZOK = ZTrue
  244.       WEND
  245.       CLOSE 2
  246.       IF ZErrCode > 0 OR NOT ZOK THEN _
  247.          ZErrCode = 0 : _
  248.          EXIT SUB
  249.       ZPageStatus$ = "AP!"                                           ' DA080902
  250.       IF LEFT$(ZWorkAra$(2),1) = "N" THEN _
  251.          ZOutTxt$ = "Telling sysop you're on..." : _
  252.          CALL RingCaller
  253.       ZWasB = (ZWorkAra$(4) = "")
  254.       ZWorkAra$(5) = ""
  255. * ------[ first line different ]------
  256.      TempSnoop = ZSnoop                                              ' DA101801
  257.      ZSnoop = ZTrue                                                  ' DA101801
  258.      CALL Line25                                                     ' DA102401
  259.       FOR WasI = 1 TO VAL(ZWorkAra$(3))
  260.          IF ZWasB THEN _
  261.             CALL LPrnt (ZBellRinger$,0) : _
  262.          ELSE ZWorkAra$(5) = ZWorkAra$(5) + "O4 X" + VARPTR$(ZWorkAra$(4))
  263.       NEXT
  264.       IF NOT ZWasB THEN _
  265.          CALL RBBSPlay (ZWorkAra$(5))
  266.       ZSnoop = TempSnoop                                             ' DA101801
  267.       END SUB
  268. * REPLACING old line(s) by new
  269. 64462 CALL CheckInt (ZOutTxt$)
  270.       IF ZErrCode = 0 THEN _
  271.          Temp = ZUserSecLevel + _
  272.             WasX * ZTestedIntValue : _
  273.          IF Temp <= MaxSecLevel THEN _
  274.             ZUserSecLevel = Temp : _
  275.             ZUserSecSave = ZUserSecLevel : _
  276.             ZAdjustedSecurity = ZTrue
  277. * ------[ first line different ]------
  278.             IF ZOrigMsgFile$ = ZActiveMessageFile$ THEN _            ' KG102703
  279.                ZOrigSec = ZUserSecLevel                              ' KG102703
  280.       GOTO 64110
  281.