home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol060 / entbbs25.asc < prev    next >
Encoding:
Text File  |  1984-04-29  |  7.6 KB  |  188 lines
  1. 5 REM  ------------->> LOGGER - V2.4  3/12/81 <<-------------
  2. 10 REM   XBBS, a front-end subsystem to a Remote CP/M System
  3. 15 REM   from RBBS 2.2 by Bruce R. Ratoff,
  4. 20 REM   as modified by Ben Bronson, 02/22/81
  5. 25 REM  ------------------------------------------------------
  6. 30 REM   Revised with corrections from RBBS v2.4  3/03/81
  7. 35 REM   by Tim Nicholas
  8. 40 REM  ------------------------------------------------------
  9. 45 REM     Added test for "*" in CALLERS file (from RBBS) and
  10. 50 REM     if CALLERS file finds "*" in beginning of caller's
  11. 55 REM     name, it will not allow him system access, and log
  12. 60 REM     him off immediately. (For those who persist in log-
  13. 65 REM     ging in with fictitious names, e.g. BUG BYTE). Also
  14. 70 REM     added "PWDS" file (from RBBS) for "P2$" only. So
  15. 75 REM     Sysop can get msgs for "SYSOP" or his name.
  16. 80 REM     by Tim Nicholas  3/05/81
  17. 85 REM    ------------------------------------------------------
  18. 90 REM     Changed sequence of response to question "Did I mis-
  19. 95 REM     anything?", so that a response other than "Y" or "y"
  20. 100 REM     or "N"/"n" will re-ask the question. So in noisy line
  21. 105 REM     conditions it won't automaticaly default to "N"/"n".
  22. 110 REM     Added suggestion by Ben Bronson to move printing of
  23. 115 REM     "BULLETIN" file to after name-taking, and other sign
  24. 120 REM     in procedures.  by Tim Nicholas 3/12/81.
  25. 125 REM    ------------------------------------------------------ 
  26. 130 REM  ** MORE MODIFICATIONS BY BB: 3/14/81 **
  27. 300 REM
  28. 310 POKE 0,&HCD '<-- Change "JMP" to "CALL" to prevent Ctl-C
  29. 320 DEFINT A-Z
  30. 330 DIM A$(17),M(200,2)
  31. 340 INC=1
  32. 350 ON ERROR GOTO 13620
  33. 355 XX=0
  34. 370 REM    
  35. 380 REM ** SIGNON FUNCTIONS
  36. 390 REM
  37. 400 MSGS=1:CALLS=MSGS+1:MNUM=CALLS+1
  38. 410 P2$="BRONSON" 'Default Password for Sysop's last name.
  39. 420 BK=0:GOSUB 13020:N=1:A$="Hyde Park (Chicago) RCPM System..":GOSUB 13020:N=0
  40. 430 OPEN "I",1,"A:PWDS":IF EOF(1) THEN 450 '<-- Password file
  41. 440 INPUT #1,P2$
  42. 450 CLOSE #1
  43. 460 BEL=-1:XPR=0'INITIAL BEL ON, NOT EXPERT
  44. 470 GOSUB 13020
  45. 480 SAV$=""
  46. 530 GOSUB 4080 'Print INFO File
  47. 540 BK=0:A$="(Prompting bell means system is ready for input).":GOSUB 13020:GOSUB 13020
  48. 550 A$="What is your FIRST name ?":GOSUB 13020:C=1:GOSUB 13260:C=0:N$=B$:IF N$="" THEN 550
  49. 570 IF N$<"A" OR LEN(N$)=1 THEN 550
  50. 580 A1$="What is your LAST name ?":GOSUB 13020:C=1:GOSUB 13260:C=0:O$=B$:IF O$="" THEN 550
  51. 590 IF O$<"A" OR LEN(O$)=1 THEN 550
  52. 600 IF N$="SYSOP" AND O$=P2$ THEN O$="":GOTO 700
  53. 610 IF N$="SYSOP" THEN PRINT:PRINT "You know you're not the SYSOP!!!":PRINT:GOTO 550
  54. 620 A$="Checking user file...":GOSUB 13020:V=0:OPEN "R",1,"A:USERS",62:FIELD#1,62 AS RR$:GET#1,1:NU=VAL(RR$)
  55. 630 FOR I=2 TO NU+1:GET#1,I:IF INSTR(RR$,N$)>0 AND INSTR(RR$,O$)>0 THEN MF$=LEFT$(RR$,1):CLOSE:GOSUB 13020:XX=1:GOTO 700
  56. 640 NEXT I
  57. 650 V=1:A1$="Where (City,State) are you calling from ?":GOSUB 13020:C=1:GOSUB 13260:C=0:ST$=B$:IF ST$="" THEN 580
  58. 660 A$="Hello "+N$+" "+O$+" from "+ST$:GOSUB 13020
  59. 662 A1$="Is any of this misspelled ?":GOSUB 13020:C=1:GOSUB 13260:C=0
  60. 665 IF LEFT$(B$,1)="Y" THEN 550
  61. 667 IF LEFT$(B$,1)<>"N" THEN 662
  62. 670 A1$="This checking is only done the first time you call.":GOSUB 13020
  63. 680 S$="  "+N$+" "+O$+" "+ST$:RL=62:GOSUB 16000:NU=NU+1:PUT#1,NU+1:S$=STR$(NU):GOSUB 16000:PUT#1,1:CLOSE
  64. 690 FIL$="NEWCOM":GOSUB 18000:MF$=" "
  65. 700 A$="Logging "+N$+" "+O$+" to disk...":N=1:GOSUB 13020:OPEN "R",1,"A:CALLERS",60:FIELD#1,60 AS RR$:GET#1,1
  66. 710 RE=VAL(RR$)+1:S$=STR$(RE):RL=60:GOSUB 16000:PUT#1,1:RE=RE+1
  67. 720 S$=N$+" "+O$+" "+ST$:GOSUB 16000:PUT#1,RE:CLOSE#1
  68. 730 OPEN "O",1,"A:LASTCALR":PRINT #1,N$;",";O$:CLOSE
  69. 740 BK=0:GOSUB 13020:OPEN "R",1,"A:COUNTERS",5:FIELD#1,5 AS RR$
  70. 750 PRINT
  71. 760 A$="You are caller # : ":N=1:GOSUB 13020:GET#1,CALLS
  72. 770 CN=VAL(RR$)+INC:A$=STR$(CN):LSET RR$=A$:GOSUB 13020:PUT#1,CALLS
  73. 790 CLOSE:GOSUB 13020
  74. 795 IF XX=0 THEN GOTO 2200
  75. 810 REM LOOK FOR MSGS FOR THIS CALLER
  76. 820 REM AND BUILD MESSAGE INDEX
  77. 830 REM
  78. 835 PRINT "Wait a second while I check to see if you have messages waiting ..."
  79. 836 PRINT
  80. 838 L=0
  81. 840 FT=1:MX=0:MZ=0:IU=0:'FLAG FIRST TIME FOR PRINTING HEADING
  82. 850 OPEN "R",1,"A:SUMMARY",30:RE=1:FIELD#1,28 AS RR$
  83. 860 BK=0:GET#1,RE:IF EOF(1) THEN 960
  84. 870 G=VAL(RR$):MZ=MZ+1:M(MZ,1)=G:IF G=0 THEN 950
  85. 880 IF IU=0 THEN IU=G
  86. 890 IF G>9998 THEN MZ=MZ-1:GOTO 960
  87. 900 GET#1,RE+3:GOSUB 16500:IF INSTR(S$,N$)>0 AND INSTR(S$,O$)>0 THEN 930
  88. 910 IF N$<>"SYSOP" THEN 950
  89. 920 IF INSTR(S$,"BEN")=0 THEN 950
  90. 930 IF FT THEN L=L+1
  91. 931 IF FT THEN A$="The following messages for "+N$+" "+O$+" are waiting in MINIRBBS: ":GOSUB 13020:FT=0
  92. 940 A$=STR$(G):N=1:GOSUB 13020:GOSUB 13020
  93. 950 GET#1,RE+5:M(MZ,2)=VAL(RR$):MX=MX+M(MZ,2)+6:RE=RE+6:GOTO 860
  94. 960 IF L=0 THEN PRINT "Nope.  No message addressed to you, "+N$+".":PRINT "But check MINIRBBS anyway for public messages.":GOSUB 13020
  95. 965 CLOSE:GOSUB 13020
  96. 2020 REM ***EXIT TO CP/M***
  97. 2040 REM
  98. 2050 REM .....First test for unwanted callers.....
  99. 2060 IF MF$="*" THEN A$="Sorry, you've lost access to this System,  "+N$+" "+O$:GOSUB 13020:GOSUB 13020:GOTO 18080
  100. 2200 GOSUB 3080 'Print BULLETIN file
  101. 2240 GOSUB 13020:POKE 4,0:A$="Entering CP/M...":GOSUB 13020
  102. 2260 POKE 0,&HC3:SYSTEM '<-- Restore "JMP", return to CP/M.
  103. 3000 REM
  104. 3020 REM ***DISPLAY BULLETINS***
  105. 3040 REM
  106. 3060 GOSUB 12220
  107. 3080 FIL$="BULLETIN":GOSUB 18000:RETURN
  108. 4000 REM
  109. 4020 REM ***DISPLAY WELCOME MESSAGE***
  110. 4040 REM
  111. 4060 GOSUB 12220
  112. 4080 FIL$="INFO":GOSUB 18000:RETURN
  113. 5000 REM
  114. 12220 RETURN
  115. 13000 A$="Use ctl-K to abort, ctl-S to pause."
  116. 13020 REM
  117. 13040 REM ***PRINT STRING FROM A$ ON CONSOLE***
  118. 13060 REM
  119. 13080 IF SAV$<>"" AND A1$<>"" THEN A1$="":RETURN
  120. 13100 IF A1$<>"" THEN A$=A1$:A1$=""
  121. 13120 IF RIGHT$(A$,1)="?" OR N=1 THEN PRINT A$;:PP$=A$:GOTO 13180
  122. 13140 BI=ASC(INKEY$+" "):IF BI=19 THEN BI=ASC(INPUT$(1))
  123. 13160 IF BI=11 THEN BK=-1:GOTO 13220 ELSE PRINT A$
  124. 13180 A=A+LEN(A$)
  125. 13220 A$="":N=0
  126. 13240 RETURN
  127. 13260 REM
  128. 13280 REM ***ACCEPT STRING INTO B$ FROM CONSOLE***
  129. 13300 REM
  130. 13320 IF BEL AND SAV$="" THEN PRINT CHR$(7);
  131. 13340 B$="":BK=0
  132. 13360 IF SAV$="" THEN LINE INPUT SAV$
  133. 13380 SP=INSTR(SAV$,";"):IF SP=0 THEN B$=SAV$:SAV$="":GOTO 13420
  134. 13400 B$=LEFT$(SAV$,SP-1):SAV$=MID$(SAV$,SP+1)
  135. 13420 IF LEN(B$)=0 THEN RETURN
  136. 13440 IF C=0 THEN 13480
  137. 13460 FOR ZZ=1 TO LEN(B$):MID$(B$,ZZ,1)=CHR$(ASC(MID$(B$,ZZ,1))+32*(ASC(MID$(B$,ZZ,1))>96)):NEXT ZZ
  138. 13480 IF LEN(B$)<63 THEN 13580
  139. 13500 A$="Input line too long - would be truncated to:":GOSUB 13020
  140. 13520 B$=LEFT$(B$,62):PRINT B$
  141. 13540 LINE INPUT "Retype line (Y/N)?";QQ$:QQ$=LEFT$(QQ$,1)
  142. 13560 IF QQ$="Y" OR QQ$="y" THEN PRINT PP$;:SAV$="":GOTO 13260
  143. 13580 D=D+LEN(B$):RETURN
  144. 13600 RETURN
  145. 13620 REM
  146. 15000 REM ***ON ERROR HANDLER***
  147. 15020 IF ERL=18030 THEN RESUME 18050
  148. 15030 IF ERL=700 THEN RE=0:RESUME 710
  149. 15100 RESUME NEXT
  150. 16000 REM
  151. 16010 REM FILL AND STORE DISK RECORD
  152. 16020 REM
  153. 16030 LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
  154. 16040 RETURN
  155. 16500 REM
  156. 16510 REM UNPACK DISK RECORD
  157. 16520 REM
  158. 16530 ZZ=LEN(RR$)-2
  159. 16540 WHILE MID$(RR$,ZZ,1)=" "
  160. 16550 ZZ=ZZ-1:IF ZZ=1 THEN 16570
  161. 16560 WEND
  162. 16570 S$=LEFT$(RR$,ZZ)
  163. 16580 IF MID$(S$,ZZ,1)="?" THEN S$=S$+" "
  164. 16590 RETURN
  165. 17000 REM
  166. 17010 REM *** TOGGLE EXPERT USER MODE
  167. 17020 REM
  168. 17030 XPR=NOT XPR:RETURN
  169. 17040 REM
  170. 17050 REM *** TOGGLE BELL PROMPT
  171. 17060 REM
  172. 17070 BEL=NOT BEL:RETURN
  173. 18000 REM
  174. 18010 REM SUBROUTINE TO PRINT A FILE
  175. 18020 REM
  176. 18030 OPEN "I",1,"A:"+FIL$:BK=0
  177. 18040 IF EOF(1) OR BK THEN 18050 ELSE LINE INPUT #1,A$:GOSUB 13020:GOTO 18040
  178. 18050 CLOSE #1:RETURN
  179. 18060 REM
  180. 18070 REM
  181. 18080 REM   *** SUBROUTINE TO LOG OFF AN UNWANTED CALLER ***
  182. 18090 REM
  183. 18100 A$="Disconnecting - Goodbye":GOSUB 13020:GOSUB 13020
  184. 18120 OUT 53,37 '<-- Turn off DTR to disconnect the line.
  185. 18130 POKE 0,&HC3 '<-- Restore the "jump" at BASE for CP/M.
  186. 18140 SYSTEM
  187. 18160 REM
  188.