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