home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / BBS / RBBS_PC / AED243A.ZIP / RSB4UGLY.MRG < prev    next >
Encoding:
Text File  |  1990-06-10  |  13.2 KB  |  367 lines
  1. * ------------[ BLED merge (c) Ken Goosens ]-------------
  2. * Merge this against RBBSSUB4.BAS to produce RSB4UGLY.BAS
  3. * RBBSSUB4.BAS:  Date 5-26-1990  Size 122396 bytes
  4. * ------------[ Created 06-10-1990 01:53:43 ]------------
  5. * REPLACING old line(s) by new
  6. * ------[ first line different ]------
  7. 57130 ZOutTxt$ = MID$("CheckSkip",1 -5 * (NOT ZCheckBulletLogon),5) + _
  8.            " old Bulletins at Logon"
  9.       CALL QuickTPut1 (ZOutTxt$)
  10.       RETURN
  11. * REPLACING old line(s) by new
  12. * ------[ first line different ]------
  13. 57160 ZOutTxt$ = MID$("CheckSkip",1 -5 * ZSkipFilesLogon,5) + _
  14.            " new Files at Logon"
  15.       CALL QuickTPut1 (ZOutTxt$)
  16.       RETURN
  17. * REPLACING old line(s) by new
  18. 58900 ZOutTxt$ = ZDirPrompt$
  19.       ZMacroMin = 2
  20.       CALL PopCmdStack
  21.       IF ZWasQ = 0 OR ZSubParm = -1 THEN _
  22.          EXIT SUB
  23.       CALL AllCaps (ZUserIn$(ZAnsIndex))
  24.       IF ZUserIn$(ZAnsIndex) = "Q" THEN _
  25.          ZWasQ = 0 : _
  26.          EXIT SUB
  27.       ZWasA = INSTR("E+.E-.E.L.H.?.",ZUserIn$(ZAnsIndex)+".")
  28.       IF ZWasA = 0 THEN _
  29.          EXIT SUB
  30.       IF ZWasA > 8 THEN _
  31.          IF ZAnsIndex < ZLastIndex THEN _
  32.             GOTO 58900 _
  33.          ELSE GOTO 58902
  34.       IF ZWasA = 7 THEN _
  35.          ZExtendedOff = NOT ZExtendedOff _
  36.       ELSE ZExtendedOff = (ZWasA > 3)
  37. * ------[ first line different ]------
  38.       CALL QuickTPut1 ("Extended directory display "+MID$("On Off",1-3*ZExtendedOff,3))
  39.       GOTO 58900
  40. * REPLACING old line(s) by new
  41. * ------[ first line different ]------
  42. 59303 CALL QuickTPut(ZEmphasizeOff$,0)
  43.       ZOutTxt$ = "Download what: L)ist, * = new, or file(s)" + _
  44.            ZPressEnterExpert$
  45.       ZMacroMin = 99
  46.       ZStackC = ZTrue
  47.       CALL PopCmdStack
  48.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  49.          ZLastIndex = 0 : _
  50.          EXIT SUB
  51. * REPLACING old line(s) by new
  52. 59320 ZOutTxt$ = PartToPrint$
  53. * ------[ first line different ]------
  54.       IF LEN(ZOutTxt$) > 78 THEN _
  55.          ZOutTxt$ = LEFT$(ZOutTxt$,78)
  56.       CALL ColorDir (ZOutTxt$,"Y")
  57.       IF PersonalStatus$ = "*" AND LEFT$(ZOutTxt$,1) <> " " THEN _
  58.          ZOutTxt$ = "*" + ZOutTxt$ _
  59.       ELSE ZOutTxt$ = " " + ZOutTxt$
  60.       IF ZLocalUser THEN _
  61.          GOTO 59322
  62.       CALL EofComm (Char)
  63.       IF Char <> -1 THEN _
  64.          GOTO 59323            ' comm port input
  65. * REPLACING old line(s) by new
  66. 59325 IF PersIndex > 0 THEN _
  67. * ------[ first line different ]------
  68.          ZOutTxt$ = "More [Y],N,C or download what (* = new)" _
  69.       ELSE GOTO 59303
  70.       ZNoAdvance = ZTrue
  71.       ZMacroMin = 99
  72.       ZStackC = ZTrue
  73.       CALL PopCmdStack
  74.       IF ZSubParm = -1 THEN _
  75.          GOTO 59335
  76.       ZNonStop = (ZNonStop OR INSTR(" Cc",ZUserIn$) > 1)
  77.       IF PersIndex < 1 AND ZWasQ = 0 THEN _
  78.          GOTO 59335
  79.       CALL WipeLine (78)
  80.       IF ZNo THEN _
  81.          GOTO 59303
  82.       IF LEN(ZUserIn$(ZAnsIndex)) > 2 THEN _
  83.          GOTO 59304
  84.       GOTO 59306
  85. * REPLACING old line(s) by new
  86. 59456 ZFileName$ = ZCurPUI$
  87.       CALL Graphic (GDefault$,ZFileName$)
  88.       IF NOT ZOK THEN _
  89.          CALL UpdtCalr ("Missing menu " + ZCurPUI$,2) : _
  90.          ZCurPUI$ = ZPrevPUI$ : _
  91.          GOTO 59456
  92. * ------[ first line different ]------
  93.       CALL BreakFileName(ZFileName$,ZWasZ$,ZActiveMenu$,ZWasZ$,ZTrue)
  94.       ZActiveMenu$ = LEFT$(ZActiveMenu$,1)
  95.       LSET ZLastCommand$ = ZActiveMenu$ + " "
  96.       ZPrevPUI$ = ZCurPUI$
  97.       LINE INPUT #2,ZFileName$
  98.       LINE INPUT #2,Prompt$
  99.       INPUT #2,ValidChoice$,ActualCommands$
  100.       LINE INPUT #2,MenuChoice$
  101.       LINE INPUT #2,MenuName$
  102.       LINE INPUT #2,QuitCmd$
  103.       LINE INPUT #2,QuitPrompt$
  104.       LINE INPUT #2,QuitSubCmds$
  105.       LINE INPUT #2,QuitMenuOpt$
  106.       LINE INPUT #2,QuitMenus$
  107.       CALL Graphic (GDefault$,ZFileName$)
  108.       CALL BreakFileName (ZFileName$,MenuDrvPath$,WasX$,ZWasY$,ZTrue)
  109.       MenuToDisplay$ = ZFileName$
  110.       WasJ = INSTR(ZOrigCommands$,"?")
  111.       IF WasJ < 1 THEN _
  112.          WasX$ = "" _
  113.       ELSE WasX$ = MID$(ZAllOpts$,WasJ,1)
  114. * REPLACING old line(s) by new
  115. * ------[ first line different ]------
  116. 59461 MID$(ZLastCommand$,2,1) = " "
  117.       ZOutTxt$ = Prompt$
  118.       CALL SmartText(ZOutTxt$,ZWasQ,ZFalse)
  119.       ZTurboKey = -ZTurboKeyUser
  120.       CALL PopCmdStack
  121.       IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
  122.          EXIT SUB
  123.       IF ZWasQ = 0 THEN _
  124.          GOTO 59458
  125. * REPLACING old line(s) by new
  126. * ------[ first line different ]------
  127. 59470 MID$(ZLastCommand$,2,1) = ZWasZ$
  128.       ZOutTxt$ = QuitPrompt$
  129.       ZTurboKey = -ZTurboKeyUser
  130.       CALL PopCmdStack
  131.       IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
  132.          EXIT SUB
  133.       IF ZWasQ = 0 THEN _
  134.          GOTO 59458
  135. * REPLACING old line(s) by new
  136. * ------[ first line different ]------
  137. 59492 CALL QuickTPut1 ("No such option <" + ZWasZ$ + ">")
  138.       GOTO 59460
  139.       END SUB
  140. * REPLACING old line(s) by new
  141. 59850 ' $SUBTITLE: 'ConfMail -- quickly checks mail waiting'
  142. ' $PAGE
  143. '
  144. '  NAME    -- ConfMail
  145. '
  146. '  INPUTS  -- PARAMETER        MEANING
  147. '         SKIP.CONFIRM         Whether to skip confirm of option
  148. '         ZConfMailList$       File of user/message pairs to check
  149. '         ZActiveUserFile$     Active user file (restored on exit)
  150. '         ZActiveMessageFile$  Active msg file (restored)
  151. '  OUTPUTS -- None
  152. '
  153. '  PURPOSE -- Quicking scans message header record to get
  154. '             last msg # and user record to get whether any
  155. '             new mail and last msg read, reports both, using
  156. '             highlighting if new mail to caller.
  157. '
  158.       SUB ConfMail (MailCheckConfirm) STATIC
  159.       SkipJoinUnjoin = ZNonStop
  160.       IF ZStartHash = 1 AND ZUserFileIndex > 0 THEN _
  161.          CALL FindIt (ZConfMailList$) _
  162.       ELSE ZOK = ZFalse
  163.       IF NOT ZOK THEN _
  164.          EXIT SUB
  165.       IF MailCheckConfirm THEN _
  166.          ZOutTxt$ = "Check conferences for mail ([Y],N)" : _
  167.          ZTurboKey = -ZTurboKeyUser : _
  168.          CALL PopCmdStack : _
  169.          IF ZNo OR ZSubParm < 0 THEN _
  170.             EXIT SUB
  171.       CALL BreakFileName (ZActiveUserFile$,WasX$,NowInPre$,NowInExt$,ZFalse)
  172.       CALL BreakFileName (ZOrigUserFile$,WasX$,OrigPre$,OrigExt$,ZFalse)
  173.       CALL SkipLine (1)
  174. * ------[ first line different ]------
  175.       CALL QuickTPut1 ("Checking Message Bases...")
  176.       AnyMail = ZFalse
  177.       ZStopInterrupts = ZFalse
  178.       WasA1$ = ZActiveUserFile$
  179.       MsgFileSave$ = ZActiveMessageFile$
  180.       TempIndivValue$ = ""
  181.       UserFileIndexSave = ZUserFileIndex
  182.       UserRecordHold$ = ZUserRecord$
  183.       ZOK = ZTrue
  184. * REPLACING old line(s) by new
  185. 59852 IF EOF(2) OR NOT ZOK THEN _
  186.          GOTO 59854
  187.          CALL ReadAny
  188.          ZActiveUserFile$ = ZOutTxt$
  189.          CALL ReadAny
  190.          IF ZErrCode > 0 THEN _
  191.             GOTO 59854
  192.          ZActiveMessageFile$ = ZOutTxt$
  193.          CALL FindFile (ZActiveUserFile$,ZOK)
  194.          IF NOT ZOK THEN _
  195.             GOTO 59854
  196.          CALL OpenUser (HighestUserRecord)
  197.          FIELD 5, 128 AS ZUserRecord$
  198.          CALL FindFile (ZActiveMessageFile$,ZOK)
  199.          IF NOT ZOK THEN _
  200.             GOTO 59854
  201.          CALL FindUser (ZOrigUserName$,"",ZStartHash,ZLenHash,_
  202.                         0,0,HighestUserRecord,_
  203.                         Found,HoldUserFileIndex,ZWasSL)
  204.          IF NOT Found THEN _
  205.             GOTO 59852
  206.          CALL OpenMsg
  207.          FIELD 1, 128 AS ZMsgRec$
  208.          GET 1,1
  209.          AnyMail = ZTrue
  210.          WasX = CVI(MID$(ZUserRecord$,57,2))
  211.          WasX = (WasX AND 512) > 0
  212.          CALL BreakFileName (ZActiveUserFile$,WasX$,CurPre$,CurExt$,ZFalse)
  213.          InCur = (CurPre$ = NowInPre$ AND CurExt$ = NowInExt$)
  214.          IF InCur THEN _
  215.             WasX = ZMailWaiting : _                                  ' KG030101
  216.             ZWasA = ZLastMsgRead _
  217.          ELSE ZWasA = CVI(MID$(ZUserRecord$,51,2))
  218.          ZWasB = VAL(LEFT$(ZMsgRec$,8))
  219.          WasZ = (ZWasB - ZWasA)
  220.          IF WasZ < 0 THEN _
  221.             ZWasA = 0 : _
  222.             WasZ = ZWasB _
  223.          ELSE IF WasZ = 0 THEN _
  224.                  WasX = ZFalse
  225.          ZOutTxt$ = MID$(STR$((ZWasB > ZWasA) * WasZ),2)
  226.          ZWasSL = LEN(ZOutTxt$)
  227.          ZOutTxt$ = SPACE$(-(ZWasSL<4) * (4-ZWasSL)) + ZOutTxt$
  228.          ZWasSL = LEN(CurPre$)
  229.          IF CurPre$ = "USERS" AND CurExt$ = "" THEN _
  230.             Conf$ = "MAIN" _
  231.          ELSE Conf$ = LEFT$(CurPre$,ZWasSL-1)
  232.          ZWasY$ = Conf$ + SPACE$(-(ZWasSL<8) * (8-ZWasSL))
  233.          IF WasX THEN _
  234.             WasX$ = ZEmphasizeOn$ : _
  235.             ZWasZ$ = ZEmphasizeOff$ _
  236.          ELSE WasX$ = "" : _
  237.               ZWasZ$ = ""
  238.          ZOutTxt$ = ZWasY$ + ": " + ZOutTxt$ + " new message(s): " + _
  239. * ------[ first line different ]------
  240.               WasX$ + MID$("-None-*Some*",-6 * WasX + 1,6) + " to you" + ZWasZ$
  241.          ZSubParm = 5
  242.          CALL TPut
  243.          IF WasZ <= 0 THEN _
  244.             GOTO 59853
  245.          IF SkipJoinUnjoin THEN _
  246.             CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue) : _
  247.             GOTO 59853
  248.          ZTurboKey = -ZTurboKeyUser
  249.          CALL AskMore (",J)oin,U)njoin",ZTrue,ZFalse,WasX,ZFalse)
  250.          IF ZNo THEN _
  251.             GOTO 59854
  252.          WasX$ = LEFT$(ZUserIn$(1),1)
  253.          CALL AllCaps (WasX$)
  254.          IF WasX$ = "J" THEN _
  255.             ZHomeConf$ = Conf$ : _
  256.             GOTO 59854
  257.          IF WasX$ = "U" THEN _
  258.             IF InCur OR (OrigPre$ = CurPre$ AND OrigExt$ = CurExt$) THEN _
  259.                CALL QuickTPut1 ("Can't omit yourself from the board or conference you're in.") _
  260.             ELSE LSET ZUserRecord$ = CHR$(0) + "deleted user" : _
  261.                  ZUserFileIndex = HoldUserFileIndex : _
  262.                  ZSubParm = 6 : _
  263.                  CALL FileLock : _
  264.                  PUT 5, HoldUserFileIndex : _
  265.                  ZSubParm = 8 : _
  266.                  CALL FileLock : _
  267.                  CALL QuickTPut1 ("Omitted you from " + Conf$)
  268. * REPLACING old line(s) by new
  269. 59854 ZActiveUserFile$ = WasA1$
  270.       CALL OpenUser (HighestUserRecord)
  271.       FIELD 5, 128 AS ZUserRecord$
  272.       IF (NOT ZRet) AND NOT AnyMail THEN _
  273. * ------[ first line different ]------
  274.          CALL QuickTPut1 ("You haven't joined any conferences.")
  275.       ZUserFileIndex = UserFileIndexSave
  276.       LSET ZUserRecord$ = UserRecordHold$
  277.       ZActiveMessageFile$ = MsgFileSave$
  278.       CALL OpenMsg
  279.       FIELD 1, 128 AS ZMsgRec$
  280.       GET 1,1
  281.       ZNonStop = (ZPageLength > 0)
  282.       END SUB
  283. * REPLACING old line(s) by new
  284. 62540 ' $SUBTITLE: 'RptTime -- Reports time on system'
  285. ' $PAGE
  286. '
  287. '  NAME    --  RptTime
  288. '
  289. '  INPUTS  --  PARAMETER                   MEANING
  290. '
  291. '  OUTPUTS --
  292. '
  293. '  PURPOSE --  Tells user time used on system
  294. '
  295.       SUB RptTime STATIC
  296.       CALL SkipLine (1)
  297.       CALL GetTime
  298.       CALL AMorPM
  299.       Mins = (ZSessionHour * 60) + ZSessionMin
  300.       CALL Carrier
  301.       IF ZSubParm = -1 THEN _
  302.          EXIT SUB
  303. * ------[ first line different ]------
  304.       CALL QuickTPut1 ("It's Now: " + DATE$ + " at " + TIME$)
  305.       CALL QuickTPut1 ("Time On:" + STR$(Mins) + " mins," + _
  306.                         STR$(ZSessionSec) + " secs")
  307.       CALL Talk (7,ZOutTxt$)
  308.       END SUB
  309. * REPLACING old line(s) by new
  310. 62620 ' $SUBTITLE: 'Transfer - Subroutine for external protocols'
  311. ' $PAGE
  312. '
  313. '  NAME    -- Transfer
  314. '
  315. '  INPUTS  --     PARAMETER                    MEANING
  316. '              ZTransferFunction         = 1 DOWNLOAD FILE TO USER
  317. '                                        = 2 UPLOAD FILE TO RBBS-PC
  318. '              ZFileName$                NAME OF FILE FOR Transfer
  319. '              ZComPort$                 NAME OF COMMUNICATIONS PORT
  320. '                                        TO BE USED BY KERMIT (COM1
  321. '                                        OR COM2)
  322. '              ZBPS                      = -1 FOR   300 BAUD
  323. '                                        = -2 FOR   450 BAUD
  324. '                                        = -3 FOR  1200 BAUD
  325. '                                        = -4 FOR  2400 BAUD
  326. '                                        = -5 FOR  4800 BAUD
  327. '                                        = -6 FOR  9600 BAUD
  328. '                                        = -7 FOR 19200 BAUD
  329. '
  330. '  OUTPUTS  -- NONE
  331. '
  332. '  PURPOSE -- To transfer files using external protocols
  333. '
  334.       SUB Transfer STATIC
  335.       IF ZPrivateDoor THEN _
  336.          CALL PrivDoorRtn : _
  337.          EXIT SUB
  338.       IF ZTransferFunction = 1 THEN _
  339.          ZUserIn$ = ZDownTemplate$ : _
  340.          ZWasZ$ = "send " _
  341.       ELSE IF ZTransferFunction = 2 THEN _
  342.               ZUserIn$ = ZUpTemplate$ : _
  343.               ZWasZ$ = "receive "
  344.       CALL MetaGSR (ZUserIn$,ZFalse)
  345.       CALL QuickTPut1 ("Protocol     : "+ZProtoPrompt$)
  346. * ------[ first line different ]------
  347.       CALL QuickTPut ("Ready to " + ZWasZ$,0)
  348.       IF ZBatchTransfer THEN _
  349.          CALL QuickTPut1 ("(BATCH)") : _
  350.          CALL OpenWork (2,ZNodeWorkFile$) : _
  351.          WHILE NOT EOF(2) : _
  352.            CALL ReadAny : _
  353.            CALL BreakFileName (ZOutTxt$,ZWasZ$,ZWasY$,WasX$,ZTrue) : _
  354.            CALL QuickTPut1 ("   "+ZWasY$+WasX$) : _
  355.          WEND _
  356.       ELSE CALL QuickTPut1 (ZFileNameHold$)
  357.       IF ZAutoLogoffReq THEN _
  358.          CALL QuickTPut1 ("Automatic logoff, if download successful")
  359.       CALL PrivDoorRtn
  360.       END SUB
  361. * REPLACING old line(s) by new
  362. * ------[ first line different ]------
  363. 64510 ZChatAvail = (INSTR("|@",ZActiveMenu$) = 0)
  364.       ZOK = ZTrue
  365.       ZLastIndex = 0
  366.       END SUB
  367.