home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol130 / usrmaint.bas < prev   
Encoding:
BASIC Source File  |  1984-04-29  |  7.8 KB  |  309 lines
  1. 1 '    signon subsystem -- USER Maintanence
  2. 3 VERSION$="1.4 {10/14/82}"    'initial release was 1.01
  3. 5 '    by dick lieber
  4. 7 '
  5. 9 DEFDRIVE$="A:"
  6. 10 USERFILE$="USERS"
  7. 15 LASTCALRFILE$="LASTCALR"
  8. 20 PWDFILE$="pwds"
  9. 50 USER0%=0
  10. 67 BSTRING$=CHR$(8)+" "+CHR$(8)
  11. 68 CRLF$=CHR$(&HA)+CHR$(&HD)
  12. 70 DIM ACLARRAY%(5,11)
  13. 71 DIM FLAGS%(14)
  14. 72 DIM USERS%(600,2)
  15. 77 ON ERROR GOTO 1000
  16. 80 '
  17. 81 '    function definition
  18. 82 '
  19. 83 '    add deliminators to time or date
  20. 84 DEF FNADDSEP$(DS$,DELIM$)=
  21.     LEFT$(DS$,2)+DELIM$+MID$(DS$,3,2)+DELIM$+RIGHT$(DS$,2)
  22. 85 '    remove date or time deliminators
  23. 86 DEF FNKILLSEP$(DS$)=LEFT$(DS$,2)+MID$(DS$,4,2)+RIGHT$(DS$,2)
  24. 88 '    on-off function
  25. 90 DIM ONOFF$(3)
  26. 91 ONOFF$(0)="Off": ONOFF$(2)=" save "
  27. 92 ONOFF$(1)="On": ONOFF$(3)="delete "
  28. 93 DEF FNONOFF$(ONOFF%)=ONOFF$(ONOFF%)
  29. 94 DEF FNLINES$(NLINES%)=STRING$(NLINES%,CRLF$)
  30. 95 DEF FNHOURS$(TIME)=STR$(INT(TIME/60))+":"+
  31.     RIGHT$("00"+MID$(STR$(TIME-(INT(TIME/60)*60)),2),2)
  32. 199 GOTO 10000
  33. 200 %INCLUDE 200.SSB
  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. 1000 '
  46. 1004 '    Error handler
  47. 1008 '1.2
  48. 1010 IF ERR=52 AND ERL=8147 THEN RESUME NEXT    'old .UBK not found (so what)
  49. 1011 IF ERR=53 THEN NOFILE%=1: RESUME NEXT
  50. 1012 A$="Error Trap":CR%=2: GOSUB 400
  51. 1020 PRINT "ERR = ";ERR, "ERL = ";ERL
  52. 1028 ON ERROR GOTO 0
  53. 1100 %INCLUDE 1100.SSB
  54. 1300 %INCLUDE 1300.SSB
  55. 1400 %INCLUDE 1400.SSB
  56. 1600 %INCLUDE 1600.SSB
  57. 2500 %INCLUDE 2500.SSB
  58. 3100 '
  59. 3105 '    clear screen
  60. 3110 '
  61. 3115 A$=CLEARSCR$:CR%=1:GOSUB 400: RETURN
  62. 3300 '
  63. 3305 '    make selection
  64. 3310 '
  65. 3315 MAX%=0:GOSUB 500
  66. 3320 IF ANSWER$="" THEN SELECTION%=0: RETURN
  67. 3325 SELECTION%=ASC(ANSWER$)-64
  68. 3327 IF SELECTION% < 0 THEN SELECTION%=0
  69. 3330 RETURN
  70. 4700 '
  71. 4705 '    pause 
  72. 4710 '
  73. 4715 PRINT:PRINT TAB(25);
  74. 4720 LINE INPUT "Press RETURN to continue."; A$
  75. 4725 RETURN
  76. 5000 '
  77. 5005 '    test that user is the SYSOP
  78. 5010 '
  79. 5015 OPEN "I", #1, DEFDRIVE$+LASTCALRFILE$
  80. 5020    INPUT #1, FRNAME$,LNAME$,ACLVL%
  81. 5025 CLOSE #1
  82. 5030 IF FRNAME$+LANME$ = "SYSOP" AND ACLVL% => 9 THEN ZRETURN%=1 
  83.         ELSE ZRETURN%=0
  84. 5035 RETURN
  85. 5100 '
  86. 5104 '    Subsystem Manager - Main menu
  87. 5108 ' 1.1
  88. 5112 GOSUB 3100
  89. 5116 PRINT
  90. 5120 PRINT TAB(30);"USER Maintainer"
  91. 5124 PRINT TAB(30);"<version ";VERSION$;">"
  92. 5128 PRINT
  93. 5156 PRINT TAB(20);"a    Display the roster of users."
  94. 5160 PRINT TAB(20);"b    Sort USER file."
  95. 5164 PRINT TAB(20);"c    Remove deleted user's records."
  96. 5168 PRINT TAB(20);"d    View a USER archive file."
  97. 5182 PRINT: PRINT TAB(20);"q    Leave subsystem manager."
  98. 5183 PRINT TAB(20);"r    Go back to subsystem manager."
  99. 5184 PRINT:PRINT TAB(25);"Press the letter of your selection > ";
  100. 5188 GOSUB 3300    'selector
  101. 5192 RETURN
  102. 5300 '
  103. 5304 '    exit module
  104. 5308 '
  105. 5310 SETUSERNUMBER%=0:GOSUB 300
  106. 5316 END
  107. 6000 '
  108. 6002 '    sort USERFILE$ by frequency of use
  109. 6004 '1.3
  110. 6006 GOSUB 3100
  111. 6008 PRINT TAB(20);"Sort USER file."
  112. 6010 PRINT FNLINES$(4);
  113.     TAB(10);"Least number of uses to keep (default is 3) > ";
  114. 6012 MAX=3: GOSUB 500
  115. 6014 IF NKEY%=0 THEN MINIUSES=3: PRINT MINIUSES ELSE MINIUSES=VAL(ANSWER$)
  116. 6016 PRINT:PRINT TAB(20);"Records with zero uses are saved unless 'deleted'."
  117. 6018 PRINT:PRINT
  118.     TAB(7);"Number of newest users to keep (default is 10) > ";
  119. 6020 MAX%=3: GOSUB 500
  120. 6022 IF NKEY%=0 THEN KEEPLAST=10: PRINT KEEPLAST ELSE KEEPLAST=VAL(ANSWER$)
  121. 6024 GOSUB 1400 ' open users
  122. 6026 FIELD #1, 88 AS MSTRUSER$
  123. 6028 SEP$="-"
  124. 6030 GOSUB 8600    'open user archive
  125. 6032 NDX%=1
  126. 6034 FOR REC=2 TO NEXTUSER-1
  127. 6036    SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  128. 6038    GET #1,REC
  129. 6040    GOSUB 1300
  130. 6042    IF (SIGCNT = 0 OR SIGCNT => MINIUSES OR REC > NEXTUSER-KEEPLAST)
  131.         AND DELETED%=0
  132.         THEN GOSUB 6100: KEEP%=2
  133.         ELSE GOSUB 8400: KEEP%=3
  134. 6044 PRINT FNONOFF$(KEEP%); FRNAME$;" ";LNAME$
  135. 6046 NEXT REC
  136. 6048 PRINT "Users remaining:";NDX%
  137. 6049 PRINT:PRINT "Sorting..."
  138. 6050 FOR J%=1 TO NDX%-1
  139. 6052    FOR K%=J%+1 TO NDX%
  140. 6054        IF USERS%(J%,2) >= USERS%(K%,2) THEN GOTO 6062
  141. 6056        SWAP USERS%(J%,1), USERS%(K%,1)
  142. 6058        SWAP USERS%(J%,2), USERS%(K%,2)
  143. 6060        PRINT ".";
  144. 6062    NEXT K%
  145. 6064    PRINT ":"
  146. 6066 NEXT J%
  147. 6068 PRINT:PRINT "Sort finished"
  148. 6072 GOSUB 8200    'close archive
  149. 6074 GOSUB 8500    'open temp file
  150. 6075 PRINT:PRINT "Building new USERS file."
  151. 6076 FOR INDEX%=1 TO NDX%-1
  152. 6078    GET #1, USERS%(INDEX%,1)
  153. 6079    PRINT ".";
  154. 6080    GOSUB 8300    'put into temp
  155. 6082 NEXT INDEX%
  156. 6084 GOSUB 8100    'close temp, make USERFILE$
  157. 6086 RETURN
  158. 6100 '
  159. 6104 '    add record to sort array
  160. 6108 '
  161. 6112 USERS%(NDX%,1)=REC
  162. 6116 USERS%(NDX%,2)=SIGCNT
  163. 6120 NDX%=NDX%+1
  164. 6124 RETURN
  165. 6200 '
  166. 6210 '    display sort array
  167. 6220 '
  168. 6230 FOR INDEX%=1 TO NDX%
  169. 6240    PRINT USERS%(INDEX%,1),USERS%(INDEX%,2)
  170. 6250 NEXT INDEX%
  171. 6260 RETURN
  172. 7000 '
  173. 7004 '    view a USERFILE archive
  174. 7008 '1.1
  175. 7012 SETUSERNUMBER%=0: GOSUB 300
  176. 7016 GOSUB 3100
  177. 7020 PRINT FNLINES$(5);"These are the USER archives:"
  178. 7024 PRINT
  179. 7028 FILES MGRDRIVE$+"????????.USR"
  180. 7032 PRINT FNLINES$(3);TAB(20);"Type date of file to view > ";
  181. 7036 MAX%=8: GOSUB 500
  182. 7040 IF NKEY%=0 THEN RETURN
  183. 7044 VIEWFILE$=ANSWER$+".USR"
  184. 7048 SETUSERNUMBER%=0: GOSUB 300
  185. 7050 NOFILE%=0
  186. 7052 OPEN "I", #1, MGRDRIVE$+VIEWFILE$
  187. 7056 CLOSE #1
  188. 7060 IF NOFILE%<>0 THEN
  189.     GOSUB 3100: PRINT FNLINES$(10); TAB(20); MGRDRIVE$+VIEWFILE$;
  190.         " does not exist.":
  191.     GOSUB 4700:
  192.     GOTO 7000
  193. 7064 GOSUB 2500
  194. 7068 GOTO 7000
  195. 7100 '
  196. 7105 '     back to POSYS
  197. 7110 '
  198. 7115 SETUSERNUMBER%=0: GOSUB 300
  199. 7120 JUMPFILE$="POSYS"
  200. 7125 GOSUB 7800
  201. 7130 RETURN
  202. 7800 %INCLUDE 7800.SSB
  203. 8000 '
  204. 8004 '    remove deleted records
  205. 8008 '1.3
  206. 8012 GOSUB 3100
  207. 8016 GOSUB 8500    'open temp USERS
  208. 8020 SEP$="/"
  209. 8024 GOSUB 8600    'open archive USERS
  210. 8028 GOSUB 1400    'open USERS
  211. 8032 FIELD #1, 88 AS MSTRUSER$
  212. 8036 FOR INDEX = 2 TO NEXTUSER-1
  213. 8040    GET #1, INDEX
  214. 8044    GOSUB 1300
  215. 8048    PRINT FNONOFF$(DELETED% + 2);FRNAME$;" ";LNAME$
  216. 8052    IF DELETED%=0 THEN
  217.         GOSUB 8300 ELSE
  218.         GOSUB 8400
  219. 8056 NEXT INDEX
  220. 8060 GOSUB 8100
  221. 8064 GOSUB 8200
  222. 8068 RETURN
  223. 8100 '
  224. 8104 '    close temp & change to new USERFILE$
  225. 8108 '1.1
  226. 8112 GOSUB 1600
  227. 8116 LSET TFUEXTUSER$=STR$(RECTEMP+1)    'NEXTuser
  228. 8120 LSET TFUSERSIG$="*"
  229. 8124 LSET TFUDATE$=DATE$
  230. 8128 LSET TFUTIME$=TIME$
  231. 8132 LSET TFUCRLF$=CRLF$
  232. 8136 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  233. 8140 PUT #2,1
  234. 8144 CLOSE #1: CLOSE #2
  235. 8147 KILL DEFDRIVE$+USERFILE$+".UBK"
  236. 8148 NAME DEFDRIVE$+USERFILE$ AS DEFDRIVE$+USERFILE$+".UBK"
  237. 8152 NAME DEFDRIVE$+USERFILE$+".$$$" AS DEFDRIVE$+USERFILE$
  238. 8156 RETURN
  239. 8200 '
  240. 8204 '    close archive user
  241. 8208 '
  242. 8212 SETUSERNUMBER%=0: GOSUB 300
  243. 8216 LSET AFUEXTUSER$=STR$(RECARCH+1)
  244. 8220 LSET AFUSERSIG$="*"
  245. 8224 LSET AFUDATE$=DATE$
  246. 8228 LSET AFUTIME$=TIME$
  247. 8232 LSET AFUCRLF$=CRLF$
  248. 8236 PUT #3,1
  249. 8240 CLOSE #3
  250. 8244 RETURN
  251. 8300 '
  252. 8304 '    put into temp
  253. 8308 '
  254. 8312 LSET MSTRTEMP$=MSTRUSER$
  255. 8316 RECTEMP = RECTEMP+1
  256. 8320 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  257. 8324 PUT #2, RECTEMP
  258. 8328 RETURN
  259. 8400 '
  260. 8404 '    put into archive
  261. 8408 '
  262. 8412 LSET MSTRARCH$=MSTRUSER$
  263. 8416 RECARCH = RECARCH+1
  264. 8420 SETUSERNUMBER%=0: GOSUB 300
  265. 8424 PUT #3, RECARCH
  266. 8428 RETURN
  267. 8500 '
  268. 8504 '    open work file of USERS
  269. 8508 '
  270. 8512 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  271. 8516 OPEN "R", #2, DEFDRIVE$+USERFILE$+".$$$", 88
  272. 8520 FIELD #2, 88 AS MSTRTEMP$
  273. 8524 FIELD #2,
  274.     5 AS TFUEXTUSER$,
  275.     1 AS TFUSERSIG$,
  276.     6 AS TFUDATE$,    
  277.     6 AS TFUTIME$,
  278.     2 AS TFUCRLF$
  279. 8528 RECTEMP=1
  280. 8532 RETURN
  281. 8600 '
  282. 8604 '    open archive USERS
  283. 8608 '1.1
  284. 8612 SETUSERNUMBER%=0: GOSUB 300
  285. 8616 GOSUB 1600
  286. 8620 OPEN "R", #3, MGRDRIVE$+FNADDSEP$(DATE$,SEP$)+".USR", 88
  287. 8624 FIELD #3, 88 AS MSTRARCH$
  288. 8628 FIELD #3,
  289.     5 AS AFUEXTUSER$,
  290.     1 AS AFUSERSIG$,
  291.     6 AS AFUDATE$,
  292.     6 AS AFUTIME$,
  293.     2 AS AFUCRLF$
  294. 8632 RECARCH=1
  295. 8636 RETURN
  296. 10000 '
  297. 10010 '    main program starts here
  298. 10020 ' 1.0
  299. 10025 GOSUB 1100
  300. 10030 IF SYSOPONLY%=1 THEN GOSUB 5000 ELSE ZRETURN%=1
  301. 10040 IF ZRETURN%=0 THEN PRINT "USRMAINT?": END
  302. 10055 IF NOFILE%<> 0 THEN PRINT "Bad start - See SIGNON.DOC": END
  303. 10060 GOSUB 5100
  304. 10066 IF SELECTION%=17 THEN GOTO 5300
  305. 10068 IF SELECTION%=18 THEN GOTO 7100
  306. 10070 ON SELECTION% GOSUB 2500, 6000, 8000, 7000
  307. 10080 GOTO 10060
  308. 20000 END
  309.