home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / BBS / RBBS_PC / AED243A.ZIP / RSB3UGLY.MRG < prev    next >
Encoding:
Text File  |  1990-06-10  |  9.7 KB  |  271 lines
  1. * ------------[ BLED merge (c) Ken Goosens ]-------------
  2. * Merge this against RBBSSUB3.BAS to produce RSB3UGLY.BAS
  3. * RBBSSUB3.BAS:  Date 5-26-1990  Size 116300 bytes
  4. * ------------[ Created 06-10-1990 01:52:43 ]------------
  5. * REPLACING old line(s) by new
  6. 20705 ' $SUBTITLE: 'UpdtUpload -- Updates upload directory'
  7. ' $PAGE
  8. '  NAME    -- UpdtUpload
  9. '
  10. '  INPUTS  -- PARAMETER             MEANING
  11. '             ZFileName$
  12. '             ZUpldDir$
  13. '             ZFileNameHold$
  14. '             ZShareIt
  15. '             ZFMSDirectory$
  16. '             ZWasQ!
  17. '             ZSecsUsedSession!
  18. '
  19. '  OUTPUTS -- ZBytesInFile#
  20. '             ZSecsPerSession!
  21. '
  22. '  PURPOSE -- Upon a successful upload, add entry to the upload
  23. '             directory and give any session time credit.
  24. '
  25.       SUB UpdtUpload (ZCategoryName$(1),ZCategoryCode$(1), LinesInDesc) STATIC
  26.       IF ZGetExtDesc THEN _
  27.          GOTO 20723
  28.       GOSUB 20734
  29.       CALL TimeRemain (MinsRemaining)
  30.       IF ZPrivateDoor THEN _
  31.          WasX! = ZUpldTimeFactor! * ZWasQ! _
  32.       ELSE WasX! = ZUpldTimeFactor! * (ZSecsUsedSession! - ZWasQ!)
  33.       CALL BreakFileName (ZFileName$,Pre$,Body$,Ext$,ZFalse)
  34.       WasX$ = ZDiskForDos$ + "T" + Ext$ + ".BAT"
  35.       CALL FindIt (WasX$)
  36.       IF NOT ZOK THEN _
  37.          GOTO 20708
  38. * ------[ first line different ]------
  39.       CALL QuickTPut1 ("Testing Upload.  Please wait...") : _
  40.       CALL ReadDir (2,1)
  41.       IF EOF(2) THEN _
  42.          WasX$ = ZOutTxt$ : _
  43.          ZGSRAra$(1) = ZFileName$ : _
  44.          ZGSRAra$(2) = ZNodeWorkFile$ _
  45.       ELSE WasX$ = WasX$ + " " + _
  46.            ZFileName$ + " " + ZNodeWorkFile$
  47.       CALL ShellExit (WasX$)
  48.       CALL FindIt (ZNodeWorkFile$)
  49.       IF ZOK THEN _
  50.          IF LOF(2) > 2 THEN _
  51.             ZBytesInFile# = 0.0 : _
  52.             WasX$ = "Deleting BAD upload " + ZFileNameHold$ : _
  53.             CALL QuickTPut1 (WasX$) : _
  54.             CALL UpdtCalr (WasX$,2) : _
  55.             CALL KillWork (ZFileName$) : _
  56.             EXIT SUB
  57. * REPLACING old line(s) by new
  58. * ------[ first line different ]------
  59. 20709 CALL QuickTPut1 ("Upload successful!")
  60.       WasX$ = DATE$
  61.       ZWasZ$ = LEFT$(WasX$,6) + _
  62.            RIGHT$(WasX$,2)
  63.       StrewTo$ = ""
  64.       UCat$ = ""
  65. * REPLACING old line(s) by new
  66. * ------[ first line different ]------
  67. 20710 CALL QuickTPut1 ("Please describe " + ZFileNameHold$ + _
  68.            " (Begin with '/' if for SYSOP only)")
  69.       CALL QuickTPut1 (LEFT$(" |----+--Min<..-+---2+0---+---3+0---+---4+0---+-", _
  70.                  ZMaxDescLen - 4) + "..Max>")
  71.       CALL QuickTPut ("? ",0)
  72.       ZOutTxt$ = ""
  73.       ZSubParm = 1
  74.       ZParseOff = ZTrue
  75.       CALL TGet
  76.       CALL Carrier
  77.       IF ZSubParm = -1 THEN _
  78.          ZUserIn$ = "<description unavailable>": _
  79.          GOTO 20712
  80.       IF LEN(ZUserIn$) > ZMaxDescLen OR LEN(ZUserIn$) < 10 THEN _
  81.          CALL QuickTPut1 ("10 chars min," + STR$(ZMaxDescLen) + " max") : _
  82.          GOTO 20710
  83. * REPLACING old line(s) by new
  84. 20722 IF ZUserSecLevel >= ZAskExtendedDesc AND _
  85.          ZMaxExtendedLines > 0 AND ZSubParm <> -1 THEN _
  86. * ------[ first line different ]------
  87.          ZOutTxt$ = "Add an extended description for " + _
  88.               ZFileNameHold$ + " ([Y],N)" : _
  89.          ZTurboKey = -ZTurboKeyUser : _
  90.          ZSubParm = 1 : _
  91.          CALL TGet : _
  92.          IF ZSubParm <> -1 THEN _
  93.             IF NOT ZNo THEN _
  94.                ZGetExtDesc = ZTrue : _
  95.                EXIT SUB
  96. * REPLACING old line(s) by new
  97. 20726 ZWasDF$ = " >> uploaded << "
  98.       ZUplds = ZUplds + 1
  99.       ZGlobalUplds = ZGlobalUplds + 1
  100.       ZULBytes! = ZULBytes! + ZBytesInFile#
  101.       ZGlobalULBytes! = ZGlobalULBytes! + ZBytesInFile#
  102.       CALL Muzak (7)
  103.       CALL TimeRemain (MinsRemaining)
  104.       ZTimeCredits! = ZTimeCredits! + WasX!
  105.       ZSecsPerSession! = ZSecsPerSession! + WasX!
  106.       IF ZPrivateDoor THEN _
  107.          WasX! = (WasX! - ZWasQ!) / 60 _
  108.       ELSE WasX! = (WasX! - ZSecsUsedSession! + ZWasQ!)/60.0
  109.       WasX$ = STR$(FIX(WasX!*10.0))
  110.       WasX$ = LEFT$(WasX$,LEN(WasX$)-1) + "." + RIGHT$(WasX$,1)
  111.       IF WasX! > 1 THEN _
  112. * ------[ first line different ]------
  113.          CALL QuickTPut1 ("The upload increased your session time by"+WasX$+" minutes.")
  114.       ZOutTxt$ = ZFirstName$
  115.       CALL NameCaps(ZOutTxt$)
  116.       CALL QuickTPut1 (ZOutTxt$ + ", thanks for the upload!")
  117.       ZGetExtDesc = ZFalse
  118.       EXIT SUB
  119. * REPLACING old line(s) by new
  120. 31398 IF NOT ZLocalUser THEN _
  121.          CALL Carrier : _
  122.          IF ZSubParm = -1 THEN _
  123.             GOTO 33970
  124. * ------[ first line different ]------
  125.       IF INSTR("|@",ZActiveMenu$) = 0 THEN _
  126.          GOTO 31399
  127.       ZCursorLine = CSRLIN
  128.       ZCursorRow = POS(0)
  129.       LOCATE 25,1
  130.       WasD$ = SPACE$(79)
  131.       GOSUB 33210
  132.       LOCATE 25,1
  133.       WasD$ ="Cannot FORCE OFF until user reaches MAIN menu"
  134.       GOSUB 33210
  135.       CALL DelayTime (1)
  136.       LOCATE ZCursorLine,ZCursorRow
  137.       ZSubParm = 1
  138.       CALL Line25
  139.       GOTO 33970
  140. * REPLACING old line(s) by new
  141. 41032 ' $SUBTITLE: 'DispTimeRemain - Display users time remaining'
  142. ' $PAGE
  143. '
  144. '  NAME    -- DispTimeRemain
  145. '
  146. '  INPUTS  --     PARAMETER                    MEANING
  147. '              MinsRemaining
  148. '
  149. '  OUTPUTS --     PARAMETER                    MEANING
  150. '                MinsRemaining               TIME IN MINUTES LEFT IN SESSION
  151. '
  152.       SUB DispTimeRemain (MinsRemaining) STATIC
  153.       CALL TimeRemain (MinsRemaining)
  154. * ------[ first line different ]------
  155.       CALL QuickTPut(ZEmphasizeOff$,0)
  156.       CALL QuickTPut1 (MID$(STR$(MinsRemaining),2) + " min left")
  157.       END SUB
  158. * REPLACING old line(s) by new
  159. * ------[ first line different ]------
  160. 43007 CALL QuickTPut1 ("Text File and Menu Graphics")
  161.       ZOutTxt$ = "Change from " + MID$("NAC",ZWasGR+1,1) + " to N)one, A)scii-IBM, C)olor-IBM, H)elp" + ZPressEnterExpert$
  162.       ZSubParm = 1
  163.       ZTurboKey = -ZTurboKeyUser
  164.       CALL TGet
  165.       IF ZSubParm = -1 THEN _
  166.          EXIT SUB
  167.       IF ZWasQ = 0 THEN _
  168.          CALL QuickTPut1 ("Graphics Unchanged.") : _
  169.          EXIT SUB
  170.       CALL AllCaps (ZUserIn$(1))
  171.       ZWasGR = INSTR("NAC",ZUserIn$(1))
  172.       IF ZWasGR = 2 AND NOT ZEightBit THEN _
  173.          CALL QuickTPut1 ("Ascii unavailable.  Requires 8 bit") : _
  174.          GOTO 43007
  175.       IF ZWasGR = 0 THEN _
  176.          GOTO 43006
  177.       ZWasGR = ZWasGR - 1
  178.       CALL SetGraphic (ZWasGR,ZUserGraphicDefault$)
  179.       END SUB
  180. '
  181. * REPLACING old line(s) by new
  182. 58110 ' $SUBTITLE: 'CheckNewBul - sub to check whether got new bulletins'
  183. ' $PAGE
  184. '
  185. '  NAME    -- CheckNewBul
  186. '
  187. '  INPUTS  --     PARAMETER           MEANING
  188. '                 LastOn$             Last DATE OF LOGON
  189. '                                   FORMAT MM/DD/YY
  190. '                 ZActiveBulletins  # OF BULLETING
  191. '                 ZBulletinPrefix$  FILESPEC FOR BULLETINS
  192. '
  193. '  OUTPUTS --     NumNewBullets   NUMBER OF NEW BULLETINS
  194. '                 NewBullets$      LIST OF NEW BULLET #'S
  195. '                 ZWasQ            WHERE Last BULLETIN STORED
  196. '                                  IN ZUserIn$()
  197. '                 ZUserIn$()       BULLETINS #'S THAT ARE NEW
  198. '                                    (2,3,4,...)
  199. '
  200. '  PURPOSE -- Checks how many bulletins have system date
  201. '             at or later than date caller last logged on
  202. '
  203.       SUB CheckNewBul (LastOn$,NumNewBullets,NewBullets$) STATIC
  204.       IF ZExitToDoors OR ZBulletinPrefix$ = ZPrevPrefix$ THEN _
  205.          EXIT SUB
  206.       ZPrevPrefix$ = ZBulletinPrefix$
  207.       NumNewBullets = 0
  208.       NewBullets$ = ":  "
  209.       BaseDate# = VAL(MID$(LastOn$,4,2)) + (100 * VAL(MID$(LastOn$,1,2))) + _
  210.                    (10000# * (1900 + VAL(MID$(LastOn$,7,2))))
  211.       CALL FindIt (ZBulletinPrefix$ + ".FCK")
  212.       WasX = 0
  213. * ------[ first line different ]------
  214.       CALL QuickTPut ("Checking New Bulletins",0)
  215.       IF ZOK THEN _
  216.          WHILE NOT EOF(2) : _
  217.             LINE INPUT #2,WasBN$ : _
  218.             GOSUB 58112 : _
  219.          WEND _
  220.       ELSE FOR WasI = 1 TO ZActiveBulletins : _
  221.               WasBN$ = MID$(STR$(WasI),2) : _
  222.               GOSUB 58112 : _
  223.            NEXT
  224.       ZWasQ = NumNewBullets + 1
  225.       IF NumNewBullets < 1 THEN _
  226.          NewBullets$ = ""
  227. '     CALL SkipLine (1)
  228.       CALL WipeLine(30)
  229.       ZOutTxt$ = "There are" + STR$(NumNewBullets) + _
  230.            " new bulletin(s) since last call" + _
  231.            NewBullets$
  232.       CALL QuickTPut1 (ZOutTxt$)
  233.       EXIT SUB
  234. * REPLACING old line(s) by new
  235. 58150 ' $SUBTITLE: 'CountNewFiles - sub to count how many files new'
  236. ' $PAGE
  237. '
  238. '  NAME    -- CountNewFiles
  239. '
  240. '  INPUTS  --     PARAMETER           MEANING
  241. '                  LastOn$          Date of last logon
  242. '                  UPLDS$            Latest uploads
  243. '
  244. '  OUTPUTS --    NumNewFiles       How many after last logon
  245. '                RptPrefix$         Set to "At least " if
  246. '                                    above is a minimum
  247. '
  248. '  PURPOSE -- Checks how many files in UPLDS$ were uploaded on or
  249. '             after date of last logon that the user can download
  250. '
  251.       SUB CountNewFiles (LastOn$,Upld(2),NumUserFiles,RptPrefix$) STATIC
  252.       BaseDate = 372 * (VAL(MID$(LastOn$,7,2)) - 80) + _
  253.                   31 * (VAL(MID$(LastOn$,1,2))) + _
  254.                   VAL(MID$(LastOn$,4,2))
  255.       NumNewFiles = 1
  256.       NumUserFiles = 0
  257.       WHILE (BaseDate <= Upld(NumNewFiles,1) AND _
  258.                 Upld(NumNewFiles,1) > 0 AND _
  259.                 NumNewFiles < UBOUND(Upld,1))
  260.          IF ZUserSecLevel => Upld(NumNewFiles,2) THEN _
  261.             NumUserFiles = NumUserFiles + 1
  262.          NumNewFiles = NumNewFiles + 1
  263.       WEND
  264.       IF Upld(NumNewFiles,1) < 1 THEN _
  265.          NumNewFiles = NumNewFiles - 1
  266.       IF BaseDate <= Upld(NumNewFiles,1) THEN _
  267. * ------[ first line different ]------
  268.          RptPrefix$ = " at least" _
  269.       ELSE RptPrefix$ = ""
  270.       END SUB
  271.