home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol130 / posys.bas < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  16.7 KB  |  601 lines
  1. 1 '    signon subsystem -- Subsystem Manager
  2. 3 VERSION$="1.4 {10/14/82}"    '1.01 was initial release
  3. 5 '    by dick lieber
  4. 7 '
  5. 9 DEFDRIVE$="A:"
  6. 10 USERFILE$="USERS"
  7. 11 CALLERFILE$="CALLERS"
  8. 15 LASTCALRFILE$="LASTCALR"
  9. 16 COMMENTMGR$="COMGR"
  10. 17 USERMAINT$="USRMAINT"
  11. 18 COMMENTFILE$="COMMENTS"
  12. 20 PWDFILE$="pwds"
  13. 50 USER0%=0
  14. 67 BSTRING$=CHR$(8)+" "+CHR$(8)
  15. 68 CRLF$=CHR$(&HA)+CHR$(&HD)
  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.     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. 95 DEF FNHOURS$(TIME)=STR$(INT(TIME/60))+":"+
  34.     RIGHT$("00"+MID$(STR$(TIME-(INT(TIME/60)*60)),2),2)
  35. 199 GOTO 10000
  36. 200 %include 200.SSB
  37. 300 '
  38. 302 '    set user number
  39. 304 '
  40. 306 USERMD=TESTADDRESS+9
  41. 312 CALL USERMD(SETUSERNUMBER%)
  42. 345 RETURN
  43. 400 %include 400500.SSB
  44. 600 %include 600.SSB
  45. 700 '
  46. 705 '    get string into ANSWER$ then CRLF
  47. 710 '
  48. 715 GOSUB 500: PRINT: RETURN
  49. 800 %include 800.SSB
  50. 1000 '
  51. 1004 '    error handler
  52. 1008 '1.1
  53. 1010 IF ERR=53 THEN NOFILE%=1: RESUME NEXT
  54. 1012 A$="Error Trap":CR%=2: GOSUB 400
  55. 1020 PRINT "ERR = ";ERR, "ERL = ";ERL
  56. 1028 END
  57. 1100 %include 1100.SSB
  58. 1200 '
  59. 1204 ' find name - get record
  60. 1208 ' 1.2
  61. 1211 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  62. 1212 NOTFOUND%=0
  63. 1216 REC%=2
  64. 1220 LAST$=SPACE$(14): FIRST$=RIGHT$(LAST$,10)
  65. 1224 LSET FIRST$=FRNAME$: LSET LAST$=LNAME$
  66. 1228    GET #1,REC%
  67. 1232    IF EOF(1) THEN NOTFOUND%=1:RETURN
  68. 1234    IF REC%=NEXTUSER THEN NOTFOUND%=1: RETURN
  69. 1236    IF FFNAME$=FIRST$ AND FLNAME$=LAST$ THEN GOSUB 1300: RETURN
  70. 1240    REC%=REC%+1
  71. 1244 GOTO 1228
  72. 1300 %include 1300.SSB
  73. 1400 %include 1400.SSB
  74. 1600 %include 1600.SSB
  75. 1700 '
  76. 1705 '    set default values to working individual variables
  77. 1710 ' 1.0
  78. 1715 ACLVL%=0
  79. 1720 SIGCNT=0
  80. 1725 NEWCOMER%=0
  81. 1730 SYSOP%=0
  82. 1735 PWD$= STRING$(13,42) ' *s
  83. 1740 LOCATION$=""
  84. 1745 LTIME$=""
  85. 1750 LDATE$=""
  86. 1755 ELAPTIME%=0
  87. 1760 TOTALTIME=0
  88. 1765 NOTATION$="normal"
  89. 1766 EXPERT%=0
  90. 1767 OLDUSER%=0
  91. 1770 RETURN
  92. 1800 '
  93. 1804 '    choose a password
  94. 1808 '
  95. 1811 OLDPWD$=PWD$
  96. 1812 PRINT
  97. 1816 A$="Choose a password.   It may be any":CR%=2:GOSUB 400
  98. 1820 A$="combination of characters, except RETURN and may":GOSUB 400
  99. 1824 A$="be up to 13 characters in length.":GOSUB 400
  100. 1828 A$="Press RETURN after typing your password.":GOSUB 400
  101. 1832 PRINT
  102. 1836 A$="    > ":CR%=1:GOSUB 400
  103. 1840 MAX%=13
  104. 1844 GOSUB 600
  105. 1845 IF NKEY%=0 THEN PWD$=OLDPWD$: RETURN
  106. 1848 PWD$=ANSWER$
  107. 1852 PRINT
  108. 1856 IF PWD$=STRING$(13,42) THEN A$="Sorry that password isn't allowed.":
  109.             CR%=2:GOSUB 400: GOTO 1812
  110. 1860 A$="To make sure, type it again.":CR%=2:GOSUB 400
  111. 1864 A$="    > ":CR%=1:GOSUB 400
  112. 1868 GOSUB 600
  113. 1872 PRINT
  114. 1876 IF PWD$<>ANSWER$ THEN A$="They don't match.": GOSUB 400: GOTO 1812
  115. 1880 PRINT
  116. 1884 A$="        ok":CR%=2:GOSUB 400
  117. 1886 CHANGED%=1
  118. 1888 RETURN
  119. 2500 %include 2500.SSB
  120. 3100 '
  121. 3105 '    clear screen
  122. 3110 '
  123. 3115 A$=CLEARSCR$:CR%=1:GOSUB 400: RETURN
  124. 3120 '
  125. 3125 '    check authorization level of user
  126. 3130 ' 1.0
  127. 3131 PRINT "3131 you shouldm't be here!":END
  128. 3132 SETUSERNUMBER%=0: GOSUB 300
  129. 3135 OPEN "I", #1, DEFDRIVE$+LASTCALRFILE$
  130. 3140 INPUT #1, FRNAME$, LNAME$, ACLVL%
  131. 3145 CLOSE #1
  132. 3150 IF ACLVL% < AUTHLEVEL% THEN 3980
  133. 3155 RETURN
  134. 3300 '
  135. 3305 '    make selection
  136. 3310 '
  137. 3315 MAX%=0:GOSUB 500
  138. 3320 IF ANSWER$="" THEN SELECTION%=0: RETURN
  139. 3325 SELECTION%=ASC(ANSWER$)-64
  140. 3327 IF SELECTION% < 0 THEN SELECTION%=0
  141. 3330 RETURN
  142. 3600 '
  143. 3605 '    display working record
  144. 3610 '1.4    'POSYS only version
  145. 3615 PRINT
  146. 3635 PRINT TAB(15);"a   First Name: "; FRNAME$
  147. 3640 PRINT TAB(15);"b    Last Name: "; LNAME$
  148. 3645 PRINT TAB(15);"c Access Level: "; :
  149.     IF ACLVL%=-1 THEN PRINT "TWIT" ELSE PRINT ACLVL%
  150. 3650 PRINT TAB(15);"d     Location: "; LOCATION$
  151. 3655 PRINT TAB(15);"e Last Date On: "; FNADDSEP$(LASTDATE$,"/")
  152. 3660 PRINT TAB(15);"f Last Time On: ";
  153.     FNADDSEP$(LASTTIME$,":");" for";FNHOURS$(ELAPTIME%);" hr:mn."
  154. 3665 PRINT TAB(15);
  155.     "g        Usage: "; SIGCNT;" signons in";FNHOURS$(TOTALTIME);" hr:mn"
  156. 3670 PRINT TAB(15);"h     Password: ";
  157. 3675 IF PWD$=STRING$(13,42) THEN PRINT STRING$(13,&H2D) 
  158.         ELSE PRINT STRING$(13,42)
  159. 3680 RETURN
  160. 3900 '
  161. 3904 '    display list of callers
  162. 3908 '1.5    #
  163. 3912 GOSUB 3100    'clear
  164. 3916 NOFILE%=0
  165. 3920 GOSUB 8600    'open CALLERFILE$
  166. 3924 IF NOFILE<>0 THEN
  167.     PRINT:PRINT TAB(20);"No ";CALLERFILE$;".":
  168.     CLOSE #3:
  169.     GOSUB 4700:
  170.     RETURN
  171. 3928 PRINT "Press ^K to abort listing."
  172. 3932 PRINT "Total number of callers: ";LOGCNT#;
  173. 3936 IF NEXTRECORD=1 THEN PRINT TAB(20); CALLERFILE$;" empty."
  174. 3940 PRINT:PRINT:PRINT
  175.     "caller        name            time-date      minutes   notation"
  176. 3944 FOR I=NEXTRECORD-1 TO 1 STEP -1
  177. 3952    GET #3, I+1
  178. 3956    DFNAME$=CFNAME$:DLNAME$=CLNAME$: ELAPTIME%=VAL(CTIMEON$)
  179. 3960    IF RIGHT$(DFNAME$,1)=" " THEN DFNAME$=LEFT$(DFNAME$,LEN(DFNAME$)-1):
  180.         GOTO 3960
  181. 3964    IF RIGHT$(DLNAME$,A)=" " THEN DLANME$=LEFT$(DLNAME$,LEN(DLNAME$)-1):
  182.         GOTO 3964
  183. 3968    PRINT USING "#### \                  \ & &    ###       &";
  184.         I;DFNAME$+" "+DLNAME$;
  185.         FNADDSEP$(CDATE$,"/");FNADDSEP$(CTIME$,":");ELAPTIME%;CNOTATION$
  186. 3969    KEY$=INKEY$: IF KEY$="S" OR KEY$="s" OR KEY$=CHR$(&H13)
  187.     THEN PAUSE%=1 ELSE PAUSE%=0
  188. 3970    IF KEY$=CHR$(&HB) THEN ABORT%=1: GOTO 3976
  189.         ELSE ABORT%=0
  190. 3971    IF PAUSE%<>0 AND LEN(INKEY$)=0 THEN GOTO 3971
  191. 3972 NEXT I
  192. 3976 CLOSE 3
  193. 3980 IF ABORT%<>0 THEN PRINT:PRINT TAB(30);"** Aborted **"
  194. 3984 GOSUB 4700    'pause
  195. 3988 RETURN
  196. 4700 '
  197. 4705 '    pause 
  198. 4710 '
  199. 4715 PRINT:PRINT TAB(25);
  200. 4720 LINE INPUT "Press RETURN to continue."; A$
  201. 4725 RETURN
  202. 5000 '
  203. 5005 '    test that user is the SYSOP
  204. 5010 '
  205. 5015 OPEN "I", #1, DEFDRIVE$+LASTCALRFILE$
  206. 5020    INPUT #1, FRNAME$,LNAME$,ACLVL%
  207. 5025 CLOSE #1
  208. 5030 IF FRNAME$+LANME$ = "SYSOP" AND ACLVL% => 9 THEN ZRETURN%=1 
  209.         ELSE ZRETURN%=0
  210. 5035 RETURN
  211. 5100 '
  212. 5104 '    Subsystem Manager - Main menu
  213. 5108 ' 1.5
  214. 5112 GOSUB 3100
  215. 5116 PRINT
  216. 5120 PRINT TAB(30);"Signon Subsystem Manager"
  217. 5124 PRINT TAB(30);"<version ";VERSION$;">"
  218. 5128 PRINT
  219. 5132 PRINT TAB(20);"a    Maintain comments.";
  220. 5136 IF SYSCOM$="*" OR NEWCOM$="*" THEN PRINT " [New ";
  221. 5140 IF SYSCOM$="*" THEN PRINT "system ";
  222. 5144 IF SYSCOM$="*" AND NEWCOM$="*" THEN PRINT "and ";
  223. 5148 IF NEWCOM$="*" THEN PRINT "user ";
  224. 5152 IF SYSCOM$="*" OR NEWCOM$="*" THEN PRINT "comments]" ELSE
  225.     PRINT
  226. 5156 PRINT TAB(20);"b    Display the roster of users."
  227. 5160 PRINT TAB(20);"c    Display list of callers."
  228. 5164 PRINT TAB(20);"d    Update ";USERFILE$;" file."
  229. 5168 PRINT TAB(20);"e    Enter/Edit a user's record."
  230. 5172 PRINT TAB(20);"f    Maintain ";CALLERFILE$;" file."
  231. 5176 PRINT TAB(20);"g    Configure subsystem."
  232. 5180 PRINT TAB(20);"h    Time of day"
  233. 5182 PRINT:PRINT TAB(20);"q    Leave subsystem manager."
  234. 5184 PRINT:PRINT TAB(25);"Press the letter of your selection > ";
  235. 5188 GOSUB 3300    'selector
  236. 5192 RETURN
  237. 5300 '
  238. 5304 '    exit subsystem manager
  239. 5308 '
  240. 5310 SETUSERNUMBER%=0:GOSUB 300
  241. 5316 END
  242. 5500 '
  243. 5505 '    initialize Subsystem manager variables
  244. 5510 '
  245. 5515 CHANGED%=0
  246. 5520 RETURN
  247. 6000 '
  248. 6005 '    get users first and last name
  249. 6010 '1.1 modified 11/16/82 by Jim Mills
  250. 6014 ABORT%=0
  251. 6015 GOSUB 3100
  252. 6016 PRINT FNLINES$(2); TAB(25);"Just press RETURN at firstname for main menu."
  253. 6017 PRINT FNLINES$(2); TAB(25);"or enter a record number (ie: 23)"
  254. 6020 MAX%=20:LNAME$=""        'bug fix 11/16/82
  255. 6025 PRINT FNLINES$(2)
  256. 6026 PRINT TAB(20);"First Name > ";: GOSUB 700: FRNAME$=ANSWER$
  257. 6027 IF NKEY%=0 THEN ABORT%=1: RETURN
  258. 6028 REM was: IF LEFT$(ANSWER$,1)="#" 
  259. 6029 REM was: THEN REC%=VAL(RIGHT$(ANSWER$,LEN(ANSWER$)-1))+1
  260. 6030 IF VAL(ANSWER$)<>0 THEN REC%=VAL(ANSWER$)+1
  261.         :IF REC%<2 THEN REC%=2: RETURN ELSE RETURN
  262. 6031 REC%=0
  263. 6033 IF FRNAME$="SYSOP" THEN LNAME$="": RETURN
  264. 6035 PRINT FNLINES$(2)
  265. 6040 PRINT TAB(20);
  266. 6042 A$="Last Name > ": GOSUB 400: GOSUB 700: LNAME$=ANSWER$
  267. 6045 IF LNAME$="" THEN 6000
  268. 6050 RETURN
  269. 6100 '
  270. 6104 '    individual users
  271. 6108 '1.0
  272. 6109 ADDREC%=0
  273. 6110 GOSUB 1400
  274. 6112 GOSUB 6000    : IF ABORT%=1 THEN CLOSE #1: RETURN
  275. 6113 TRYAGAIN%=0
  276. 6116 IF REC%=0 THEN GOSUB 1200 ELSE GOSUB 7200    'search on name or get number
  277. 6117 IF TRYAGAIN%=1 THEN GOTO 6112
  278. 6118 IF NOTFOUND% <> 0 THEN GOSUB 6400 ELSE GOSUB 1300
  279. 6119 IF TRYAGAIN%=1  THEN GOTO 6112
  280. 6120 GOSUB 6200    'editor
  281. 6130 GOSUB 200
  282. 6140 GOTO 6100
  283. 6200 '
  284. 6204 '    user editor
  285. 6208 '
  286. 6212 GOSUB 3100
  287. 6214 DATE$=LASTDATE$: TIME$=LASTTIME$
  288. 6216 PRINT FNLINES$(2)
  289. 6217 IF DELETED%<>0 THEN GOTO 6260
  290. 6220 GOSUB 3600    'display user
  291. 6225 PRINT FNLINES$(2); TAB(15);"i    Delete record."
  292. 6226 PRINT TAB(15);"j    Display/Edit flags."
  293. 6228 PRINT FNLINES$(2);TAB(25);"Type letter of line to change > ";
  294. 6232 GOSUB 3300    'selector
  295. 6233 IF SELECTION%=0 THEN RETURN
  296. 6239 PRINT FNLINES$(4); TAB(20);
  297. 6240 ON SELECTION% GOSUB 6303,6307,6311,6316,6320,6320,6320,6332,6250,
  298.     6600
  299. 6244 GOTO 6200
  300. 6250 DELETED%=1: RETURN
  301. 6260 PRINT TAB(20);FRNAME$+" "+LNAME$+"'s "+
  302.         "record is deleted."
  303. 6263 PRINT FNLINES$(3); TAB(20);"a    Undelete this record."
  304. 6266 PRINT FNLINES$(2); TAB(20);"b    Leave deleted."
  305. 6269 PRINT FNLINES$(2); TAB(20);"Type letter > ";
  306. 6272 GOSUB 3300
  307. 6275 IF SELECTION%=1 THEN DELETED%=0: GOTO 6200
  308. 6278 RETURN
  309. 6300 '
  310. 6301 '    user editor subroutines
  311. 6302 '1.1    '#
  312. 6303 PRINT "Type new first name > ";
  313. 6304 MAX%=20: GOSUB 500: IF NKEY%=0 THEN RETURN
  314. 6305 FRNAME$=ANSWER$
  315. 6306 RETURN
  316. 6307 PRINT "Type new last name > ";
  317. 6308 MAX%=20: GOSUB 500: IF NKEY%=0 THEN RETURN
  318. 6309 LNAME$=ANSWER$
  319. 6310 RETURN
  320. 6311 PRINT "Type T to flag user as a twit or":
  321.     PRINT TAB(20);"Enter new access level number > ";
  322. 6312 MAX%=2: GOSUB 500: IF NKEY%=0 THEN RETURN
  323. 6313 IF LEFT$(ANSWER$,4)="T" THEN ACLVL%=-1: RETURN
  324. 6314 ACLVL%=VAL(ANSWER$)
  325. 6315 RETURN
  326. 6316 PRINT "Type new location > ";
  327. 6317 MAX%=20: GOSUB 500: IF NKEY%=0 THEN RETURN
  328. 6318 LOCATION$=ANSWER$
  329. 6319 RETURN
  330. 6320 PRINT "Sorry, you can't change that."
  331. 6321 MAX%=0: GOSUB 500
  332. 6322 RETURN
  333. 6328 RETURN
  334. 6332 GOSUB 3100
  335. 6333 PRINT FNLINES$(3):  IF ACLVL% <= PWDACL% AND PWD$=STRING$(13,42)
  336.         THEN GOTO 6390
  337. 6334 PRINT TAB(25);"a    Choose a new password."
  338. 6335 PRINT TAB(25);"b    Delete password "
  339. 6336 PRINT TAB(25);"    ("+FRNAME$+" "+LNAME$+" will have to choose"
  340. 6337 PRINT TAB(25);"     a new one.)"
  341. 6338 PRINT TAB(25);"c    Leave current password unchanged."
  342. 6339 PRINT FNLINES$(3); TAB(30);"Type selection letter > ";
  343. 6340 GOSUB 3300    'selector
  344. 6341 IF SELECTION%=1 THEN GOSUB 3100:PRINT:PRINT:
  345.         GOSUB 1800: RETURN
  346. 6342 IF SELECTION%=2 THEN PWD$=STRING$(13,42)
  347. 6343 RETURN
  348. 6390 PRINT USING "        & ## & ";
  349.     "Access levels thru";PWDACL%
  350. 6392 PRINT
  351. 6394 PRINT TAB(20);"don't require passwords."
  352. 6396 PRINT FNLINES$(2): GOSUB 4700
  353. 6397 RETURN
  354. 6400 '
  355. 6404 '    ask if new user is ok
  356. 6408 '1.1
  357. 6412 GOSUB 3100
  358. 6420 PRINT FNLINES$(4); TAB(20);FRNAME$+" "+LNAME$+" is not a current user."
  359. 6428 PRINT FNLINES$(3); TAB(20);"a    Enter into the system"
  360. 6432 PRINT TAB(20);"b    Try another name."
  361. 6436 GOSUB 3300    'selection
  362. 6444 IF SELECTION%=2 THEN TRYAGAIN%=1
  363. 6447 GOSUB 1700
  364. 6448 IF SELECTION%=1 THEN REC%=NEXTUSER: ADDREC%=1
  365. 6499 RETURN
  366. 6500 '
  367. 6503 '    remove deleted records -- make archive
  368. 6506 ' 1.3
  369. 6507 SETUSERNUMBER%=0: GOSUB 300
  370. 6510 JUMPFILE$=USERMAINT$
  371. 6525 GOSUB 7800
  372. 6550 RETURN
  373. 6600 '
  374. 6604 '    display/edit user's flags
  375. 6608 '1.1
  376. 6612 GOSUB 3100
  377. 6616 PRINT FNLINES$(2)
  378. 6620 PRINT TAB(30);FRNAME$;" ";LNAME$
  379. 6624 PRINT FNLINES$(3)
  380. 6628 PRINT TAB(15);"a        Expert: ";FNONOFF$(EXPERT%)
  381. 6632 PRINT TAB(15);"b      Old User: ";FNONOFF$(OLDUSER%)
  382. 6636 PRINT TAB(15);"c Need Location: ";FNONOFF$(NEEDLOC%)
  383. 6640 PRINT FNLINES$(3)
  384. 6644 PRINT TAB(20);"Press letter to change > ";
  385. 6648 GOSUB 3300
  386. 6652 IF SELECTION%=0 THEN RETURN
  387. 6656 ON SELECTION% GOSUB 6664,6676,6684
  388. 6660 GOTO 6600
  389. 6664 IF ACLVL% < PWDACL% AND EXPERT%=0 THEN PRINT FNLINES$(2):
  390.     PRINT TAB(30);"User's with access levels lower than";PWDACL%+1:
  391.     PRINT TAB(30);"cannot be experts.": GOSUB 4700: RETURN
  392. 6668 IF EXPERT%=0 THEN EXPERT%=1 ELSE EXPERT%=0
  393. 6672 RETURN
  394. 6676 IF OLDUSER%=0 THEN OLDUSER%=1 ELSE OLDUSER%=0
  395. 6680 RETURN
  396. 6684 IF NEEDLOC%=0 THEN NEEDLOC%=1 ELSE NEEDLOC%=0
  397. 6688 RETURN
  398. 7200 '
  399. 7204 '    get a user by record number
  400. 7208 '1.1
  401. 7209 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  402. 7212 GET #1, REC%
  403. 7216 IF NOT EOF(1) THEN RETURN
  404. 7255 TRYAGAIN%=1
  405. 7257 NOTFOUND%=1
  406. 7260 GOSUB 3100
  407. 7268 PRINT FNLINES$(4);  TAB(25);"Record number";REC%-1;" does not exist."
  408. 7270 PRINT:PRINT TAB(25);"Use option 'b' from the main menu to see the"
  409. 7274 PRINT:PRINT TAB(25);"roster of users."
  410. 7276 PRINT FNLINES$(3)
  411. 7280 GOSUB 4700
  412. 7290 RETURN
  413. 7600 '
  414. 7605 '    jumpout to configurator
  415. 7610 '
  416. 7615 SETUSERNUMBER%=0: GOSUB 300
  417. 7620 JUMPFILE$="CONFIG"
  418. 7625 GOSUB 7800
  419. 7630 RETURN
  420. 7700 '
  421. 7705 '    jumpout to comments manager
  422. 7710 '
  423. 7712 SETUSERNUMBER%=0: GOSUB 300
  424. 7715 JUMPFILE$=COMMENTMGR$
  425. 7720 GOSUB 7800
  426. 7725 RETURN
  427. 7800 %include 7800.SSB
  428. 8000 '
  429. 8010 '    dummy
  430. 8020 '    no system comments needed
  431. 8030 '
  432. 8040 RETURN
  433. 8100 '
  434. 8104 '    check for new comments
  435. 8108 '
  436. 8110 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  437. 8112 OPEN "R", #3,DEFDRIVE$+COMMENTFILE$, 66
  438. 8116 FIELD #3,
  439.     5 AS COMMENTNUMBER$,
  440.     8 AS TOTCOMMT$,
  441.     1 AS COMSIG$,
  442.     6 AS FCOMDATE$,
  443.     6 AS FCOMTIME$,
  444.     1 AS FINEWCOM$,
  445.     1 AS FSYSCOM$
  446. 8117 GET #3,1
  447. 8120 IF COMSIG$="*" THEN
  448.     NEWCOM$=FINEWCOM$:
  449.     SYSCOM$=FSYSCOM$
  450. 8124 CLOSE #3
  451. 8128 RETURN
  452. 8500 '
  453. 8504 '    maintain CALLERFILE$
  454. 8508 '
  455. 8512 GOSUB 3100
  456. 8516 PRINT TAB(30);CALLERFILE$;" Manager"
  457. 8524 PRINT FNLINES$(4); TAB(20);"a    view callers log."
  458. 8528 PRINT FNLINES$(2); TAB(20);"b    Make archive of current callers."
  459. 8532 PRINT FNLINES$(2); TAB(20);"c    Delete current callers from log."
  460. 8536 PRINT FNLINES$(2); TAB(20);"d    View an archive callers log."
  461. 8540 PRINT FNLINES$(3); TAB(20);"Press letter of your choice > ";
  462. 8543 GOSUB 3300
  463. 8544 IF SELECTION%=0 THEN RETURN
  464. 8548 ON SELECTION% GOSUB 3900,8700,8800,8900
  465. 8552 GOTO 8500
  466. 8600 '
  467. 8605 '    open CALLERFILE$
  468. 8610 ' 1.0    (POSYS only)
  469. 8611 NOFILE%=0
  470. 8615 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  471. 8620 OPEN "R",#3, DEFDRIVE$+CALLERFILE$, 75
  472. 8625 FIELD #3,
  473.     8  AS CLOGCNT$,
  474.     6  AS FCALDATE$,
  475.     6  AS FCALTIME$,
  476.     1  AS SIGNATURE$,
  477.     8  AS CLREC$
  478. 8630 GET #3,1
  479. 8635 IF SIGNATURE$<>"*" THEN
  480.     NOFILE%=1:    GOSUB 1600:
  481.     LSET FCALDATE$=DATE$: LSET FCALTIME$=TIME$:
  482.     LSET SIGNATURE$="*": LSET CLOGCNT$=STR$(0): LSET CLREC$=STR$(2):
  483.     PUT #3,1:
  484.     RETURN
  485. 8640 LOGCNT#=VAL(CLOGCNT$)
  486. 8645 NEXTRECORD = VAL(CLREC$)
  487. 8655 FIELD #3, 20 AS CFNAME$,
  488.         20 AS CLNAME$,
  489.         6  AS CDATE$,
  490.         6  AS CTIME$,
  491.         6  AS CTIMEON$,
  492.         10 AS CNOTATION$,
  493.         2  AS CCRLF$
  494. 8660 RETURN
  495. 8700 '
  496. 8704 '    make archive of CALLERFILE$
  497. 8707 '1.1
  498. 8708 GOSUB 3100
  499. 8711 GOSUB 8600    'open CALLERFILE$
  500. 8715 IF NOCALLERS%<>0 THEN
  501.     PRINT:PRINT TAB(20);CALLERFILE$ ;" is empty.":
  502.     CLOSE #3:
  503.     GOSUB 4700:
  504.     RETURN
  505. 8719 GOSUB 1600
  506. 8720 PRINT TAB(20);"Making ";FNADDSEP$(DATE$,"/");".CLR from ";CALLERFILE$;"."
  507. 8721 PRINT
  508. 8722 SETUSERNUMBER%=0: GOSUB 300
  509. 8723 OPEN "O", #2, MGRDRIVE$+FNADDSEP$(DATE$,"/")+".CLR"
  510. 8725 CALLERCOUNT%=0
  511. 8727 FOR CALREC=2 TO NEXTRECORD
  512. 8731    GET #3, CALREC
  513. 8735    PRINT #2,
  514.         CFNAME$;" ";
  515.         CLNAME$;" ";
  516.         FNADDSEP$(CDATE$,"/");" ";
  517.         FNADDSEP$(CTIME$,":");" ";
  518.         CTIMEON$;" ";
  519.         CNOTATION$
  520. 8736    CALLERCOUNT%=CALLERCOUNT%+1
  521. 8737    PRINT ".";
  522. 8739 NEXT CALREC
  523. 8743 CLOSE #3
  524. 8747 CLOSE #2
  525. 8748 PRINT FNLINES$(3); TAB(20); CALLERCOUNT%;"callers written to ";
  526.     FNADDSEP$(DATE$,"/")+".CLR"
  527. 8750 GOSUB 4700
  528. 8783 RETURN
  529. 8800 '
  530. 8805 '    delete callers from CALLERFILE$
  531. 8810 '1.1
  532. 8815 GOSUB 3100
  533. 8820 PRINT FNLINES$(3); TAB(20);"Type D to delete callers."
  534. 8825 PRINT FNLINES$(2); TAB(20);"Press RETURN for ";CALLERFILE$;" menu."
  535. 8830 GOSUB 3300    'selector
  536. 8835 IF SELECTION%<>4 THEN RETURN
  537. 8840 GOSUB 8600    'open CALLERFILE$
  538. 8845 OLDLOGCNT#=LOGCNT#
  539. 8850 CLOSE #3
  540. 8852 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  541. 8855 KILL DEFDRIVE$+CALLERFILE$
  542. 8865 GOSUB 8600
  543. 8870 LSET CLOGCNT$ = STR$(OLDLOGCNT#)
  544. 8875 LSET CLREC$ = STR$(1)
  545. 8880 LSET SIGNATURE$="*"
  546. 8885 PUT #3,1
  547. 8890 CLOSE #3
  548. 8895 RETURN
  549. 8900 '
  550. 8904 '    view a CALLER archieve
  551. 8908 ' 1.0
  552. 8912 GOSUB 3100
  553. 8916 PRINT FNLINES$(2); TAB(20);"These are the archive callers files:"
  554. 8920 PRINT
  555. 8923 NOFILE%=0
  556. 8924 SETUSERNUMBER%=0:GOSUB 300:
  557.     FILES MGRDRIVE$+"????????.CLR"
  558. 8928 IF NOFILE%<>0 THEN 
  559.     PRINT TAB(20);"No archive of callers on this disk/user.":
  560.     GOSUB 4700:
  561.     RETURN
  562. 8932 PRINT FNLINES$(2); TAB(20);"Type date of archive callers file > ";
  563. 8936 MAX%=8: GOSUB 700
  564. 8940 IF NKEY%=0 THEN RETURN
  565. 8943 DRIVE$=MGRDRIVE$
  566. 8944 FIL$=ANSWER$+".CLR"
  567. 8948 SWAP USER0%,USERNUMBER%:
  568.     GOSUB 800:
  569.     SWAP USER0%,USERNUMBER%
  570. 8949 IF NOFILE%<>0 THEN 
  571.     PRINT : PRINT TAB(20);FIL$;" does not exist on this disk/user.":
  572.     GOSUB 4700:
  573.     GOTO 8900
  574. 8952 PRINT
  575. 8956 GOSUB 4700
  576. 8960 RETURN
  577. 9200 '
  578. 9204 '    time of day clock
  579. 9208 ' 1.0
  580. 9210 GOSUB 3100
  581. 9212 GETDAY%=1
  582. 9216 GOSUB 1600
  583. 9220 PRINT FNLINES$(5); TAB(20);
  584.     FNADDSEP$(TIME$,":");" ";DAY$;" ";FNADDSEP$(DATE$,"/")
  585. 9224 GOSUB 4700
  586. 9228 RETURN
  587. 10000 '
  588. 10010 '    main program starts here
  589. 10020 ' 1.2
  590. 10025 GOSUB 1100
  591. 10030 IF SYSOPONLY%=1 THEN GOSUB 5000 ELSE ZRETURN%=1
  592. 10040 IF ZRETURN%=0 THEN PRINT "POSYS?": END
  593. 10055 IF NOFILE%<> 0 THEN PRINT "Bad start - See SIGNON.DOC": END
  594. 10056 GOSUB 8100    'check for comments
  595. 10060 GOSUB 5100
  596. 10065 IF SELECTION%=17 THEN 5300
  597. 10070 ON SELECTION% GOSUB 7700,2500,3900,6500,6100,8500,7600,
  598.                 9200
  599. 10080 GOTO 10060
  600. 20000 END
  601.