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