home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / sigmv084.ark / EXITRBBS.BAS < prev    next >
BASIC Source File  |  1984-04-29  |  7KB  |  268 lines
  1. 100    '  EXITRBBS.BAS, version 1.1
  2. 120    '  Routine to allow users to leave comments before logging off
  3. 140    '  Original by Brian Kantor & Skip Hansen 09/81 (?)
  4. 160    '  Minor text changes, bye call, and time-on-system stuff added
  5. 180    '            by Ben Bronson, 10/11/81
  6. 200    '     Note that this is meant to be compiled and called "BYE.COM"
  7. 220    '  Modified for Macrostore-R 10-18-81 -CAF
  8. 240    '  Main routine for users to leave comments before logging off
  9. 241    ' --------------------------------------------------------
  10. 242    ' 15/Jun/82 Added clock routines from ENTRBBS to allow exit
  11. 243    ' time of caller to be recorded. Caller status is checked from
  12. 244    ' and recorded in CALLERS along with out time. TWit status callers
  13. 245    ' don't get a chance to leave comments. TWit status may be entered
  14. 246    ' LASTCALR in ENTRBBS (from USERS) or by a password utility like
  15. 247    ' UTIL that a user has tried to break into. SYSOP bypasses the
  16. 248    ' out time recording as he never makes it into CALLERS. Added date
  17. 249    ' and "exit" to COMMENTS enteries so you can tell when and where
  18. 250    ' they were entered (MINIRBBS enters "Mini"). Bill Bolton
  19. 251    ' --------------------------------------------------------
  20. 252    ' 09/Aug/82 Added routine from MINIRBBS to give time on system.
  21. 253    ' Bill Bolton
  22. 254    ' --------------------------------------------------------
  23. 260    '
  24. 280    DEFINT A-Z
  25. 300    DIM H(6),HT(6),HD(6),TOD(5),DOY(5)
  26. 320    ERS$=CHR$(8)+" "+CHR$(8)
  27. 330    MAGIC$ = "SUPER"
  28. 340    OPEN "I",1,"A:LASTCALR":
  29.     INPUT #1,N$,O$,F$,DT$:
  30.     CLOSE
  31. 360    PRINT
  32. 370    IF F$ = "TW" THEN
  33.         GOTO 720
  34. 380    PRINT "Want to leave any comments (Y/N)? ";:
  35.     C=1:
  36.     GOSUB 980:
  37.     C=0
  38. 400    IF LEFT$(B$,1)="N" OR LEFT$(B$,1)="n" THEN
  39.         720
  40. 420    IF LEFT$(B$,1)<>"Y" AND LEFT$(B$,1)<>"y" THEN
  41.         380
  42. 440    PRINT
  43. 460    OPEN "R",1,"A:C"+CHR$(&HCF)+"MMENTS. "+CHR$(&HA0),65:
  44.     FIELD#1,65 AS RR$
  45. 480    GET#1,1:
  46.     RE=VAL(RR$)+1:
  47.     RL=65
  48. 500    IF RE=1 THEN
  49.         RE=2
  50. 520    S$="From: "+N$+" "+O$+" "+DT$+" (Exit)":
  51.     GOSUB 1200
  52. 540    PUT#1,RE
  53. 560    PRINT "Enter comments, <return> to end, (16 lines max)"
  54. 580    PRINT
  55. 600    PRINT "-->";
  56. 620    GOSUB 980
  57. 640    IF B$="" THEN
  58.         700    
  59. 660    RE=RE+1:
  60.     S$=B$:
  61.     RL=65:
  62.     GOSUB 1200:
  63.     PUT#1,RE 
  64. 680    GOTO 600
  65. 700    S$=STR$(RE):
  66.     RL=65:
  67.     GOSUB 1200:
  68.     PUT#1,1:
  69.     CLOSE
  70. 720    GOSUB 1660:
  71.     GOSUB 2300
  72. 730    IF N$ = MAGIC$ THEN
  73.         GOTO 920        'Skip callers time out for SYSOP
  74. 740    OPEN "R",1,"A:CALLERS",60:
  75.     FIELD#1, 60 AS RR$:
  76.     GET #1,1
  77. 760    RE = VAL(RR$) + 1:
  78.     RL = 60
  79. 780    GET #1,RE:
  80.     INPUT#1,S$
  81. 800    IF INSTR(S$,":") THEN
  82.         POINTER = INSTR(S$,":")
  83.     ELSE
  84.         POINTER = LEN(S$)
  85. 820    S$ = LEFT$(S$,POINTER + 2)  + " to " + TI$ + " " + F$ + MID$(S$,POINTER + 3)
  86. 840    GOSUB 1200
  87. 860    PUT #1,RE:
  88.     CLOSE #1
  89. 880    '
  90. 920    PRINT
  91. 930    GOSUB 44000
  92. 940    RUN "A:SUPER.COM"
  93. 960    END
  94. 980    '
  95. 1000    '  Accept string into B$ from console
  96. 1020    '
  97. 1040    GOSUB 1320
  98. 1060    B$=SAV$
  99. 1080    IF LEN(B$)=0 THEN
  100.         RETURN
  101. 1100    IF C=0 THEN
  102.         1180
  103. 1120    FOR ZZ=1 TO LEN(B$)
  104. 1140        MID$(B$,ZZ,1)=CHR$(ASC(MID$(B$,ZZ,1))+32*(ASC(MID$(B$,ZZ,1))>96))
  105. 1160    NEXT ZZ
  106. 1180    RETURN
  107. 1200    '
  108. 1220    '  Fill and store disk record
  109. 1240    '
  110. 1260    LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
  111. 1280    RETURN
  112. 1300    '
  113. 1320    CHC=0:
  114.     SAV$=""
  115. 1340    NCH=ASC(INPUT$(1))
  116. 1360    IF NCH=127 THEN
  117.         1500
  118. 1380    IF NCH<32 THEN
  119.         1560
  120. 1400    IF CHC>=62 THEN
  121.         PRINT CHR$(7);:
  122.         GOTO 1340
  123. 1420    SAV$=SAV$+CHR$(NCH):
  124.     CHC=CHC+1:
  125.     PRINT CHR$(NCH);
  126. 1440    IF CHC=55 THEN
  127.         PRINT CHR$(7);
  128. 1460    GOTO 1340
  129. 1480    '
  130. 1500    IF CHC=0 THEN
  131.         1340
  132.     ELSE
  133.         PRINT RIGHT$(SAV$,1);:
  134.          GOTO 1540
  135. 1520    IF CHC=0 THEN
  136.         1340
  137.     ELSE
  138.         PRINT ERS$;
  139. 1540    CHC=CHC-1:
  140.     SAV$=LEFT$(SAV$,CHC):
  141.     GOTO 1340
  142. 1560    IF NCH=8 THEN
  143.         1520
  144. 1580    IF NCH=13 THEN
  145.         PRINT:
  146.         RETURN
  147. 1600    IF NCH=21 THEN
  148.         PRINT " #":
  149.         GOTO 1320
  150. 1620    IF NCH<>24 OR CHC=0 THEN
  151.         1340
  152. 1640    FOR BCC=1 TO CHC:
  153.          PRINT ERS$;:
  154.     NEXT BCC:
  155.     GOTO 1320
  156. 1660 ' Date getting subroutine
  157. 1680    BASEPORT = &H50
  158. 1700    CMDPORT = BASEPORT + 10
  159. 1720    DATAPORT = CMDPORT + 1
  160. 1740 '**********************************************************
  161. 1760 '*        READ THE DATE DIGITS            *
  162. 1780 '**********************************************************
  163. 1800    FOR DIGIT = 12 TO 7 STEP -1
  164. 1820        OUT CMDPORT,(&H10 + DIGIT)
  165. 1840        DOY(DIGIT - 7) = INP(DATAPORT)
  166. 1860    NEXT DIGIT
  167. 1880    YEAR= (DOY(5) * 10) + DOY(4)
  168. 1900    MONTH10 = DOY(3)
  169. 1920    MONTH1  = DOY(2)
  170. 1940    DAY10 = DOY(1)
  171. 1960    DAY1  = DOY(0)
  172. 1980 '**********************************************************
  173. 2000 '*        FORMAT THE FIRST DATE STRING        *
  174. 2020 '**********************************************************
  175. 2040    DATE1$="        "
  176. 2060    MID$(DATE1$,1,1) = RIGHT$(STR$(DAY10),1)
  177. 2080    MID$(DATE1$,2,1) = RIGHT$(STR$(DAY1),1)
  178. 2100    MID$(DATE1$,3,1) = "/"
  179. 2120    MID$(DATE1$,4,1) = RIGHT$(STR$(MONTH10),1)
  180. 2140    MID$(DATE1$,5,1) = RIGHT$(STR$(MONTH1),1)
  181. 2160    MID$(DATE1$,6,1) = "/"
  182. 2180    MID$(DATE1$,7,2) = RIGHT$(STR$(YEAR),2)
  183. 2200    DZ$ = DATE1$
  184. 2220    DT$ = LEFT$(DATE1$,5)
  185. 2240    DD$ = MID$(DATE1$,1,2)
  186. 2260    DM$ = MID$(DATE1$,4,2)
  187. 2280    RETURN
  188. 2300 '
  189. 2320 ' Time-finding subroutine
  190. 2340    FOR DIGIT = 5 TO 0 STEP -1
  191. 2360        OUT CMDPORT,(&H10 + DIGIT)
  192. 2380        TOD(DIGIT) = INP(DATAPORT)
  193. 2400        IF DIGIT = 5 THEN TOD(DIGIT) = TOD(DIGIT) AND 3
  194. 2420    NEXT DIGIT
  195. 2440    H(1) = TOD(5)
  196. 2460    H(2) = TOD(4)
  197. 2480    H(3) = TOD(3)
  198. 2500    H(4) = TOD(2)
  199. 2520    H(5) = TOD(1)
  200. 2540    H(6) = TOD(0)
  201. 2560    DH$ = "  ":
  202.     DI$ = "  ":
  203.     DS$ = "  "
  204. 2580    MID$(DH$,1,1) = RIGHT$(STR$(H(1)),1):
  205.     MID$(DH$,2,1) = RIGHT$(STR$(H(2)),1):
  206.     MID$(DI$,1,1) = RIGHT$(STR$(H(3)),1):
  207.     MID$(DI$,2,1) = RIGHT$(STR$(H(4)),1):
  208.     MID$(DS$,1,1) = RIGHT$(STR$(H(5)),1):
  209.     MID$(DS$,2,1) = RIGHT$(STR$(H(6)),1)
  210. 2600    TI$=DD$+"-"+DH$+":"+DI$
  211. 2620    TD$=DH$+":"+DI$+":"+DS$
  212. 2640    RETURN
  213. 44000 '
  214. 44002 'CLOCK ROUTINES
  215. 44005 '
  216. 44270    PRINT:
  217.     PRINT "The time now is (Hrs:Mins:Secs).... ";
  218. 44280    TF$="#"
  219. 44290    FOR I=1 TO 6
  220. 44300        PRINT USING TF$;H(I);
  221. 44310        IF I=2 THEN 
  222.             PRINT ":";
  223. 44320        IF I=4 THEN 
  224.             PRINT ":";
  225. 44330    NEXT I
  226. 44340    PRINT
  227. 44700 '  Now get hh/mm/ss stored by enterbbs
  228. 44710    HT(1)=PEEK(74):
  229.     HT(2)=PEEK(75):
  230.     HT(3)=PEEK(76)
  231. 44720    HT(4)=PEEK(77):
  232.     HT(5)=PEEK(78):
  233.     HT(6)=PEEK(79)
  234. 44730 '  And calculate the difference...
  235. 44740    IF H(6)<HT(6) THEN 
  236.         H(6)=H(6)+10:
  237.         H(5)=H(5)-1
  238. 44750    IF H(5)<HT(5) THEN 
  239.         H(5)=H(5)+6:
  240.         H(4)=H(4)-1
  241. 44760    IF H(4)<HT(4) THEN 
  242.         H(4)=H(4)+10:
  243.         H(3)=H(3)-1
  244. 44770    IF H(3)<HT(3) THEN 
  245.         H(3)=H(3)+6:
  246.         H(2)=H(2)-1
  247. 44780    IF H(2)<HT(2) THEN 
  248.         H(2)=H(2)+10:
  249.         H(1)=H(1)-1
  250. 44790    HD(6)=H(6)-HT(6):
  251.     HD(5)=H(5)-HT(5):
  252.     HD(4)=H(4)-HT(4)
  253. 44800    HD(3)=H(3)-HT(3):
  254.     HD(2)=H(2)-HT(2):
  255.     HD(1)=H(1)-HT(1)
  256. 44810    PRINT "You've been on the system for...... ";
  257. 44820    TF$="#"
  258. 44830    FOR I=1 TO 6
  259. 44840        PRINT USING TF$;HD(I);
  260. 44850        IF I=2 THEN 
  261.             PRINT ":";
  262. 45860        IF I=4 THEN 
  263.             PRINT ":";
  264. 45870    NEXT I
  265. 45880    PRINT:
  266.     PRINT
  267. 45890    RETURN
  268.