home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / sigmv084.ark / ENTRBBS.BAS < prev    next >
BASIC Source File  |  1984-04-29  |  25KB  |  867 lines
  1. 5 '  ------------->> ENTERBBS V2.7D 15/Jul/82 <<-------------
  2. 9 '
  3. 10 '         (As run on Software Tools/RCPM  Australia (61-2)-997-1836)
  4. 11 '         (slightly cleaned up by Ben Bronson and Bill Bolton)
  5. 12 '
  6. 15 '   : Entry/name-logging module of RBBS version 2.2,    :
  7. 20 '   : from Howard Moulton's original SJBBS (in Xitan    :
  8. 25 '   : Basic), converted to MBASIC and called RBBS or    :
  9. 30 '   : RIBBS by Bruce Ratoff, and extensively revised/   :
  10. 35 '   : expanded by Ron Fowler to become RBBS22.          :
  11. 40 '   :---------------------------------------------------:
  12. 45 '   : The Fowler version, RBBS22, was split into 2 mod- :
  13. 50 '   : ules, ENTERBBS and MINIRBBS, by Ben Bronson.      :
  14. 55 '   :---------------------------------------------------:
  15. 60 '   : Both were revised and given RBBS-compatible ver-  :
  16. 65 '   : sion nos. in 03/81 by Tim Nicholas, to incorporate:
  17. 70 '   : updates from his version 2.4 of RBBS.             :
  18. 75 '  ------------------------------------------------------
  19. 80 '     Added test for "*" in CALLERS file (from RBBS) and
  20. 85 '     if CALLERS file finds "*" in beginning of caller's
  21. 90 '     name, it will not allow him system access, and log
  22. 95 '     him off immediately. (For those who persist in log-
  23. 100 '     ging in with fictitious names, e.g. BUG BYTE). Also
  24. 105 '     added "PWDS" file (from RBBS) for "P2$" only. So
  25. 110 '     Sysop can get msgs for "SYSOP" or his name.
  26. 115 '     by Tim Nicholas  05/Mar/81
  27. 120 '    ------------------------------------------------------
  28. 125 '     Changed sequence of response to question "Did I mis-
  29. 130 '     anything?", so that a response other than "Y" or "y"
  30. 135 '     or "N"/"n" will re-ask the question. So in noisy line
  31. 140 '     conditions it won't automaticaly default to "N"/"n".
  32. 145 '     Added suggestion by Ben Bronson to move printing of
  33. 150 '     "BULLETIN" file to after name-taking, and other sign
  34. 155 '     in procedures.  by Tim Nicholas 12/Mar/81.
  35. 180 '    ------------------------------------------------------ 
  36. 181 '  More modifications by BB (14/Mar/81): checking-for-msgs
  37. 182 '  code transferred from MINIRBBS, lines 810-965.  No new
  38. 183 '  version number.  AND sysop now drops direct to disk
  39. 184 '  without incrementing COUNTERS.
  40. 185 ' -------------------------------------------------------- 
  41. 186 '  Modifications by Bill Bolton (up to 01/Jun/82). Godbout
  42. 187 '  System Support 1 clock routines, DATA file read moved to
  43. 188 '  before menus and BULLETIN choice so it can be used to show
  44. 189 '  date of latest update to BULLETIN, code "structured" for
  45. 190 '  easier reading/maintenance (but now MUST use MBASIC editor).
  46. 191 '  MAGIC$ added for SYSOP password . Password no longer echoed for
  47. 192 '  more secure remote use. SUMMARY check for new callers
  48. 193 '  too. Numerous other small changes. Version to 2.7A (for Australia)
  49. 194 ' --------------------------------------------------------
  50. 195 '  Twit log out changed. Twits are written out to LASTCALR with
  51. 196 '  TW tag. Then logged out through EXITRBBS for consistancy. Note
  52. 197 '  that EXITRBBS and RBBSUTIL have been simultaneously updated to
  53. 198 '  make use of this TW status in LASTCALR. ST$ reset if something was
  54. 199 '  misspelled in name log to stop redundant info getting into CALLERS
  55. 200 '  If comma entered between town and state it is changed to a period
  56. 201 '  to make life easier for EXITRBBS. RESET statemnet added at
  57. 202 '  start to allow for changes to disk between calls without having
  58. 203 '  to cold boot. Version to 2.7D, Bill Bolton
  59. 204 '----------------------------------------------------------------------
  60. 210 '  10/Apr/81 additions: another PWD step for SYSOP to go
  61. 215 '     thru, to discourage villians...
  62. 220 '  11/Apr/81: Change "SYSOP" to another word, to ditto..
  63. 225 '    (see lines 600-610)
  64. 230 '  02/May/81: add Y/N for skipping BULLETIN
  65. 240 '  09/May/81: add routine for reading special user messages (=SPECIAL) 
  66. 245 '  20/Jun/81: add putting P$ (SP or RG) into LASTCALR so user 
  67. 246 '    privilege status can be passed to MINIRBBS
  68. 250 '  08/Aug/81: change special user introduction
  69. 255 '  18/Aug/81: insert Bill Earnest's routines for counting
  70. 260 '    callers & putting times in USERS, CALLERS, & LASTCALR
  71. 265 '  01/Sep/81: add Brian Kantor's CHAIN MINIRBBS & system user quiz
  72. 270 '  07/Sep/81: drop re-caller straight to CP/M
  73. 275 '  09/Sep/81: CALL TIMEX added (Dummy routine compiled with M80 and
  74. 280 '     linked to the BASCOMed pgm with L80, calling an ASM
  75. 285 '        pgm above CP/M for reading the MH clock; other clocks
  76. 286 '        can probably be handled with direct port reads)
  77. 287 '  19/Sep/81: Give special (SP) users a command menu 
  78. 288 '  10/Sep/81: Improve twit sign-out; POKE reset bits for PMMI
  79. 289 '  27/Sep/81: Add Hank Szyszka's time interval stuff.
  80. 290 '  9/Oct/81: Add 3rd user category, NW, without direct MINIRBBS access
  81. 291 '  10/Oct/81: And add cp/m knowledge test at 390 & 32000
  82. 292 '  24/Oct/81: Limited command menu for RG users too.
  83. 293 '  01/Jun/82: Numerous Aussie changes, see above
  84. 294 '  15/Jun/82: Twit logout changed, see above.
  85. 297 '---------------------------------------------------------------------
  86. 298 ' NOTE that user privilege status is read from the USERS file, where
  87. 299 ' the following characters are inserted (with an editor) in the first
  88. 300 ' space of the line:  * = 'Twit',  + = 'Special User',  - = 'Regular
  89. 301 ' User', and (space) = 'New User'
  90. 302 ' NOTE ALSO that the code for other clocks made to run with this program
  91. 303 ' will be welcomed.  Use similar line #s if you can but separate the
  92. 304 ' relevant lines and call the result RBBTIME1.BAS, RBBTIME2.BAS, etc.
  93. 305 '----------------------------------------------------------------------
  94. 306 ' Howard Booker's suggested additions at 13030 were removed as they
  95. 307 ' didn't work and even when corrected were no better than the INKEY$
  96. 308 ' when running under BYE. Bill Bolton
  97. 309 '----------------------------------------------------------------------
  98. 310    POKE 0,&HCD '<-- Change "JMP" to "CALL" to prevent Ctl-C
  99. 315    VERS$ = "2.7F"    '<---- Current version number
  100. 320    DEFINT A-Z
  101. 325    MODEMPORT=&H5C:
  102.     CONSOLEPORT=&H4
  103. 330    DIM A$(17),M(200,2),H(6),HT(6),HD(6),TOD(5),DOY(5)
  104. 335    RESET        '<----- In case disk was changed between calls
  105. 340    INC=1
  106. 350    ON ERROR GOTO 15000
  107. 355    XX=0:
  108.     YY=0
  109. 358    MAGIC$="SUPER"    'The magic sysop pasword
  110. 360    'TIMEX=&HE800  -disabled Call to MHTIME.COM; unnecessary for most non-MH
  111. 365    'CALL TIMEX     clocks, but you'll have have to modify 14000- & 44000-.
  112. 370     '    
  113. 372    GOSUB 14000:
  114.     GOSUB 14200   'Set time counters (HK routine)
  115. 374    HT(1)=H(1):
  116.     HT(2)=H(2):
  117.     HT(3)=H(3):
  118.     HT(4)=H(4):
  119.     HT(5)=H(5):
  120.     HT(6)=H(6)
  121. 376    M=74:
  122.     FOR I=1 TO 6:
  123.         POKE M,HT(I):
  124.         M=M+1:
  125.     NEXT I   'Save the time in lo memory
  126. 379    '
  127. 380    '  Signon Functions...
  128. 381    '
  129. 385    PRINT:
  130.     PRINT "Version ";VERS$
  131. 390    GOSUB 32000    'CP/M familiarity test
  132. 400    MSGS=1:
  133.     CALLS=MSGS+1:
  134.     MNUM=CALLS+1
  135. 425    BK=0
  136. 430    OPEN "I",1,"A:P"+CHR$(&HD7)+"DS. "+CHR$(&HA0):
  137.     IF EOF(1) THEN
  138.         450  '<-- Password file
  139. 440    INPUT #1,P1$,P2$   'use editor to make the file. e.g.: BANANA,APPLE,COW
  140. 450    CLOSE #1
  141. 460    BEL=-1:
  142.     XPR=0      ' (initial bell on, not expert)
  143. 470    GOSUB 13020
  144. 480    SAV$=""
  145. 510    OPEN "I",1,"A:LASTCALR":
  146.     INPUT #1,Y$,Z$:
  147.     CLOSE
  148. 530    GOSUB 4050:
  149.     GOSUB 13020   ' Print WELCOME File
  150. 540    BK=0:
  151.     A$="(Prompting bell means system is ready for input).":
  152.     GOSUB 13020:
  153.     GOSUB 13020:
  154.     XX=0
  155. 550    A$="What is your FIRST name ?":
  156.     GOSUB 13020:
  157.     C=1:
  158.     GOSUB 13260:
  159.     C=0:
  160.     N$=B$:
  161.     IF N$="" THEN
  162.         550
  163. 570    IF N$<"A" OR LEN(N$)=1 THEN 
  164.         550
  165. 580    A1$="What is your LAST name ?":
  166.     GOSUB 13020:
  167.     C=1:
  168.     GOSUB 13260:
  169.     C=0:
  170.     O$=B$:
  171.     IF O$="" THEN 
  172.         550
  173. 590    IF O$<"A" OR LEN(O$)=1 THEN 
  174.         550
  175. 591 '
  176. 592 ' Note that the XXXXX below should be replaced with a codeword of your own.
  177. 593 ' It gets passed thru LASTCALR to MINIRBBS, which replaces it with "SYSOP",
  178. 594 ' a paranoid precaution which could probably be dispensed with....
  179. 595 '
  180. 598    IF N$<>MAGIC$ THEN 
  181.         610  
  182. 600    IF N$=MAGIC$ AND O$<>P1$ THEN 
  183.         XX=XX+1:
  184.         IF XX=3 THEN 
  185.             18100 
  186.         ELSE 
  187.             550
  188. 605    IF N$=MAGIC$ AND O$=P1$ THEN 
  189.         O$="":
  190.         A1$="2nd codeword?":
  191.         GOSUB 13020:
  192.         C=1:
  193.         B$=INPUT$(8):
  194.         GOSUB 13420:
  195.         C=0:
  196.         X$=B$:
  197.         PRINT:
  198.         IF INSTR(X$,P2$) THEN 
  199.             730
  200.         ELSE 
  201.             550
  202. 610    IF INSTR(N$,"SYSOP") THEN 
  203.         PRINT:
  204.         PRINT "You know you're not the SYSOP!!!":
  205.         PRINT:
  206.         XX=XX+1:
  207.         IF XX=3 THEN 
  208.             18100 
  209.         ELSE 
  210.             550   ' pseudo-SYSOP gets logged off on 3rd try
  211. 612 '
  212. 620    A$="Checking user file...":
  213.     GOSUB 13020:
  214.     V=0:
  215.     OPEN "R",1,"A:U"+CHR$(&HD3)+"ERS. "+CHR$(&HA0),62:
  216.     FIELD#1,50 AS RZ$,4 AS NC$,6 AS DT$:
  217.     GET#1,1:
  218.     NU=VAL(RZ$)
  219. 625    FIELD #1,62 AS RR$
  220. 630    FOR I=2 TO NU+1:
  221.         GET#1,I:
  222.         IF INSTR(RZ$,N$)>0 AND INSTR(RZ$,O$)>0 THEN 
  223.             MF$=LEFT$(RZ$,1):
  224.             GOSUB 15990:
  225.             PUT#1,I:
  226.             CLOSE:
  227.             GOSUB 13020:
  228.             XX=1:
  229.             GOTO 700
  230. 640    NEXT I   ' If recognized, caller is passed to CALLER-logging routine
  231. 649    ' But a caller not in the USER file gets quizzed further...
  232. 650    V=1:
  233.     A1$="Where (Suburb/Town AND State) are you calling from ?":
  234.     GOSUB 13020:
  235.     C=1:
  236.     GOSUB 13260:
  237.     C=0:
  238.     ST$=B$:
  239.     IF ST$="" THEN 
  240.         580
  241. 655    POINTER = INSTR(ST$,","):
  242.     IF POINTER THEN
  243.         MID$(ST$,POINTER,1) = "."
  244. 660    A$="Hello "+N$+" "+O$+" from "+ST$:
  245.     GOSUB 13020
  246. 662    A1$="Is any of this misspelled ?":
  247.     GOSUB 13020:
  248.     C=1:
  249.     GOSUB 13260:
  250.     C=0
  251. 665    IF LEFT$(B$,1)="Y" THEN 
  252.         N$ = "":
  253.         O$ = "":
  254.         ST$ = "":
  255.         GOTO 550
  256. 667    IF LEFT$(B$,1)<>"N" THEN 
  257.         662
  258. 670    PRINT:
  259.     A1$="This checking is only done the first time you call.":
  260.     GOSUB 13020:
  261.     LSET NC$=MKI$(0)
  262. 680    LSET RZ$="  "+N$+" "+O$+" "+ST$+SPACE$(44):
  263.     GOSUB 15990:
  264.     NU=NU+1:
  265.     PUT#1,NU+1:
  266.     S$=STR$(NU):
  267.     GOSUB 16000:
  268.     PUT#1,1:
  269.     CLOSE
  270. 690    FIL$="NEWCOM":
  271.     GOSUB 18000:
  272.     MF$=" "   '...and made to read the NEWCOMer file
  273. 695    PRINT
  274. 700    GOSUB 14200    '  Now everybody gets logged to CALLERS
  275. 705    A$="Logging "+N$+" "+O$+" to disk...":
  276.     N=1:
  277.     GOSUB 13020:
  278.     OPEN "R",1,"A:C"+CHR$(&HC1)+"LLERS. "+CHR$(&HA0),60:
  279.     FIELD#1,60 AS RR$:
  280.     GET#1,1
  281. 710    RE=VAL(RR$)+1:
  282.     S$=STR$(RE):
  283.     RL=60:
  284.     GOSUB 16000:
  285.     PUT#1,1:
  286.     RE=RE+1
  287. 715    S$=N$+" "+O$+" "+ST$+" "+TI$:
  288.     GOSUB 16000:
  289.     PUT#1,RE:
  290.     CLOSE#1
  291. 720    '  Recallers (who are not "twits") go straight to CP/M
  292. 723    IF N$=Y$ AND O$=Z$ AND MF$ <> "*" THEN 
  293.         GOSUB 13020:
  294.         A$="Welcome back.  Since you just signed off, go straight to CP/M":
  295.         GOSUB 13020:
  296.         GOTO 2240
  297. 724    '
  298. 725    '  User privilege level (from USERS) & date (DT$) is added to LASTCALR...
  299. 726    IF MF$="*" THEN
  300.         F$="TW"
  301. 727    IF MF$="+" THEN 
  302.         F$="SP"
  303. 728    IF MF$=" " THEN 
  304.         F$="NW"
  305. 729    IF MF$="-" THEN 
  306.         F$="RG"
  307. 730    OPEN "O",1,"A:L"+CHR$(&HC1)+"STCALR. "+CHR$(&HA0):
  308.     PRINT #1,N$;",";O$;",";F$;",";DZ$:
  309.     IF N$=MAGIC$ THEN 
  310.         2240
  311. 735    CLOSE
  312. 736    ' Now log out the twits through exit routines
  313. 737    IF MF$="*" THEN
  314.         PRINT:
  315.         PRINT:
  316.         PRINT "You have lost access privileges to this system":
  317.         PRINT:
  318.         CHAIN "BYE"
  319. 740    BK=0:
  320.     GOSUB 13020:
  321.     OPEN "R",1,"A:C"+CHR$(&HCF)+"UNTERS. "+CHR$(&HA0),5:
  322.     FIELD#1,5 AS RR$
  323. 750    PRINT
  324. 760    A$="You are caller # : ":
  325.     N=1:
  326.     GOSUB 13020:
  327.     GET#1,CALLS
  328. 770    CN=VAL(RR$)+INC:
  329.     A$=STR$(CN):
  330.     LSET RR$=A$:
  331.     GOSUB 13020:
  332.     PUT#1,CALLS
  333. 790    CLOSE:
  334.     GOSUB 13020
  335. 792    'And now the user gets to choose whether to answer the survey at 35000,
  336. 793    IF XX=0 THEN 
  337.         GOSUB 35000:
  338.         GOTO 800   'except that new users have no choice
  339. 795    A1$="Have you answered the user survey questions yet?":
  340.     GOSUB 13020:
  341.     C=1:
  342.     GOSUB 13260:
  343.     C=0
  344. 798    IF LEFT$(B$,1)="N" THEN 
  345.         GOSUB 35000
  346. 799    '
  347. 800    ' The SUMMARY file is now checked for messages to all except new users
  348. 830    '
  349. 835    A1$="Wait a second while I check to see if you have messages waiting ...":
  350.     GOSUB 13020:
  351.     GOSUB 13020
  352. 838    L=0
  353. 840    FT=1:
  354.     MX=0:
  355.     MZ=0:
  356.     IU=0:     ' (Flag first time for printing heading)
  357. 850    OPEN "R",1,"A:S"+CHR$(&HD5)+"MMARY. "+CHR$(&HA0),30:
  358.     RE=1:
  359.     FIELD#1,28 AS RR$
  360. 860    BK=0:
  361.     GET#1,RE:
  362.     IF EOF(1) THEN 
  363.         960
  364. 870    G=VAL(RR$):
  365.     MZ=MZ+1:
  366.     M(MZ,1)=G:
  367.     IF G=0 THEN 
  368.         950
  369. 880    IF IU=0 THEN 
  370.         IU=G
  371. 890    IF G>9998 THEN 
  372.         MZ=MZ-1:
  373.         GOTO 960
  374. 900    GET#1,RE+3:
  375.     GOSUB 16500:
  376.     IF INSTR(S$,N$)>0 AND INSTR(S$,O$)>0 THEN 
  377.         930
  378. 910    IF N$<>MAGIC$ THEN 
  379.         950  
  380. 920    IF INSTR(S$,"BILL")=0 THEN 
  381.         950
  382. 930    IF FT THEN 
  383.         L=L+1
  384. 931    IF FT THEN 
  385.         A$="The following messages for "+N$+" "+O$+" are waiting in MINIRBBS: ":
  386.         GOSUB 13020:
  387.         FT=0
  388. 940    A$=STR$(G):
  389.     N=1:
  390.     GOSUB 13020:
  391.     GOSUB 13020
  392. 950    GET#1,RE+5:
  393.     M(MZ,2)=VAL(RR$):
  394.     MX=MX+M(MZ,2)+6:
  395.     RE=RE+6:
  396.     GOTO 860
  397. 960    IF L=0 THEN 
  398.         PRINT "Nope.  No message addressed to you, "+N$+".":
  399.         PRINT "But check MINIRBBS anyway for public messages.":
  400.         GOSUB 13020
  401. 965    CLOSE
  402. 2000 '
  403. 2020 '  Everyone comes here, to get ready to go to CP/M
  404. 2040 '
  405. 2045    GOSUB 4070    'Everyone sees the DATA file before menus
  406. 2046 '
  407. 2049 '  They get menus according to their status....
  408. 2050 '
  409. 2051    IF MF$<>"+" THEN 
  410.         2100
  411. 2052    GOSUB 13020:
  412.     A$="As a special user, you have the following options:":
  413.     GOSUB 13020:
  414.     GOSUB 13020
  415. 2053    A$=" CON  Read CONFIDENTIAL msgs    MIN  Go to MINIRBBS":
  416.     GOSUB 13020
  417. 2054    A$=" NEW  Latest program data       CPM  Go straight to CP/M":
  418.     GOSUB 13020
  419. 2055    A$=" OFF  Log Off immediately":
  420.     GOSUB 13020
  421. 2056    GOSUB 13020:
  422.     A1$="Which ?":
  423.     GOSUB 13020:
  424.     C=1:
  425.     GOSUB 13260:
  426.     C=0
  427. 2060    IF B$="CON" THEN 
  428.         4100   'the SPECIAL file
  429. 2065    IF B$="MIN" THEN 
  430.         CHAIN "MINIRBBS"  'to the message module
  431. 2070    IF B$="NEW" THEN 
  432.         2220   'the BULLETIN file
  433. 2075    IF B$="CPM" THEN 
  434.         2230   'the DATA file, then CP/M
  435. 2076    IF B$="OFF" THEN 
  436.         CHAIN "BYE"  'straight to log-off module
  437. 2080    GOTO 2056
  438. 2099    '
  439. 2100    IF MF$=" " THEN 
  440.         2200    ' Note that new callers don't get a menu
  441. 2110    GOSUB 13020:
  442.     A$="Now you can do one of the following:":
  443.     GOSUB 13020:
  444.     GOSUB 13020
  445. 2120    A$=" NEW  Latest program data        CPM  Go straight to CP/M":
  446.     GOSUB 13020
  447. 2125    A$=" MIN  Go to message subsystem    OFF  Log Off immediately":
  448.     GOSUB 13020
  449. 2130    GOSUB 13020:
  450.     A1$="Which do you want ?":
  451.     GOSUB 13020:
  452.     C=1:
  453.     GOSUB 13260:
  454.     C=0
  455. 2135    IF B$="MIN" THEN 
  456.         CHAIN "MINIRBBS"
  457. 2140    IF B$="NEW" THEN 
  458.         2220    ' RG callers can do everything SP callers can
  459. 2145    IF B$="CPM" THEN 
  460.         2230    ' except read the SPECIAL file
  461. 2150    IF B$="OFF" THEN 
  462.         CHAIN "BYE"
  463. 2160    GOTO 2130
  464. 2170 '
  465. 2197 ' To discourage new callers from thinking this is a bulletin board system,
  466. 2198 ' this is the only choice they get
  467. 2199 '
  468. 2200    GOSUB 13020:
  469.     A1$="Want data on the latest programs before entering CP/M?":
  470.     GOSUB 13020:
  471.     C=1:
  472.     GOSUB 13260:
  473.     C=0
  474. 2210    IF LEFT$(B$,1)="N" THEN 
  475.         2230
  476. 2215    IF LEFT$(B$,1)<>"Y" THEN 
  477.         2200
  478. 2220    GOSUB 3040 ' Print BULLETIN file
  479. 2225    IF MF$="+" THEN 
  480.         2052
  481. 2226    IF MF$="-" THEN 
  482.         2110
  483. 2230 '            Used to be DATA file read, moved to 2045
  484. 2235    CLOSE ' (just in case any files are still open)
  485. 2237    GOTO 44620  ' Then to the time-on-system routine, and then...
  486. 2240    GOSUB 13020:
  487.     POKE 4,0:
  488.     A$="Entering CP/M...":
  489.     GOSUB 13020
  490. 2260    POKE 0,&HC3:
  491.     SYSTEM ' we restore the "JMP" and go to CP/M.
  492. 3000 '
  493. 3010 ' The main program has now ended.  It's just subroutines from here on
  494. 3015 '
  495. 3020 ' The display BULLETIN file subroutine
  496. 3040 '
  497. 3050    PRINT:
  498.     GOSUB 13000
  499. 3060    GOSUB 12220
  500. 3080    FIL$="BULLETIN":
  501.     GOSUB 18000:
  502.     PRINT:
  503.     RETURN
  504. 4000 '
  505. 4020 ' The display WELCOME file subroutine
  506. 4030 '
  507. 4050    GOSUB 12220
  508. 4060    FIL$="WELCOME":
  509.     GOSUB 18000:
  510.     RETURN
  511. 4065 '
  512. 4070 ' The display DATA file subroutine*
  513. 4075 '
  514. 4080    GOSUB 12220
  515. 4090    FIL$="DATA":
  516.     GOSUB 18000:
  517.     RETURN
  518. 4095 '
  519. 4100 ' The display SPECIAL file subroutine*
  520. 4120 '
  521. 4140    GOSUB 12220
  522. 4160    FIL$="SPECIAL":
  523.     GOSUB 18000:
  524.     GOTO 2052
  525. 5000 '
  526. 12220    RETURN
  527. 12999 '
  528. 13000    A$="Use ctl-K to abort, ctl-S to pause."
  529. 13020 '
  530. 13040 ' Routine to print string from A$ on console
  531. 13060 '
  532. 13080    IF SAV$<>"" AND A1$<>"" THEN 
  533.         A1$="":
  534.         RETURN
  535. 13100    IF A1$<>"" THEN 
  536.         A$=A1$:
  537.         A1$=""
  538. 13120    IF RIGHT$(A$,1)="?" OR N=1 THEN 
  539.         PRINT A$;:
  540.         PP$=A$:
  541.         GOTO 13180
  542. 13140    BI=ASC(INKEY$+" "):
  543.     IF BI=19 THEN 
  544.         BI=ASC(INPUT$(1))
  545. 13160    IF BI=11 THEN 
  546.         BK=-1:
  547.         GOTO 13220 
  548.     ELSE 
  549.         PRINT A$
  550. 13180    A=A+LEN(A$)
  551. 13220    A$="":
  552.     N=0
  553. 13240    RETURN
  554. 13260 '
  555. 13280 ' Routine to accept string into B$ from console
  556. 13300 '
  557. 13320    IF BEL AND SAV$="" THEN 
  558.         PRINT CHR$(7);
  559. 13340    B$="":
  560.     BK=0
  561. 13360    IF SAV$="" THEN 
  562.         LINE INPUT SAV$
  563. 13380    SP=INSTR(SAV$,";"):
  564.     IF SP=0 THEN 
  565.         B$=SAV$:
  566.         SAV$="":
  567.         GOTO 13420
  568. 13400    B$=LEFT$(SAV$,SP-1):
  569.     SAV$=MID$(SAV$,SP+1)
  570. 13420    IF LEN(B$)=0 THEN 
  571.         RETURN
  572. 13440    IF C=0 THEN 
  573.         13480
  574. 13460    FOR ZZ=1 TO LEN(B$):
  575.         MID$(B$,ZZ,1)=CHR$(ASC(MID$(B$,ZZ,1))+32*(ASC(MID$(B$,ZZ,1))>96)):
  576.     NEXT ZZ
  577. 13480    IF LEN(B$)<63 THEN 
  578.         13580
  579. 13500    A$="Input line too long - would be truncated to:":
  580.     GOSUB 13020
  581. 13520    B$=LEFT$(B$,62):
  582.     PRINT B$
  583. 13540    LINE INPUT "Retype line (Y/N)?";QQ$:
  584.     GOSUB 35600:
  585.     QQ$=LEFT$(QQ$,1)
  586. 13560    IF QQ$="Y" OR QQ$="y" THEN 
  587.         PRINT PP$;:
  588.         SAV$="":
  589.         GOTO 13260
  590. 13580    D=D+LEN(B$):
  591.     RETURN
  592. 13600    RETURN
  593. 13620 '
  594. 14000 ' Date getting subroutine
  595. 14010    BASEPORT = &H50
  596. 14013    CMDPORT = BASEPORT + 10
  597. 14016    DATAPORT = CMDPORT + 1
  598. 14019 '**********************************************************
  599. 14022 '*        READ THE DATE DIGITS            *
  600. 14025 '**********************************************************
  601. 14028    FOR DIGIT = 12 TO 7 STEP -1
  602. 14031        OUT CMDPORT,(&H10 + DIGIT)
  603. 14034        DOY(DIGIT - 7) = INP(DATAPORT)
  604. 14037    NEXT DIGIT
  605. 14040    YEAR= (DOY(5) * 10) + DOY(4)
  606. 14043    MONTH10 = DOY(3)
  607. 14046    MONTH1  = DOY(2)
  608. 14049    DAY10 = DOY(1)
  609. 14052    DAY1  = DOY(0)
  610. 14055 '**********************************************************
  611. 14058 '*        FORMAT THE FIRST DATE STRING        *
  612. 14061 '**********************************************************
  613. 14064    DATE1$="        "
  614. 14067    MID$(DATE1$,1,1) = RIGHT$(STR$(DAY10),1)
  615. 14070    MID$(DATE1$,2,1) = RIGHT$(STR$(DAY1),1)
  616. 14073    MID$(DATE1$,3,1) = "/"
  617. 14076    MID$(DATE1$,4,1) = RIGHT$(STR$(MONTH10),1)
  618. 14079    MID$(DATE1$,5,1) = RIGHT$(STR$(MONTH1),1)
  619. 14082    MID$(DATE1$,6,1) = "/"
  620. 14085    MID$(DATE1$,7,2) = RIGHT$(STR$(YEAR),2)
  621. 14088    DZ$ = DATE1$
  622. 14091    DT$ = LEFT$(DATE1$,5)
  623. 14093    DD$ = MID$(DATE1$,1,2)
  624. 14095    DM$ = MID$(DATE1$,4,2)
  625. 14100    RETURN
  626. 14190 '
  627. 14200 ' Time-finding subroutine
  628. 14205    FOR DIGIT = 5 TO 0 STEP -1
  629. 14210        OUT CMDPORT,(&H10 + DIGIT)
  630. 14215        TOD(DIGIT) = INP(DATAPORT)
  631. 14220        IF DIGIT = 5 THEN TOD(DIGIT) = TOD(DIGIT) AND 3
  632. 14225    NEXT DIGIT
  633. 14230    H(1) = TOD(5)
  634. 14235    H(2) = TOD(4)
  635. 14240    H(3) = TOD(3)
  636. 14245    H(4) = TOD(2)
  637. 14250    H(5) = TOD(1)
  638. 14255    H(6) = TOD(0)
  639. 14260    DH$ = "  ":
  640.     DI$ = "  ":
  641.     DS$ = "  "
  642. 14265    MID$(DH$,1,1) = RIGHT$(STR$(H(1)),1):
  643.     MID$(DH$,2,1) = RIGHT$(STR$(H(2)),1):
  644.     MID$(DI$,1,1) = RIGHT$(STR$(H(3)),1):
  645.     MID$(DI$,2,1) = RIGHT$(STR$(H(4)),1):
  646.     MID$(DS$,1,1) = RIGHT$(STR$(H(5)),1):
  647.     MID$(DS$,2,1) = RIGHT$(STR$(H(6)),1)
  648. 14280    TI$=DD$+"-"+DH$+":"+DI$
  649. 14285    TD$=DH$+":"+DI$+":"+DS$
  650. 14290    RETURN
  651. 14999 '
  652. 15000 ' The ON-ERROR handler...
  653. 15001 '
  654. 15020    IF ERL=18030 THEN 
  655.         RESUME 18050
  656. 15030    IF ERL=700 THEN 
  657.         RE=0:
  658.         RESUME 710
  659. 15100    RESUME NEXT
  660. 15887 '
  661. 15888 ' Small routine for writing date, etc., to USERS file (see lines 630 & 680))
  662. 15889 '
  663. 15990    S$=LEFT$(RZ$,50)+RIGHT$("   "+STR$(VAL(NC$)+1),4)+" "+RIGHT$("0"+DD$,2)
  664. 15992    S$=S$+"/"+RIGHT$("0"+DM$,2):RL=62   ' (now fall thru...).
  665. 16000 '
  666. 16010 ' Fill and store disk record...
  667. 16020 '
  668. 16030    LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
  669. 16040    RETURN
  670. 16500 '
  671. 16510 ' Unpack disk record...
  672. 16520 '
  673. 16530    ZZ=LEN(RR$)-2
  674. 16540    WHILE MID$(RR$,ZZ,1)=" "
  675. 16550        ZZ=ZZ-1:
  676.         IF ZZ=1 THEN 
  677.             16570
  678. 16560    WEND
  679. 16570    S$=LEFT$(RR$,ZZ)
  680. 16580    IF MID$(S$,ZZ,1)="?" THEN S$=S$+" "
  681. 16590    RETURN
  682. 17000 '
  683. 17010 ' Toggle expert user mode
  684. 17020 '
  685. 17030 ' XPR=NOT XPR:RETURN  (inactivated here but kept for future use)
  686. 17040 '
  687. 17050 ' Toggle bell prompt
  688. 17060 '
  689. 17070 ' BEL=NOT BEL:RETURN  (ditto)
  690. 18000 '
  691. 18010 ' Subroutine to print a file
  692. 18020 '
  693. 18030    OPEN "I",1,"A:"+FIL$:
  694.     BK=0
  695. 18040    IF EOF(1) OR BK THEN 
  696.         18050 
  697.     ELSE 
  698.         LINE INPUT #1,A$:
  699.         GOSUB 13020:
  700.         GOTO 18040
  701. 18050    CLOSE #1:
  702.     RETURN
  703. 18060 '
  704. 18070 '
  705. 18080 ' Subroutine to log off an unwanted caller (=twit)
  706. 18090 '
  707. 18100 '
  708. 18110    'POKE 0,&HC3    '<-----Restore "Jump" at BASE for CP/M (doesn't
  709.              really matter if this isn't done if you use BYE
  710.              to load this program
  711. 18120    RUN "A:SUPER.COM" 'Neatest log off is through BYE
  712. 18140    END
  713. 19000 '  
  714. 32000 '  The CP/M familiarity testing routine  (feel free to make changes)
  715. 32001 '
  716. 32010    XX=0
  717. 32020    GOSUB 13020:
  718.     A1$="What is the name of Digital Research's standard debugger?":
  719.     GOSUB 13020:
  720.     C=1:
  721.     GOSUB 13260:
  722.     C=0
  723. 32040    IF INSTR(B$,"DDT") THEN 
  724.         32400
  725. 32050    IF INSTR(B$,"ddt") THEN 
  726.         32400
  727. 32055    IF INSTR(B$,"SID") THEN
  728.         PRINT "Not ";B$;", try the other one...":
  729.         GOTO 32020
  730. 32060    XX=XX+1:
  731.      IF XX=3 THEN 
  732.         18080   ' Log the caller off...
  733. 32070    IF XX=1 THEN
  734.         PRINT "You only get 3 tries...":
  735.         GOTO 32020
  736. 32080    IF XX=2 THEN
  737.         PRINT "One last try...":
  738.         GOTO 32020
  739. 32400    RETURN
  740. 32499 '
  741. 35000 '   BK's system user survey module  (again, make changes)
  742. 35001 '
  743. 35002    PRINT:
  744.     PRINT "     ***   SYSTEM USER SURVEY  ***"
  745. 35005    OPEN "R",1,"A:S"+CHR$(&HD5)+"RVEY.B"+CHR$(&HC2)+"S",40:
  746.     FIELD#1,40 AS RR$:
  747.     GET#1,1
  748. 35006    RE=VAL(RR$)+1
  749. 35007    IF RE=1 THEN 
  750.         RE=2
  751. 35008    S$=N$+" "+O$+" "+DZ$
  752. 35009    GOSUB 35200
  753. 35010    GOSUB 13020:
  754.     GOSUB 13020:
  755.     A$="Skip questions you don't feel like answering.  But more data"
  756. 35020    GOSUB 13020:
  757.     A$="about your system will help make this system better":
  758.     GOSUB 13020
  759. 35025    PRINT:
  760.     PRINT "(Keep each answer to 34 chars. max.)"
  761. 35026    PRINT "(There are 8 questions in all)":
  762.     PRINT
  763. 35030    PRINT "What kind of computer (or terminal) are you using? (S-100, Apple,"
  764. 35035    PRINT "  TRS-80, etc.; if S-100, which controller & CPU card?":
  765.     GOSUB 35600:
  766.     Q$=" 1":
  767.     GOSUB 35100
  768. 35040    PRINT "With which operating systems? (CP/M 1.4?  CP/M 2.x?  TRS-DOS?"
  769. 35045    PRINT "  PASCAL?  More than one?)":
  770.     GOSUB 35600:
  771.     Q$=" 2":
  772.     GOSUB 35100
  773. 35050    PRINT "How about the modem?  What brand & baud rate(s)?":
  774.     GOSUB 35600:
  775.     Q$=" 3":
  776.     GOSUB 35100
  777. 35060    PRINT "Where did you learn of this system":
  778.     PRINT " (If a BBS, which one)? ":
  779.     GOSUB 35600:
  780.     Q$=" 4":
  781.     GOSUB 35100
  782. 35070    PRINT "Do you work with computers professionally?  Which kind?":
  783.     GOSUB 35600:
  784.     Q$=" 5":
  785.     GOSUB 35100
  786. 35080    PRINT "How long have you been involved with microcomputers?":
  787.     GOSUB 35600:
  788.     Q$=" 6":
  789.     GOSUB 35100
  790. 35085    PRINT "If you write your own programs, which languages do you usually use?":
  791.     GOSUB 35600:
  792.     Q$=" 7":
  793.     GOSUB 35100
  794. 35090    PRINT "Are you interested in 16-bit CPUs or other"
  795. 35091    PRINT "  leading-edge equipment & software?  Which?":
  796.     GOSUB 35600:
  797.     Q$=" 8":
  798.     GOSUB 35100
  799. 35092    PRINT "If you'd care to give details, leave a msg in MINIRBBS"
  800. 35094    S$=STR$(RE)
  801. 35095    GOSUB 16000
  802. 35096    PUT#1,1
  803. 35097    CLOSE
  804. 35098    PRINT:
  805.     PRINT "Thanks for the information.  Now back to the log-in routine...":
  806.     PRINT:
  807.     RETURN
  808. 35100 ' PUT IN FILE
  809. 35120    GOSUB 13280:
  810.     IF B$="" THEN 
  811.         S$="<omitted>" 
  812.     ELSE 
  813.         S$=B$
  814. 35140    S$=Q$+": "+S$
  815. 35200    RL=40
  816. 35220    GOSUB 16000
  817. 35240    PUT#1,RE
  818. 35260    RE=RE+1
  819. 35280    RETURN
  820. 35600    PRINT "----------------------------------|"
  821. 35620    RETURN
  822. 44620 '  Routines for printing the time & time-on-system 
  823. 44625 '   (for MH clock, but adaptable for other clocks)
  824. 44630 '    a. Print just time
  825. 44640    GOSUB 14200  
  826. 44650    PRINT "The time now is (Hrs:Mins:Secs).... "TD$
  827. 44659 '    b. Print elapsed time too
  828. 44660    GOSUB 44940
  829. 44670    GOTO 2240
  830. 44830 '    (calculate the time difference...)
  831. 44840    IF H(6)<HT(6) THEN 
  832.         H(6)=H(6)+10:
  833.         H(5)=H(5)-1
  834. 44850    IF H(5)<HT(5) THEN 
  835.         H(5)=H(5)+6:
  836.         H(4)=H(4)-1
  837. 44860    IF H(4)<HT(4) THEN 
  838.         H(4)=H(4)+10:
  839.         H(3)=H(3)-1
  840. 44870    IF H(3)<HT(3) THEN 
  841.         H(3)=H(3)+6:
  842.         H(2)=H(2)-1
  843. 44880    IF H(2)<HT(2) THEN 
  844.         H(2)=H(2)+10:
  845.         H(1)=H(1)-1
  846. 44890    HD(6)=H(6)-HT(6):
  847.     HD(5)=H(5)-HT(5):
  848.     HD(4)=H(4)-HT(4)
  849. 44900    HD(3)=H(3)-HT(3):
  850.     HD(2)=H(2)-HT(2):
  851.     HD(1)=H(1)-HT(1)
  852. 44910    RETURN
  853. 44920    INPUT "TIME= H,H,M,M,S,S ";HT(1),HT(2),HT(3),HT(4),HT(5),HT(6)
  854. 44930    INPUT "LATER TIME H,H,M,M,S,S ";H(1),H(2),H(3),H(4),H(5),H(6)
  855. 44940    GOSUB 44830
  856. 44950    PRINT "You've been on the system for...... ";
  857. 44960    TF$="#"
  858. 44970    FOR I=1 TO 6
  859. 44980        PRINT USING TF$;HD(I);
  860. 44990        IF I=2 THEN 
  861.             PRINT ":";
  862. 45000        IF I=4 THEN 
  863.             PRINT ":";
  864. 45010    NEXT I
  865. 45020    PRINT
  866. 45030    RETURN
  867.