home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol112 / signon-2.arc / COMGR.BAS
Encoding:
BASIC Source File  |  1985-02-10  |  13.1 KB  |  480 lines

  1. 1 '    signon subsystem -- Comments Manager
  2. 3 VERSION$="1.00 {7/14/82}"
  3. 5 '    by dick lieber
  4. 6 SYSOPONLY%=0    '0 for anyone, 1 for sysop only
  5. 7 '
  6. 9 DEFDRIVE$="A:"
  7. 10 USERFILE$=DEFDRIVE$+"USERS"
  8. 11 CALLERFILE$="CALLERS"
  9. 15 LASTCALRFILE$="LASTCALR"
  10. 20 PWDFILE$="pwds"
  11. 21 SYSMGR$="POSYS"
  12. 50 USER0%=0
  13. 65 CRLF$=CHR$(&HA)+CHR$(&HD)
  14. 67 BSTRING$=CHR$(8)+" "+CHR$(8)
  15. 68 COMMENTFILE$="COMMENTS"
  16. 70 DIM ACLARRAY%(5,11)
  17. 71 DIM FLAGS%(14)
  18. 77 ON ERROR GOTO 1000
  19. 80 '
  20. 81 '    function definition
  21. 82 '
  22. 83 '    add deliminators to time or date
  23. 84 DEF FNADDSEP$(DS$,DELIM$)=
  24.  
  25.     LEFT$(DS$,2)+DELIM$+MID$(DS$,3,2)+DELIM$+RIGHT$(DS$,2)
  26. 85 '    remove date or time deliminators
  27. 86 DEF FNKILLSEP$(DS$)=LEFT$(DS$,2)+MID$(DS$,4,2)+RIGHT$(DS$,2)
  28. 88 '    on-off function
  29. 90 DIM ONOFF$(1)
  30. 91 ONOFF$(0)="Off"
  31. 92 ONOFF$(1)="On"
  32. 93 DEF FNONOFF$(ONOFF%)=ONOFF$(ONOFF%)
  33. 94 DEF FNLINES$(NLINES%)=STRING$(NLINES%,CRLF$)
  34. 199 GOTO 10000
  35. 300 '
  36. 302 '    set user number
  37. 304 '
  38. 306 USERMD=TESTADDRESS+9
  39. 312 CALL USERMD(SETUSERNUMBER%)
  40. 345 RETURN
  41. 400 '
  42. 407 '    print a string on con:
  43. 414 '    string in A$, CR%=1 no crlf cr%=2 crlf after
  44. 435 ' 1.2
  45. 442 IF STACKED%<>0 THEN RETURN
  46. 449 BREAK%=0
  47. 456 XKEY$=INKEY$
  48. 463 IF XKEY$=CHR$(3) OR XKEY$="C" OR XKEY$="c" THEN BREAK%=1
  49. 470 IF XKEY$=CHR$(18) OR XKEY$="S" OR XKEY$="s" THEN PAUSE%=1 ELSE PAUSE%=0
  50. 477 IF PAUSE%<>0 AND LEN(INKEY$)=0 THEN GOTO 477    'wait for key
  51. 484 ON CR% GOTO 491,498
  52. 491    PRINT A$; : RETURN
  53. 498    PRINT A$: RETURN
  54. 500 '
  55. 503 '    get a string into ANSWER$ (make upper case)
  56. 512 ' 1.7    [*** tremendously improved! ***]
  57. 515 IF STACKED%<>0 THEN
  58.  
  59.     ANSWER$=STACKED$:
  60.  
  61.     STACKED%=0:
  62.  
  63.     NKEY%=LEN(STACKED$):
  64.  
  65.     GOTO 557
  66. 518 ANSWER$=""
  67. 521 KEY$="*"
  68. 524 NKEY%=0
  69. 527 WHILE NKEY% <= MAX%
  70. 530    KEY$=INPUT$(1)
  71. 533    KEY%=ASC(KEY$)
  72. 536    IF KEY$="~" THEN GOTO 551    'don't allow tilde
  73. 539    IF KEY%=13 THEN GOTO 557    'done
  74. 542    IF (KEEPLOWER%=0 AND KEY% >= 97 AND KEY%<= 122) THEN KEY%=KEY%-32
  75. 545    IF KEY%=127 OR KEY%=8 THEN GOSUB 569    'process backspace
  76. 548    IF DELCHAR%=0 THEN
  77.  
  78.         NKEY%=NKEY%+1:
  79.  
  80.         PRINT KEY$;:
  81.  
  82.         ANSWER$=ANSWER$+CHR$(KEY%)
  83.  
  84.         ELSE
  85.  
  86.         DELCHAR%=0
  87. 551    IF NKEY%<0 THEN NKEY%=0
  88. 554 WEND
  89. 557 STACKED%=INSTR(ANSWER$,";")
  90. 560 IF STACKED%<>0 THEN
  91.  
  92.     STACKED$=MID$(ANSWER$,STACKED%+1):
  93.  
  94.     ANSWER$=LEFT$(ANSWER$,STACKED%-1)
  95. 563 KEEPLOWER%=0
  96. 566 RETURN
  97. 569 DELCHAR%=1
  98. 572 IF NKEY%=0 THEN RETURN
  99. 575 NKEY%=NKEY%-1
  100. 578 PRINT BSTRING$;
  101. 581 ANSWER$=LEFT$(ANSWER$,LEN(ANSWER$)-1)
  102. 584 RETURN
  103. 700 '
  104. 705 '    get string into ANSWER$ then CRLF
  105. 710 '
  106. 715 GOSUB 500: PRINT: RETURN
  107. 800 '
  108. 810 '    print a file
  109. 820 '    filename in FIL$
  110. 821 '    NOCTLC% <> 0 to not allow ^C to skip
  111. 830 ' 1.6
  112. 833 IF SKIPFILES%=1 THEN RETURN
  113. 837 IF FIL$="NONE" THEN RETURN
  114. 838 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  115. 839 NOFILE%=0
  116. 840 OPEN "I",2,DRIVE$+FIL$:BK=0
  117. 842 IF NOFILE%<>0 THEN RETURN
  118. 845 IF NOCTLC% = 0 THEN 
  119.  
  120.     A$=CRLF$+"Ctrl-C to skip ahead."+CRLF$: GOSUB 400
  121. 850 CR%=2
  122. 860 IF EOF(2) OR (BREAK% AND NOCTLC%=0) THEN
  123.  
  124.      870 ELSE LINE INPUT #2,A$:GOSUB 400:GOTO 860
  125. 870 CLOSE #2
  126. 875 NOCTLC%=0
  127. 880 RETURN
  128. 1000 '
  129. 1004 '    Error handler
  130. 1008 '
  131. 1012 A$="Error Trap":CR%=2: GOSUB 400
  132. 1016 IF ERR=53 AND ERL=1135 THEN RESUME 1150
  133. 1020 PRINT "ERR = ";ERR, "ERL = ";ERL
  134. 1022 IF ERR=53 THEN NOFILE%=1
  135. 1024 IF ERR = 53 THEN RESUME NEXT    ' file not found
  136. 1028 END
  137. 1100 '    get passwords & configuration parameters
  138. 1110 ' 1.4
  139. 1115 NOFILE%=0
  140. 1120 OPEN "I", #2,DEFDRIVE$+PWDFILE$'caution line # must = in sub 1000
  141. 1125    IF NOFILE%<>0 THEN CLOSE #1: RETURN
  142. 1130    INPUT #2, PWD1$, PWD2$, PWD3$, ALLOWNEW%, SIGNONMESS$, OPTIONMESS$
  143. 1135    INPUT #2,BULLFILE$, SUCESSFILE$, OPTIONFILE$, INSTRFILE$,
  144.  
  145.          NEWCOMFILE$, NOACCESSFILE$, EXITFILE$,SPECIALFILE$
  146. 1140    INPUT #2,PWDACL%, MAXPW%, SYSOPSLVL%, USERNUMBER%, DENIEDCOMMENT%
  147. 1145    INPUT #2, CLEARSCR$,NOCLOCK%,SPECIALEVEL%
  148. 1150    INPUT #2, MUSTQUALIFY%, QUALQUESTION$, QUALANSWER1$, QUALANSWER2$,
  149.  
  150.     QUALNONPWD%, MGRDRIVE$
  151. 1155    INPUT #2, SKIPFILES%,RAMPOKE%,RAMPOKEADDRESS%,TESTADDRESS
  152. 1160    INPUT #2, BYEPOKE%, BYEPARAMS%
  153. 1165    FOR INDEX%=0 TO 4:
  154.  
  155.         FOR I%=0 TO 10:
  156.  
  157.             INPUT #2,ACLARRAY%(INDEX%,I%):
  158.  
  159.         NEXT I%:
  160.  
  161.     NEXT INDEX%
  162. 1170 CLOSE #2
  163. 1175 RETURN
  164. 1600 '
  165. 1602 ' date process and time
  166. 1604 ' 1.1
  167. 1606 '    on entry:
  168. 1608 '
  169. 1610 '    GETDAY% <> 0 if day of week is required
  170. 1612 '  NOCLOCK% <> 0 to return dummy values (no TOD clock)
  171. 1614 '
  172. 1616 '    returns:
  173. 1618 '
  174. 1620 '    DATE$ as mmddyy
  175. 1622 '    TIME$ as hhmmss
  176. 1624 '    DOW$ as string with day of week (Monday, Tuesday, etc.)
  177. 1626 '
  178. 1628 '    as written here, calls are made to externally linked
  179. 1630 '    modules:
  180. 1632 '
  181. 1634 '    TIMEMD returns "HH:MM:SS"
  182. 1636 '    DATEMD returns "DD/MM/YY"
  183. 1638 '    DAYMD  returns "dayofweekstring" (ie: Monday, Tuesday, etc.)
  184. 1640 '    seperators must be present
  185. 1642 '
  186. 1644 TIMEMD=TESTADDRESS
  187. 1646 DATEMD=TESTADDRESS+3
  188. 1648 DAYMD=TESTADDRESS+6
  189. 1650 IF NOCLOCK%<>0 THEN
  190.  
  191.     DATE$="xxxxxx":
  192.  
  193.     TIME$="xxxxxx":
  194.  
  195.     DAY$="":
  196.  
  197.     RETURN
  198. 1651 ODATE$=STRING$(12,"$")
  199. 1652 CALL DATEMD(ODATE$)
  200. 1654 DATE$=FNKILLSEP$(LEFT$(ODATE$,8))
  201. 1656 '
  202. 1658 '    get time
  203. 1660 '
  204. 1661 OTIME$=STRING$(12,"$")
  205. 1662 CALL TIMEMD(OTIME$)
  206. 1664 TIME$=FNKILLSEP$(LEFT$(OTIME$,8))
  207. 1666 '
  208. 1668 '    get day of week
  209. 1670 '
  210. 1672 DAY$=""
  211. 1674 IF GETDAY%=0 THEN RETURN
  212. 1676 ODAY$=STRING$(10,"$")
  213. 1678 CALL DAYMD(ODAY$)
  214. 1680 FOR I%=1 TO LEN(ODAY$)
  215. 1682    IF MID$(ODAY$,I%,1)<>"$" THEN DAY$=DAY$+MID$(ODAY$,I%,1)
  216. 1684 NEXT I%
  217. 1686 GETDAY%=0
  218. 1688 RETURN
  219. 3100 '
  220. 3105 '    clear screen
  221. 3110 '
  222. 3115 A$=CLEARSCR$:CR%=1:GOSUB 400: RETURN
  223. 3300 '
  224. 3305 '    make selection
  225. 3310 '
  226. 3315 MAX%=0:GOSUB 500
  227. 3320 IF ANSWER$="" THEN SELECTION%=0: RETURN
  228. 3325 SELECTION%=ASC(ANSWER$)-64
  229. 3327 IF SELECTION% < 0 THEN SELECTION%=0
  230. 3330 RETURN
  231. 4700 '
  232. 4705 '    pause 
  233. 4710 '
  234. 4715 PRINT:PRINT TAB(25);
  235. 4720 LINE INPUT "Press RETURN to continue."; A$
  236. 4725 RETURN
  237. 5000 '
  238. 5005 '    test that user is the SYSOP
  239. 5010 '
  240. 5015 OPEN "I", #1, DEFDRIVE$+LASTCALRFILE$
  241. 5020    INPUT #1, FRNAME$,LNAME$,ACLVL%
  242. 5025 CLOSE #1
  243. 5030 IF FRNAME$+LANME$ = "SYSOP" AND ACLVL% => 9 THEN ZRETURN%=1 
  244.  
  245.         ELSE ZRETURN%=0
  246. 5035 RETURN
  247. 5100 '
  248. 5105 '    COMMENTFILE$ maintainer - main menu
  249. 5110 '1.2
  250. 5115 GOSUB 3100
  251. 5120 PRINT TAB(30);COMMENTFILE$;" Manager"
  252. 5122 PRINT TAB(22);"Version: ";VERSION$
  253. 5125 PRINT FNLINES$(3); TAB(20);"a    View comments.";
  254. 5130 IF SYSCOM$="*" OR NEWCOM$="*" THEN PRINT " [New ";
  255. 5135 IF SYSCOM$="*" THEN PRINT "system ";
  256. 5140 IF SYSCOM$="*" AND NEWCOM$="*" THEN PRINT "and ";
  257. 5145 IF NEWCOM$="*" THEN PRINT "user ";
  258. 5150 IF SYSCOM$="*" OR NEWCOM$="*" THEN PRINT "comments]" ELSE
  259.  
  260.     PRINT
  261. 5155 PRINT FNLINES$(1); TAB(20);"b    Delete comments."
  262. 5160 PRINT FNLINES$(1); TAB(20);"c    Make typeable archive of COMMENTS."
  263. 5165 PRINT FNLINES$(1); TAB(20);"d    View a COMMENTS archive file."
  264. 5170 PRINT FNLINES$(1); TAB(20);"e    Jump back to Signon Manager."
  265. 5172 PRINT: PRINT FNLINES$(1); TAB(20);"q    Quit Comments Manager."
  266. 5175 PRINT FNLINES$(3); TAB(20);"Press letter of your choice > ";
  267. 5180 GOSUB 3300
  268. 5190 RETURN
  269. 5300 '
  270. 5304 '    exit subsystem manager
  271. 5308 '
  272. 5310 SETUSERNUMBER%=0:GOSUB 300
  273. 5316 END
  274. 7600 '
  275. 7605 '    leave comments manager
  276. 7610 '
  277. 7612 SETUSERNUMBER%=0: GOSUB 300
  278. 7615 END
  279. 7700 '
  280. 7704 '    jumpout to posys
  281. 7708 '
  282. 7710 SETUSERNUMBER%=0: GOSUB 300
  283. 7712 JUMPFILE$=SYSMGR$
  284. 7716 GOSUB 7800
  285. 7720 RETURN
  286. 7800 '
  287. 7807 '    generalized jumpout (chain)
  288. 7814 '1.2
  289. 7821 GOSUB 3100
  290. 7822 CLOSE
  291. 7828 PRINT FNLINES$(4)
  292. 7835 PRINT TAB(20);"Chaining to ";JUMPFILE$;"."
  293. 7842 PRINT FNLINES$(2)
  294. 7849 PRINT TAB(20);"Please wait."
  295. 7856 CHAIN JUMPFILE$
  296. 7863 GOSUB 3100
  297. 7870 PRINT FNLINES$(4)
  298. 7877 PRINT TAB(25); JUMPFILE$;" is not available."
  299. 7884 GOSUB 4700
  300. 7891 RETURN
  301. 7900 '
  302. 7905 '    open comments file
  303. 7910 '    get comment parameters from header
  304. 7915 '    1.5
  305. 7920 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  306. 7925 OPEN "R", #3, DEFDRIVE$+COMMENTFILE$, 66
  307. 7930 FIELD #3,
  308.  
  309.     5 AS COMMENTNUMBER$,
  310.  
  311.     8 AS TOTCOMMT$,
  312.  
  313.     1 AS COMSIG$,
  314.  
  315.     6 AS FCOMDATE$,
  316.  
  317.     6 AS FCOMTIME$,
  318.  
  319.     1 AS FINEWCOM$,
  320.  
  321.     1 AS FSYSCOM$
  322. 7935 GET #3,1
  323. 7940 NEXTCOMMENT%=VAL(COMMENTNUMBER$)
  324. 7945 TOTALCOMMENTS#=VAL(TOTCOMMT$)
  325. 7950 COMTIME$=FCOMTIME$
  326. 7955 NEWCOM$=FINEWCOM$
  327. 7960 COMDATE$=FCOMDATE$
  328. 7965 SYSCOM$=FSYSCOM$
  329. 7975 IF COMSIG$<>"*" THEN 
  330.  
  331.     NEXTCOMMENT%=2:
  332.  
  333.     TOTALCOMMENTS#=1:
  334.  
  335.     GOSUB 1600:
  336.  
  337.     COMTIME$=TIME$:
  338.  
  339.     COMDATE$=DATE$:
  340.  
  341.     NOCOMMENTS%=1
  342. 7977 IF HEADONLY%<>0 THEN
  343.  
  344.     HEADONLY%=0:
  345.  
  346.     RETURN
  347. 7980 FIELD #3, 64 AS COMMENT$
  348. 7985 RETURN
  349. 8000 '
  350. 8003 '    get a line from the COMMENTFILE$
  351. 8006 '
  352. 8007 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  353. 8010    GET #3, COMREC%
  354. 8015    COMMENTLINE$=COMMENT$
  355. 8017    IF RIGHT$(COMMENTLINE$,1)=" " THEN
  356.  
  357.         COMMENTLINE$=LEFT$(COMMENTLINE$,LEN(COMMENTLINE$)-1):
  358.  
  359.         GOTO 8017
  360. 8021    IF LEFT$(COMMENTLINE$,1)="~" THEN
  361.  
  362.         COMMENTLINE$=RIGHT$(COMMENTLINE$,LEN(COMMENTLINE$)-1):
  363.  
  364.         COMMENTCOUNT%=COMMENTCOUNT%+1:
  365.  
  366.         HEADER%=1
  367.  
  368.         ELSE
  369.  
  370.         HEADER%=0
  371. 8040 RETURN
  372. 8100 '
  373. 8104 '    check for new comments
  374. 8108 '
  375. 8110 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  376. 8112 OPEN "R", #3,DEFDRIVE$+COMMENTFILE$, 66
  377. 8116 FIELD #3,
  378.  
  379.     5 AS COMMENTNUMBER$,
  380.  
  381.     8 AS TOTCOMMT$,
  382.  
  383.     1 AS COMSIG$,
  384.  
  385.     6 AS FCOMDATE$,
  386.  
  387.     6 AS FCOMTIME$,
  388.  
  389.     1 AS FINEWCOM$,
  390.  
  391.     1 AS FSYSCOM$
  392. 8117 GET #3,1
  393. 8120 IF COMSIG$="*" THEN
  394.  
  395.     NEWCOM$=FINEWCOM$:
  396.  
  397.     SYSCOM$=FSYSCOM$
  398. 8124 CLOSE #3
  399. 8128 RETURN
  400. 8200 '
  401. 8203 '    write COMMENTFILE$ to a comments archeive file
  402. 8206 '    named DATE.CMT
  403. 8209 '
  404. 8212 GOSUB 1600
  405. 8215 GOSUB 3100
  406. 8218 PRINT:PRINT TAB(15);
  407.  
  408.     "Making an archeive of any comments in the file COMMENTS."
  409. 8221 PRINT:PRINT TAB(15);
  410.  
  411.     "The new file will be called ";FNADDSEP$(DATE$,"/");".CMT"
  412. 8224 GOSUB 7900
  413. 8227 IF NOCOMMENTS%<>0 THEN PRINT:PRINT TAB(20);"No comments in file.":
  414.  
  415.     PRINT: GOSUB 4700:
  416.  
  417.     RETURN
  418. 8230 SETUSERNUMBER%=0: GOSUB 300:
  419.  
  420.     OPEN "O", #2, MGRDRIVE$+FNADDSEP$(DATE$,"/")+".CMT"
  421. 8233 COMMENTCOUNT%=0
  422. 8236 PRINT
  423. 8239 FOR COMREC%=2 TO NEXTCOMMENT%-1
  424. 8242    GOSUB 8000    'get a line
  425. 8245    SETUSERNUMBER%=0:GOSUB 300
  426. 8248    IF HEADER%=0 THEN
  427.  
  428.         PRINT #2, COMMENTLINE$
  429.  
  430.         ELSE
  431.  
  432.             PRINT #2,"":
  433.  
  434.             PRINT #2,COMMENTLINE$
  435. 8251 PRINT ".";
  436. 8254 NLINES%=NLINES%+1
  437. 8257 NEXT COMREC%
  438. 8260 PRINT
  439. 8263 CLOSE #2
  440. 8266 PRINT:PRINT TAB(15); COMMENTCOUNT%; "comments, consisting of";NLINES%;:
  441.  
  442.     PRINT TAB(15);     "lines written to the ";
  443.  
  444.     FNADDSEP$(DATE$,"/");".CMT file."
  445. 8269 CLOSE #3
  446. 8272 PRINT:PRINT "These are the archeive COMMENTS files on this disk/user:"
  447. 8275 PRINT:SETUSERNUMBER%=0: GOSUB 300
  448. 8278 FILES MGRDRIVE$+"????????.CMT"
  449. 8281 IF NOFILE%=1 THEN PRINT "No COMMENTS archeives."
  450. 8284 PRINT: GOSUB 4700
  451. 8287 RETURN
  452. 8300 '
  453. 8304 '    display comments from COMMENTFIL$
  454. 8308 '1.1
  455. 8312 GOSUB 3100
  456. 8314 PRINT TAB(10);"Press ^K to abort listing."
  457. 8316 GOSUB 7900    'open COMMENTFILE$
  458. 8320 COMMENTCOUNT%=0
  459. 8324 IF NOCOMMENTS%=1 THEN
  460.  
  461.     PRINT FNLINES$(1); TAB(20);"The COMMENTS file is empty":
  462.  
  463.     PRINT TAB(20);"Total comments: ";TOTALCOMMENTS#-1:
  464.  
  465.     PRINT FNLINES$(2);  :GOSUB 4700:
  466.  
  467.     RETURN
  468. 8328 FOR COMREC%=2 TO NEXTCOMMENT%-1
  469. 8330 IF INKEY$=CHR$(&HB) THEN ABORT%=1 ELSE ABORT%=0
  470. 8332    GOSUB 8000    'get comment line
  471. 8336    IF HEADER%=0 THEN
  472.  
  473.         PRINT COMMENTLINE$
  474.  
  475.         ELSE
  476.  
  477.             PRINT:
  478.  
  479.             PRINT COMMENTLINE$
  480. 8338    IF ABORT%<>0 THEN COMREC%=NEXTCOMMENT%-1
  481. 8340 NEXT COMREC%
  482. 8344 CLOSE #3
  483. 8345 IF ABORT%<>0 THEN PRINT FNLINES$(2); TAB(20); "** aborted **"
  484. 8348 PRINT:PRINT TAB(10);"Number of comments displayed:";COMMENTCOUNT%
  485. 8352 PRINT TAB(10);"    Total number of comments:";TOTALCOMMENTS#-1
  486. 8353 IF ABORT%<>0 THEN PRINT: GOSUB 4700: RETURN
  487. 8356 HEADONLY%=1: GOSUB 7900
  488. 8360 LSET FINEWCOM$="": NEWCOM$=""
  489. 8364 LSET FSYSCOM$="": SYSCOM$=""
  490. 8368 PUT #3,1
  491. 8369 GET #3,2
  492. 8372 CLOSE #3
  493. 8376 PRINT: GOSUB 4700
  494. 8380 RETURN
  495. 8400 '
  496. 8404 '    view a COMMENTS archeive
  497. 8408 '
  498. 8412 NOFILE%=0
  499. 8416 GOSUB 3100
  500. 8420 PRINT:PRINT TAB(10);"These are the available COMMENT archieves:"
  501. 8424 PRINT: SETUSERNUMBER%=0: GOSUB 300:
  502.  
  503.     FILES MGRDRIVE$+"????????.CMT"
  504. 8428 IF NOFILE%<>0 THEN PRINT TAB(20);"No archeives on disk/user.":
  505.  
  506.     PRINT: GOSUB 4700: RETURN
  507. 8432 PRINT:PRINT:PRINT "Type date of archeive to view > ";: MAX%=8:GOSUB 500
  508. 8436 IF NKEY%=0 THEN RETURN
  509. 8440 FIL$=ANSWER$+".CMT": DRIVE$=MGRDRIVE$
  510. 8444 GOSUB 3100
  511. 8448 SWAP USER0%,USERNUMBER%:
  512.  
  513.     GOSUB 800:
  514.  
  515.     SWAP USER0%,USERNUMBER%
  516. 8452 IF NOFILE%<>0 THEN PRINT TAB(20); FIL$;" doesn't exist.":
  517.  
  518.     PRINT: GOSUB 4700: GOTO 8400
  519. 8456 PRINT: GOSUB 4700
  520. 8460 RETURN
  521. 8500 '
  522. 8504 '    remove all comments from COMMENTFILE$
  523. 8508 '
  524. 8512 GOSUB 3100
  525. 8516 GOSUB 7900    'open COMENTFILE$
  526. 8520 OLDTOTAL#=TOTALCOMMENTS#
  527. 8524 IF NOCOMMENTS%<>0  THEN
  528.  
  529.     PRINT:PRINT TAB(20);"There are no comments to delete.":
  530.  
  531.     PRINT:PRINT TAB(20);"Total comments so far:";OLDTOTAL#:
  532.  
  533.     CLOSE #3:
  534.  
  535.     PRINT: GOSUB 4700:
  536.  
  537.     RETURN
  538. 8525 CLOSE #3
  539. 8526 PRINT TAB(10);"Press d to delete current comments."
  540. 8527 MAX%=0: GOSUB 500: IF ANSWER$<>"D" THEN RETURN
  541. 8528 PRINT : PRINT TAB(20);"Removing comments."
  542. 8536 KILL DEFDRIVE$+COMMENTFILE$
  543. 8540 HEADONLY%=1: GOSUB 7900
  544. 8544 LSET COMMENTNUMBER$ = STR$(2)
  545. 8548 LSET TOTCOMMT$ = STR$(OLDTOTAL#)
  546. 8552 LSET COMSIG$="*"
  547. 8556 PUT #3,1
  548. 8560 CLOSE #3
  549. 8564 RETURN
  550. 10000 '
  551. 10010 '    main program starts here
  552. 10020 ' 1.0
  553. 10030 IF SYSOPONLY%=1 THEN GOSUB 5000 ELSE ZRETURN%=1
  554. 10040 IF ZRETURN%=0 THEN PRINT "POSYS?": END
  555. 10050 GOSUB 1100
  556. 10055 GOSUB 8100
  557. 10060 IF NOFILE%<> 0 THEN PRINT "Bad start - See SIGNON.DOC": END
  558. 10070 GOSUB 5100
  559. 10080 IF SELECTION%=17 THEN GOTO 7600
  560. 10090 ON SELECTION% GOSUB 8300,8500,8200,8400,7700
  561. 10100 GOTO 10070
  562. 10110 END
  563. 20000 ' the end
  564. ELECTION%=17 THEN GOTO 7600
  565. 10090 ON SELECTION% GOSUB 8300,8500,8200,8400,7700
  566. 101