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