home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol128 / exitrbbs.bqs / EXITRBBS.BAS
Encoding:
BASIC Source File  |  1985-02-10  |  8.0 KB  |  311 lines
  1. 100    '  EXITRBBS.BAS, version 1.4
  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. 255    ' 26/Mar/83 Fixed bug in elapsed time routine that gave weird
  24. 256    ' results if login went over midnight. Bill Bolton
  25. 257    '---------------------------------------------------------
  26. 258    ' 04/Apr/83 Added SYSOP logout recording in DIRECT file.
  27. 259    ' Version 1.3 - Bill Bolton
  28. 260    '---------------------------------------------------------
  29. 261    ' 15/May/83 Added error trap when exiting system with no
  30. 262    ' pre-existing DIRECT or CALLERS file (i.e. after a general
  31. 263    ' file purge and system maintenance). Must now be compiled
  32. 264    ' with /X switch. Version message added. Version 1.4 - Bill Bolton
  33. 265    '---------------------------------------------------------
  34. 279    '
  35. 280    DEFINT A-Z
  36. 300    DIM H(6),HT(6),HD(6),TOD(5),DOY(5)
  37. 310    ON ERROR GOTO 4000
  38. 320    ERS$=CHR$(8)+" "+CHR$(8)
  39. 330    MAGIC$ = "SUPER"
  40. 340    OPEN "I",1,"A:LASTCALR":
  41.  
  42.     INPUT #1,N$,O$,F$,DT$:
  43.  
  44.     CLOSE
  45. 360    PRINT
  46. 370    IF F$ = "TW" THEN
  47.  
  48.         GOTO 720
  49. 375    PRINT "BYE Version 1.4"
  50. 376    PRINT
  51. 380    PRINT "Want to leave any comments (Y/N)? ";:
  52.  
  53.     C=1:
  54.  
  55.     GOSUB 1200:
  56.  
  57.     C=0
  58. 400    IF LEFT$(B$,1)="N" OR LEFT$(B$,1)="n" THEN
  59.  
  60.         720
  61. 420    IF LEFT$(B$,1)<>"Y" AND LEFT$(B$,1)<>"y" THEN
  62.  
  63.         380
  64. 440    PRINT
  65. 460    OPEN "R",1,"A:C"+CHR$(&HCF)+"MMENTS. "+CHR$(&HA0),65:
  66.  
  67.     FIELD#1,65 AS RR$
  68. 480    GET#1,1:
  69.  
  70.     RE=VAL(RR$)+1:
  71.  
  72.     RL=65
  73. 500    IF RE=1 THEN
  74.  
  75.         RE=2
  76. 520    S$="From: "+N$+" "+O$+" "+DT$+" (Exit)":
  77.  
  78.     GOSUB 1500
  79. 540    PUT#1,RE
  80. 560    PRINT "Enter comments, <return> to end, (16 lines max)"
  81. 580    PRINT
  82. 600    PRINT "-->";
  83. 620    GOSUB 1200
  84. 640    IF B$="" THEN
  85.  
  86.         700    
  87. 660    RE=RE+1:
  88.  
  89.     S$=B$:
  90.  
  91.     RL=65:
  92.  
  93.     GOSUB 1500:
  94.  
  95.     PUT#1,RE 
  96. 680    GOTO 600
  97. 700    S$=STR$(RE):
  98.  
  99.     RL=65:
  100.  
  101.     GOSUB 1500:
  102.  
  103.     PUT#1,1:
  104.  
  105.     CLOSE
  106. 720    GOSUB 2000:
  107.  
  108.     GOSUB 2700
  109. 730    IF N$ = MAGIC$ THEN
  110.  
  111.         GOSUB 1000:
  112.  
  113.         GOTO 920        'Record time off for SYSOP
  114. 740    OPEN "R",1,"A:C"+CHR$(&HC1)+"LLERS. "+CHR$(&HA0),60:
  115.  
  116.     FIELD#1, 60 AS RR$:
  117.  
  118.     GET #1,1
  119. 760    RE = VAL(RR$) + 1:
  120.  
  121.     RL = 60
  122. 780    GET #1,RE:
  123.  
  124.     INPUT#1,S$
  125. 800    IF INSTR(S$,":") THEN
  126.  
  127.         POINTER = INSTR(S$,":")
  128.  
  129.     ELSE
  130.  
  131.         POINTER = LEN(S$)
  132. 820    S$ = LEFT$(S$,POINTER + 2)  + " to " + TI$ + " " + F$ + MID$(S$,POINTER + 3)
  133. 840    GOSUB 1500
  134. 860    PUT #1,RE:
  135.  
  136.     CLOSE #1
  137. 880    '
  138. 920    PRINT
  139. 930    GOSUB 44000
  140. 940    RUN "A:SUPER.COM"
  141. 960    END
  142. 980    '
  143. 1000    OPEN "R",1,"A:D"+CHR$(&HC9)+"RECT. "+CHR$(&HA0),40:
  144.  
  145.     FIELD#1, 40 AS RR$:
  146.  
  147.     GET #1,1
  148. 1020    RE = VAL(RR$) + 1:
  149.  
  150.     RL = 40
  151. 1040    GET #1,RE:
  152.  
  153.     INPUT#1,S$
  154. 1060    IF INSTR(S$,":") THEN
  155.  
  156.         POINTER = INSTR(S$,":")
  157.  
  158.     ELSE
  159.  
  160.         POINTER = LEN(S$)
  161. 1080    S$ = LEFT$(S$,POINTER + 2)  + " to " + TI$ + " " + F$ + MID$(S$,POINTER + 3)
  162. 1100    GOSUB 1500
  163. 1120    PUT #1,RE:
  164.  
  165.     CLOSE #1
  166. 1140    RETURN
  167. 1200    '
  168. 1220    '  Accept string into B$ from console
  169. 1240    '
  170. 1260    GOSUB 1620
  171. 1280    B$=SAV$
  172. 1300    IF LEN(B$)=0 THEN
  173.  
  174.         RETURN
  175. 1320    IF C=0 THEN
  176.  
  177.         1400
  178. 1340    FOR ZZ=1 TO LEN(B$)
  179. 1360        MID$(B$,ZZ,1)=CHR$(ASC(MID$(B$,ZZ,1))+32*(ASC(MID$(B$,ZZ,1))>96))
  180. 1380    NEXT ZZ
  181. 1400    RETURN
  182. 1500    '
  183. 1520    '  Fill and store disk record
  184. 1540    '
  185. 1560    LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
  186. 1580    RETURN
  187. 1600    '
  188. 1620    CHC=0:
  189.  
  190.     SAV$=""
  191. 1640    NCH=ASC(INPUT$(1))
  192. 1660    IF NCH=127 THEN
  193.  
  194.         1800
  195. 1680    IF NCH<32 THEN
  196.  
  197.         1860
  198. 1700    IF CHC>=62 THEN
  199.  
  200.         PRINT CHR$(7);:
  201.  
  202.         GOTO 1640
  203. 1720    SAV$=SAV$+CHR$(NCH):
  204.  
  205.     CHC=CHC+1:
  206.  
  207.     PRINT CHR$(NCH);
  208. 1740    IF CHC=55 THEN
  209.  
  210.         PRINT CHR$(7);
  211. 1760    GOTO 1640
  212. 1780    '
  213. 1800    IF CHC=0 THEN
  214.  
  215.         1640
  216.  
  217.     ELSE
  218.  
  219.         PRINT RIGHT$(SAV$,1);:
  220.  
  221.          GOTO 1840
  222. 1820    IF CHC=0 THEN
  223.  
  224.         1640
  225.  
  226.     ELSE
  227.  
  228.         PRINT ERS$;
  229. 1840    CHC=CHC-1:
  230.  
  231.     SAV$=LEFT$(SAV$,CHC):
  232.  
  233.     GOTO 1640
  234. 1860    IF NCH=8 THEN
  235.  
  236.         1820
  237. 1880    IF NCH=13 THEN
  238.  
  239.         PRINT:
  240.  
  241.         RETURN
  242. 1900    IF NCH=21 THEN
  243.  
  244.         PRINT " #":
  245.  
  246.         GOTO 1620
  247. 1920    IF NCH<>24 OR CHC=0 THEN
  248.  
  249.         1640
  250. 1940    FOR BCC=1 TO CHC:
  251.  
  252.          PRINT ERS$;:
  253.  
  254.     NEXT BCC:
  255.  
  256.     GOTO 1620
  257. 1960 '
  258. 2000 ' Date getting subroutine
  259. 2020    BASEPORT = &H50
  260. 2040    CMDPORT = BASEPORT + 10
  261. 2060    DATAPORT = CMDPORT + 1
  262. 2080 '**********************************************************
  263. 2100 '*        READ THE DATE DIGITS            *
  264. 2120 '**********************************************************
  265. 2140    FOR DIGIT = 12 TO 7 STEP -1
  266. 2160        OUT CMDPORT,(&H10 + DIGIT)
  267. 2180        DOY(DIGIT - 7) = INP(DATAPORT)
  268. 2200    NEXT DIGIT
  269. 2220    YEAR= (DOY(5) * 10) + DOY(4)
  270. 2240    MONTH10 = DOY(3)
  271. 2260    MONTH1  = DOY(2)
  272. 2280    DAY10 = DOY(1)
  273. 2300    DAY1  = DOY(0)
  274. 2320 '**********************************************************
  275. 2340 '*        FORMAT THE FIRST DATE STRING        *
  276. 2360 '**********************************************************
  277. 2380    DATE1$="        "
  278. 2400    MID$(DATE1$,1,1) = RIGHT$(STR$(DAY10),1)
  279. 2420    MID$(DATE1$,2,1) = RIGHT$(STR$(DAY1),1)
  280. 2440    MID$(DATE1$,3,1) = "/"
  281. 2460    MID$(DATE1$,4,1) = RIGHT$(STR$(MONTH10),1)
  282. 2480    MID$(DATE1$,5,1) = RIGHT$(STR$(MONTH1),1)
  283. 2500    MID$(DATE1$,6,1) = "/"
  284. 2520    MID$(DATE1$,7,2) = RIGHT$(STR$(YEAR),2)
  285. 2540    DZ$ = DATE1$
  286. 2560    DT$ = LEFT$(DATE1$,5)
  287. 2580    DD$ = MID$(DATE1$,1,2)
  288. 2600    DM$ = MID$(DATE1$,4,2)
  289. 2620    RETURN
  290. 2700 '
  291. 2720 ' Time-finding subroutine
  292. 2740    FOR DIGIT = 5 TO 0 STEP -1
  293. 2760        OUT CMDPORT,(&H10 + DIGIT)
  294. 2780        TOD(DIGIT) = INP(DATAPORT)
  295. 2800        IF DIGIT = 5 THEN TOD(DIGIT) = TOD(DIGIT) AND 3
  296. 2820    NEXT DIGIT
  297. 2840    H(1) = TOD(5)
  298. 2860    H(2) = TOD(4)
  299. 2880    H(3) = TOD(3)
  300. 2900    H(4) = TOD(2)
  301. 2920    H(5) = TOD(1)
  302. 2940    H(6) = TOD(0)
  303. 2960    DH$ = "  ":
  304.  
  305.     DI$ = "  ":
  306.  
  307.     DS$ = "  "
  308. 2980    MID$(DH$,1,1) = RIGHT$(STR$(H(1)),1):
  309.  
  310.     MID$(DH$,2,1) = RIGHT$(STR$(H(2)),1):
  311.  
  312.     MID$(DI$,1,1) = RIGHT$(STR$(H(3)),1):
  313.  
  314.     MID$(DI$,2,1) = RIGHT$(STR$(H(4)),1):
  315.  
  316.     MID$(DS$,1,1) = RIGHT$(STR$(H(5)),1):
  317.  
  318.     MID$(DS$,2,1) = RIGHT$(STR$(H(6)),1)
  319. 3000    TI$=DD$+"-"+DH$+":"+DI$
  320. 3020    TD$=DH$+":"+DI$+":"+DS$
  321. 3040    RETURN
  322. 4000    IF ERL=780 THEN
  323.  
  324.         RESUME 860
  325. 4010    IF ERL=1040 THEN
  326.  
  327.         RESUME 1120
  328. 4020    ON ERROR GOTO 0
  329. 4030    '
  330. 4040    '
  331. 44000 '
  332. 44020 'CLOCK ROUTINES
  333. 44040 '
  334. 44060    PRINT:
  335.  
  336.     PRINT "The time now is (Hrs:Mins:Secs).... ";
  337. 44080    TF$="#"
  338. 44100    FOR I=1 TO 6
  339. 44120        PRINT USING TF$;H(I);
  340. 44140        IF I=2 THEN 
  341.  
  342.             PRINT ":";
  343. 44160        IF I=4 THEN 
  344.  
  345.             PRINT ":";
  346. 44180    NEXT I
  347. 44200    PRINT
  348. 44220 '  Now get hh/mm/ss stored by enterbbs
  349. 44240    HT(1)=PEEK(74):
  350.  
  351.     HT(2)=PEEK(75):
  352.  
  353.     HT(3)=PEEK(76)
  354. 44260    HT(4)=PEEK(77):
  355.  
  356.     HT(5)=PEEK(78):
  357.  
  358.     HT(6)=PEEK(79)
  359. 44280 '  And calculate the difference...
  360. 44300    IF H(1) < HT(1) THEN
  361.  
  362.         H(1) = H(1) + 2:
  363.  
  364.         H(2) = H(2) + 4
  365. 44320    IF H(6)<HT(6) THEN 
  366.  
  367.         H(6)=H(6)+10:
  368.  
  369.         H(5)=H(5)-1
  370. 44340    IF H(5)<HT(5) THEN 
  371.  
  372.         H(5)=H(5)+6:
  373.  
  374.         H(4)=H(4)-1
  375. 44360    IF H(4)<HT(4) THEN 
  376.  
  377.         H(4)=H(4)+10:
  378.  
  379.         H(3)=H(3)-1
  380. 44380    IF H(3)<HT(3) THEN 
  381.  
  382.         H(3)=H(3)+6:
  383.  
  384.         H(2)=H(2)-1
  385. 44400    IF H(2)<HT(2) THEN 
  386.  
  387.         H(2)=H(2)+10:
  388.  
  389.         H(1)=H(1)-1
  390. 44420    HD(6)=H(6)-HT(6):
  391.  
  392.     HD(5)=H(5)-HT(5):
  393.  
  394.     HD(4)=H(4)-HT(4)
  395. 44440    HD(3)=H(3)-HT(3):
  396.  
  397.     HD(2)=H(2)-HT(2):
  398.  
  399.     HD(1)=H(1)-HT(1)
  400. 44460    PRINT "You've been on the system for...... ";
  401. 44480    TF$="#"
  402. 44500    FOR I=1 TO 6
  403. 44520        PRINT USING TF$;HD(I);
  404. 44540        IF I=2 THEN 
  405.  
  406.             PRINT ":";
  407. 44560        IF I=4 THEN 
  408.  
  409.             PRINT ":";
  410. 44580    NEXT I
  411. 44600    PRINT:
  412.  
  413.     PRINT
  414. 44620    RETURN
  415.