home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol130 / comgr.bas < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  8.9 KB  |  332 lines
  1. 1 '    signon subsystem -- Comments Manager
  2. 3 VERSION$="1.4 {10/14/82}"    'initial release was 1.00
  3. 5 '    by dick lieber
  4. 6 SYSOPONLY%=0    '0 for anyone, 1 for sysop only
  5. 7 '
  6. 10 USERFILE$=DEFDRIVE$+"USERS"
  7. 11 CALLERFILE$="CALLERS"
  8. 15 LASTCALRFILE$="LASTCALR"
  9. 20 PWDFILE$="pwds"
  10. 21 SYSMGR$="POSYS"
  11. 50 USER0%=0
  12. 65 CRLF$=CHR$(&HA)+CHR$(&HD)
  13. 67 BSTRING$=CHR$(8)+" "+CHR$(8)
  14. 68 COMMENTFILE$="COMMENTS"
  15. 70 DIM ACLARRAY%(5,11)
  16. 71 DIM FLAGS%(14)
  17. 77 ON ERROR GOTO 1000
  18. 80 '
  19. 81 '    function definition
  20. 82 '
  21. 83 '    add deliminators to time or date
  22. 84 DEF FNADDSEP$(DS$,DELIM$)=
  23.     LEFT$(DS$,2)+DELIM$+MID$(DS$,3,2)+DELIM$+RIGHT$(DS$,2)
  24. 85 '    remove date or time deliminators
  25. 86 DEF FNKILLSEP$(DS$)=LEFT$(DS$,2)+MID$(DS$,4,2)+RIGHT$(DS$,2)
  26. 88 '    on-off function
  27. 90 DIM ONOFF$(1)
  28. 91 ONOFF$(0)="Off"
  29. 92 ONOFF$(1)="On"
  30. 93 DEF FNONOFF$(ONOFF%)=ONOFF$(ONOFF%)
  31. 94 DEF FNLINES$(NLINES%)=STRING$(NLINES%,CRLF$)
  32. 199 GOTO 10000
  33. 300 '
  34. 302 '    set user number
  35. 304 '
  36. 306 USERMD=TESTADDRESS+9
  37. 312 CALL USERMD(SETUSERNUMBER%)
  38. 345 RETURN
  39. 400 %include 400500.SSB
  40. 700 '
  41. 705 '    get string into ANSWER$ then CRLF
  42. 710 '
  43. 715 GOSUB 500: PRINT: RETURN
  44. 800 %include 800.SSB
  45. 1000 '
  46. 1004 '    Error handler
  47. 1008 '
  48. 1010 IF ERR=53 THEN NOFILE%=1
  49. 1020 IF ERR = 53 THEN RESUME NEXT    ' file not found
  50. 1030 A$="Error Trap":CR%=2: GOSUB 400
  51. 1040 PRINT "ERR = ";ERR, "ERL = ";ERL
  52. 1050 END
  53. 1100 %include 1100.SSB
  54. 1600 %include 1600.SSB
  55. 3100 '
  56. 3105 '    clear screen
  57. 3110 '
  58. 3115 A$=CLEARSCR$:CR%=1:GOSUB 400: RETURN
  59. 3300 '
  60. 3305 '    make selection
  61. 3310 '
  62. 3315 MAX%=0:GOSUB 500
  63. 3320 IF ANSWER$="" THEN SELECTION%=0: RETURN
  64. 3325 SELECTION%=ASC(ANSWER$)-64
  65. 3327 IF SELECTION% < 0 THEN SELECTION%=0
  66. 3330 RETURN
  67. 4700 '
  68. 4705 '    pause 
  69. 4710 '
  70. 4715 PRINT:PRINT TAB(25);
  71. 4720 LINE INPUT "Press RETURN to continue."; A$
  72. 4725 RETURN
  73. 5000 '
  74. 5005 '    test that user is the SYSOP
  75. 5010 '
  76. 5015 OPEN "I", #1, DEFDRIVE$+LASTCALRFILE$
  77. 5020    INPUT #1, FRNAME$,LNAME$,ACLVL%
  78. 5025 CLOSE #1
  79. 5030 IF FRNAME$+LANME$ = "SYSOP" AND ACLVL% => 9 THEN ZRETURN%=1 
  80.         ELSE ZRETURN%=0
  81. 5035 RETURN
  82. 5100 '
  83. 5105 '    COMMENTFILE$ maintainer - main menu
  84. 5110 '1.2
  85. 5115 GOSUB 3100
  86. 5120 PRINT TAB(30);COMMENTFILE$;" Manager"
  87. 5122 PRINT TAB(22);"Version: ";VERSION$
  88. 5125 PRINT FNLINES$(3); TAB(20);"a    View comments.";
  89. 5130 IF SYSCOM$="*" OR NEWCOM$="*" THEN PRINT " [New ";
  90. 5135 IF SYSCOM$="*" THEN PRINT "system ";
  91. 5140 IF SYSCOM$="*" AND NEWCOM$="*" THEN PRINT "and ";
  92. 5145 IF NEWCOM$="*" THEN PRINT "user ";
  93. 5150 IF SYSCOM$="*" OR NEWCOM$="*" THEN PRINT "comments]" ELSE
  94.     PRINT
  95. 5155 PRINT FNLINES$(1); TAB(20);"b    Delete comments."
  96. 5160 PRINT FNLINES$(1); TAB(20);"c    Make typeable archive of COMMENTS."
  97. 5165 PRINT FNLINES$(1); TAB(20);"d    View a COMMENTS archive file."
  98. 5172 PRINT: PRINT FNLINES$(1); TAB(20);"q    Quit Comments Manager."
  99. 5173 PRINT FNLINES$(1); TAB(20);"r    Jump back to Signon Manager."
  100. 5175 PRINT FNLINES$(3); TAB(20);"Press letter of your choice > ";
  101. 5180 GOSUB 3300
  102. 5190 RETURN
  103. 5300 '
  104. 5304 '    exit subsystem manager
  105. 5308 '
  106. 5310 SETUSERNUMBER%=0:GOSUB 300
  107. 5316 END
  108. 7500 '
  109. 7503 '    get a line from the COMMENTFILE$
  110. 7506 ' 1.1
  111. 7507 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  112. 7510    GET #3, COMREC%
  113. 7515    COMMENTLINE$=COMMENT$
  114. 7517    IF RIGHT$(COMMENTLINE$,1)=" " THEN
  115.         COMMENTLINE$=LEFT$(COMMENTLINE$,LEN(COMMENTLINE$)-1):
  116.         GOTO 7517
  117. 7521    IF LEFT$(COMMENTLINE$,1)="~" THEN
  118.         COMMENTLINE$=RIGHT$(COMMENTLINE$,LEN(COMMENTLINE$)-1):
  119.         COMMENTCOUNT%=COMMENTCOUNT%+1:
  120.         HEADER%=1
  121.         ELSE
  122.         HEADER%=0
  123. 7540 RETURN
  124. 7600 '
  125. 7605 '    leave comments manager
  126. 7610 '
  127. 7612 SETUSERNUMBER%=0: GOSUB 300
  128. 7615 END
  129. 7700 '
  130. 7704 '    jumpout to posys
  131. 7708 '
  132. 7710 SETUSERNUMBER%=0: GOSUB 300
  133. 7712 JUMPFILE$=SYSMGR$
  134. 7716 GOSUB 7800
  135. 7720 RETURN
  136. 7800 %include 7800.SSB
  137. 7900 '
  138. 7905 '    open comments file
  139. 7910 '    get comment parameters from header
  140. 7915 '    1.7
  141. 7916 CLOSE
  142. 7920 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  143. 7925 OPEN "R", #3, DEFDRIVE$+COMMENTFILE$, 66
  144. 7930 FIELD #3,
  145.     5 AS COMMENTNUMBER$,
  146.     8 AS TOTCOMMT$,
  147.     1 AS COMSIG$,
  148.     6 AS FCOMDATE$,
  149.     6 AS FCOMTIME$,
  150.     1 AS FINEWCOM$,
  151.     1 AS FSYSCOM$
  152. 7935 GET #3,1
  153. 7940 NEXTCOMMENT%=VAL(COMMENTNUMBER$)
  154. 7945 TOTALCOMMENTS#=VAL(TOTCOMMT$)
  155. 7950 COMTIME$=FCOMTIME$
  156. 7955 NEWCOM$=FINEWCOM$
  157. 7960 COMDATE$=FCOMDATE$
  158. 7965 SYSCOM$=FSYSCOM$
  159. 7975 IF COMSIG$<>"*" THEN 
  160.     NEXTCOMMENT%=2:
  161.     TOTALCOMMENTS#=1:
  162.     GOSUB 1600:
  163.     COMTIME$=TIME$:
  164.     COMDATE$=DATE$:
  165.     NOCOMMENTS%=1
  166. 7977 IF NEXTCOMMENT%=2 THEN NOCOMMENTS%=1
  167. 7980 FIELD #3, 64 AS COMMENT$
  168. 7985 RETURN
  169. 8000 '
  170. 8010 '    this is usually where the send a comment to SYSOP by the system
  171. 8020 '    goes, however you don't need that in COMGR
  172. 8030 '
  173. 8040 RETURN
  174. 8100 '
  175. 8104 '    check for new comments
  176. 8108 '
  177. 8110 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  178. 8112 OPEN "R", #3,DEFDRIVE$+COMMENTFILE$, 66
  179. 8116 FIELD #3,
  180.     5 AS COMMENTNUMBER$,
  181.     8 AS TOTCOMMT$,
  182.     1 AS COMSIG$,
  183.     6 AS FCOMDATE$,
  184.     6 AS FCOMTIME$,
  185.     1 AS FINEWCOM$,
  186.     1 AS FSYSCOM$
  187. 8117 GET #3,1
  188. 8120 IF COMSIG$="*" THEN
  189.     NEWCOM$=FINEWCOM$:
  190.     SYSCOM$=FSYSCOM$
  191. 8124 CLOSE #3
  192. 8128 RETURN
  193. 8200 '
  194. 8203 '    write COMMENTFILE$ to a comments archive file
  195. 8206 '    named DATE.CMT
  196. 8209 '1.1
  197. 8212 GOSUB 1600
  198. 8215 GOSUB 3100
  199. 8218 PRINT:PRINT TAB(15);
  200.     "Making an archive of any comments in the file COMMENTS."
  201. 8221 PRINT:PRINT TAB(15);
  202.     "The new file will be ";mgrdrive$+FNADDSEP$(DATE$,"/");".CMT"
  203. 8224 GOSUB 7900
  204. 8227 IF NOCOMMENTS%<>0 THEN PRINT:PRINT TAB(20);"No comments in file.":
  205.     PRINT: GOSUB 4700:
  206.     RETURN
  207. 8230 SETUSERNUMBER%=0: GOSUB 300:
  208.     OPEN "O", #2, MGRDRIVE$+FNADDSEP$(DATE$,"/")+".CMT"
  209. 8233 COMMENTCOUNT%=0
  210. 8236 PRINT
  211. 8239 FOR COMREC%=2 TO NEXTCOMMENT%-1
  212. 8242    GOSUB 7500    'get a line
  213. 8245    SETUSERNUMBER%=0:GOSUB 300
  214. 8248    IF HEADER%=0 THEN
  215.         PRINT #2, COMMENTLINE$
  216.         ELSE
  217.             PRINT #2,"":
  218.             PRINT #2,COMMENTLINE$
  219. 8251 PRINT ".";
  220. 8254 NLINES%=NLINES%+1
  221. 8257 NEXT COMREC%
  222. 8260 PRINT
  223. 8263 CLOSE #2
  224. 8266 PRINT:PRINT TAB(15); COMMENTCOUNT%; "comments, consisting of";NLINES%;:
  225.     PRINT TAB(15);     "lines written to the ";
  226.     FNADDSEP$(DATE$,"/");".CMT file."
  227. 8269 CLOSE #3
  228. 8272 PRINT:PRINT "These are the archive COMMENTS files on drive ";MGRDRIVE$;":"
  229. 8275 PRINT:SETUSERNUMBER%=0: GOSUB 300
  230. 8278 FILES MGRDRIVE$+"????????.CMT"
  231. 8281 IF NOFILE%=1 THEN PRINT "No COMMENTS archives."
  232. 8284 PRINT: GOSUB 4700
  233. 8287 RETURN
  234. 8300 '
  235. 8304 '    display comments from COMMENTFIL$
  236. 8308 '1.21
  237. 8312 GOSUB 3100
  238. 8314 PRINT TAB(10);"Press ^K to abort listing."
  239. 8316 GOSUB 7900    'open COMMENTFILE$
  240. 8320 COMMENTCOUNT%=0
  241. 8321 IF NOCOMMENTS%=1 THEN
  242.     PRINT FNLINES$(1); TAB(20);"The COMMENTS file is empty":
  243.     PRINT TAB(20);"Total comments: ";TOTALCOMMENTS#-1:
  244.     PRINT FNLINES$(2);  :GOSUB 4700:
  245.     RETURN
  246. 8322 FOR COMREC%=2 TO NEXTCOMMENT%-1
  247. 8323 KEY$=INKEY$
  248. 8325 IF KEY$=CHR$(&HB) THEN ABORT%=1 ELSE ABORT%=0
  249. 8326 IF KEY$="S" OR KEY$="s" OR KEY$=CHR$(19) THEN PAUSE%=1 ELSE PAUSE%=0
  250. 8328 IF PAUSE%<>0 THEN IF INKEY$="" THEN GOTO 8328
  251. 8332    GOSUB 7500    'get comment line
  252. 8336    IF HEADER%=0 THEN
  253.         PRINT COMMENTLINE$
  254.         ELSE
  255.             PRINT:
  256.             PRINT COMMENTLINE$
  257. 8338    IF ABORT%<>0 THEN COMREC%=NEXTCOMMENT%-1
  258. 8340 NEXT COMREC%
  259. 8344 CLOSE #3
  260. 8345 IF ABORT%<>0 THEN PRINT FNLINES$(2); TAB(20); "** aborted **"
  261. 8348 PRINT:PRINT TAB(10);"Number of comments displayed:";COMMENTCOUNT%
  262. 8352 PRINT TAB(10);"    Total number of comments:";TOTALCOMMENTS#-1
  263. 8353 IF ABORT%<>0 THEN PRINT: GOSUB 4700: RETURN
  264. 8356 HEADONLY%=1: GOSUB 7900
  265. 8360 LSET FINEWCOM$="": NEWCOM$=""
  266. 8364 LSET FSYSCOM$="": SYSCOM$=""
  267. 8368 PUT #3,1
  268. 8369 GET #3,2
  269. 8372 CLOSE #3
  270. 8376 PRINT: GOSUB 4700
  271. 8380 RETURN
  272. 8400 '
  273. 8404 '    view a COMMENTS archive
  274. 8408 '1.1
  275. 8412 NOFILE%=0
  276. 8416 GOSUB 3100
  277. 8420 PRINT:PRINT TAB(10);"These are the available COMMENT archives:"
  278. 8424 PRINT: SETUSERNUMBER%=0: GOSUB 300:
  279.     FILES MGRDRIVE$+"????????.CMT"
  280. 8428 IF NOFILE%<>0 THEN PRINT TAB(20);"No archives on disk/user.":
  281.     PRINT: GOSUB 4700: RETURN
  282. 8432 PRINT:PRINT:PRINT "Type date of archive to view > ";: MAX%=8:GOSUB 500
  283. 8436 IF NKEY%=0 THEN RETURN
  284. 8440 FIL$=ANSWER$+".CMT": DRIVE$=MGRDRIVE$
  285. 8444 GOSUB 3100
  286. 8448 SWAP USER0%,USERNUMBER%:
  287.     GOSUB 800:
  288.     SWAP USER0%,USERNUMBER%
  289. 8452 IF NOFILE%<>0 THEN PRINT TAB(20); FIL$;" doesn't exist.":
  290.     PRINT: GOSUB 4700: GOTO 8400
  291. 8456 PRINT: GOSUB 4700
  292. 8457 GOTO 8400
  293. 8500 '
  294. 8504 '    remove all comments from COMMENTFILE$
  295. 8508 '1.1
  296. 8512 GOSUB 3100
  297. 8516 GOSUB 7900    'open COMENTFILE$
  298. 8520 OLDTOTAL#=TOTALCOMMENTS#
  299. 8524 IF NOCOMMENTS%<>0  THEN
  300.     PRINT:PRINT TAB(20);"There are no comments to delete.":
  301.     PRINT:PRINT TAB(20);"Total comments so far:";OLDTOTAL#:
  302.     CLOSE #3:
  303.     PRINT: GOSUB 4700:
  304.     RETURN
  305. 8525 CLOSE #3
  306. 8526 PRINT TAB(10);"Press d to delete current comments."
  307. 8527 MAX%=0: GOSUB 500: IF ANSWER$<>"D" THEN RETURN
  308. 8528 PRINT : PRINT TAB(20);"Removing comments."
  309. 8536 KILL DEFDRIVE$+COMMENTFILE$
  310. 8540 GOSUB 7900
  311. 8544 LSET COMMENTNUMBER$ = STR$(2)
  312. 8548 LSET TOTCOMMT$ = STR$(OLDTOTAL#)
  313. 8552 LSET COMSIG$="*"
  314. 8556 PUT #3,1
  315. 8560 CLOSE #3
  316. 8564 RETURN
  317. 10000 '
  318. 10010 '    main program starts here
  319. 10020 ' 1.2
  320. 10025 GOSUB 1100
  321. 10030 IF SYSOPONLY%=1 THEN GOSUB 5000 ELSE ZRETURN%=1
  322. 10040 IF ZRETURN%=0 THEN PRINT "COMGR?": END
  323. 10055 GOSUB 8100
  324. 10060 IF NOFILE%<> 0 THEN PRINT "Bad start - See SIGNON.DOC": END
  325. 10070 GOSUB 5100
  326. 10080 IF SELECTION%=17 THEN GOTO 7600
  327. 10085 IF SELECTION%=18 THEN GOSUB 7700
  328. 10090 ON SELECTION% GOSUB 8300,8500,8200,8400
  329. 10100 GOTO 10070
  330. 10110 END
  331. 20000 ' the end
  332.