home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol130 / convrbb.bas < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  16.5 KB  |  615 lines
  1. 1 '    signon subsystem -- convert old USERS file
  2. 2 '    RBBENT27.BAS to SIGNON USERS 1.0 format
  3. 3 VERSION$="1.03 {8/22/82}"
  4. 5 '    by dick lieber
  5. 7 '
  6. 9 DEFDRIVE$="A:"
  7. 10 USERFILE$="USERS"
  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. 78 DIM ARYCLASS$(10)    'RBBENT27 classes (RG, SP etc.)
  17. 79 DIM ARYACLVL%(10)    'RBBEN27 aclvls matching above
  18. 80 '
  19. 81 '    function definition
  20. 82 '
  21. 83 '    add deliminators to time or date
  22. 84 DEF FNADDSEP$(DS$,DELIM$)=
  23.     LEFT$(DS$,2)+DELIM$+MID$(DS$,3,2)+DELIM$+RIGHT$(DS$,2)
  24. 85 '    remove date or time deliminators
  25. 86 DEF FNKILLSEP$(DS$)=LEFT$(DS$,2)+MID$(DS$,4,2)+RIGHT$(DS$,2)
  26. 88 '    on-off function
  27. 90 DIM ONOFF$(1)
  28. 91 ONOFF$(0)="Off"
  29. 92 ONOFF$(1)="On"
  30. 93 DEF FNONOFF$(ONOFF%)=ONOFF$(ONOFF%)
  31. 94 DEF FNLINES$(NLINES%)=STRING$(NLINES%,CRLF$)
  32. 199 GOTO 10000
  33. 200 ' special modified version of this routine for conv.bas only
  34. 202 '    packup user record & put
  35. 206 ' 1.11 (1300.10)
  36. 208 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  37. 210 FLAGS%(0)=EXPERT%
  38. 216 FLAGS%(8)=OLDUSER%
  39. 217 FLAGS%(9)=NEEDLOC%
  40. 218 FLAGS%(10)=DELETED%
  41. 224 FLAG%=0
  42. 228 FOR INDEX%=14 TO 0 STEP -1
  43. 229    MASK=2^INDEX%
  44. 230    IF FLAGS%(INDEX%) <> 0 THEN FLAG%= FLAG% OR MASK
  45. 234 NEXT INDEX%
  46. 236 ACLVL$=STR$(ACLVL%)
  47. 238 LSET FACLVL$ = ACLVL$
  48. 240 LSET FFNAME$ = FRNAME$
  49. 242 LSET FLNAME$ = LNAME$
  50. 244 LSET FLOCATION$ = LOCATION$
  51. 246 SIGCNT$=STR$(SIGCNT)
  52. 248 LSET FSIGCNT$ = SIGCNT$
  53. 250 LSET FLASTDATE$ = DATE$
  54. 252 LSET FLASTIME$=TIME$
  55. 254 ELAPTIME$=STR$(ELAPTIME%)
  56. 256 LSET FELAPTIME$=ELAPTIME$
  57. 258 TOTALTIME$=STR$(TOTALTIME)
  58. 260 LSET FTOTTIME$=TOTALTIME$
  59. 262 LSET FPWD$ = PWD$
  60. 264 FLAG$=STR$(FLAG%)
  61. 266 LSET FFLAG$ = FLAG$
  62. 268 LSET FCRLF$=CRLF$
  63. 270 PUT #1, REC%
  64. 271 RETURN
  65. 275 ' put header , close users
  66. 276 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  67. 278 LSET FUEXTUSER$ = STR$(NEXTUSER)
  68. 280 LSET FUSERSIG$ = "*"
  69. 282 LSET FUDATE$=UDATE$
  70. 283 LSET FUTIME$=UTIME$
  71. 286 LSET FUCRLF$=CRLF$
  72. 288 PUT #1,1
  73. 290 CLOSE #1
  74. 292 RETURN
  75. 300 '
  76. 302 '    set user number
  77. 304 '
  78. 306 USERMD=TESTADDRESS+9
  79. 312 CALL USERMD(SETUSERNUMBER%)
  80. 345 RETURN
  81. 400 '
  82. 407 '    print a string on con:
  83. 414 '    string in A$, CR%=1 no crlf cr%=2 crlf after
  84. 435 ' 1.2
  85. 442 IF STACKED%<>0 THEN RETURN
  86. 449 BREAK%=0
  87. 456 XKEY$=INKEY$
  88. 463 IF XKEY$=CHR$(3) OR XKEY$="C" OR XKEY$="c" THEN BREAK%=1
  89. 470 IF XKEY$=CHR$(18) OR XKEY$="S" OR XKEY$="s" THEN PAUSE%=1 ELSE PAUSE%=0
  90. 477 IF PAUSE%<>0 AND LEN(INKEY$)=0 THEN GOTO 477    'wait for key
  91. 484 ON CR% GOTO 491,498
  92. 491    PRINT A$; : RETURN
  93. 498    PRINT A$: RETURN
  94. 500 '
  95. 503 '    get a string into ANSWER$ (make upper case)
  96. 512 ' 1.7    [*** tremendously improved! ***]
  97. 515 IF STACKED%<>0 THEN
  98.     ANSWER$=STACKED$:
  99.     STACKED%=0:
  100.     NKEY%=LEN(STACKED$):
  101.     GOTO 557
  102. 518 ANSWER$=""
  103. 521 KEY$="*"
  104. 524 NKEY%=0
  105. 527 WHILE NKEY% <= MAX%
  106. 530    KEY$=INPUT$(1)
  107. 533    KEY%=ASC(KEY$)
  108. 536    IF KEY$="~" THEN GOTO 551    'don't allow tilde
  109. 539    IF KEY%=13 THEN GOTO 557    'done
  110. 542    IF (KEEPLOWER%=0 AND KEY% >= 97 AND KEY%<= 122) THEN KEY%=KEY%-32
  111. 545    IF KEY%=127 OR KEY%=8 THEN GOSUB 569    'process backspace
  112. 548    IF DELCHAR%=0 THEN
  113.         NKEY%=NKEY%+1:
  114.         PRINT KEY$;:
  115.         ANSWER$=ANSWER$+CHR$(KEY%)
  116.         ELSE
  117.         DELCHAR%=0
  118. 551    IF NKEY%<0 THEN NKEY%=0
  119. 554 WEND
  120. 557 STACKED%=INSTR(ANSWER$,";")
  121. 560 IF STACKED%<>0 THEN
  122.     STACKED$=MID$(ANSWER$,STACKED%+1):
  123.     ANSWER$=LEFT$(ANSWER$,STACKED%-1)
  124. 563 KEEPLOWER%=0
  125. 566 RETURN
  126. 569 DELCHAR%=1
  127. 572 IF NKEY%=0 THEN RETURN
  128. 575 NKEY%=NKEY%-1
  129. 578 PRINT BSTRING$;
  130. 581 ANSWER$=LEFT$(ANSWER$,LEN(ANSWER$)-1)
  131. 584 RETURN
  132. 1000 '
  133. 1004 '    Error handler
  134. 1008 '
  135. 1012 A$="Error Trap":CR%=2: GOSUB 400
  136. 1020 PRINT "ERR = ";ERR, "ERL = ";ERL
  137. 1022 IF ERR=53 THEN NOFILE%=1: RESUME NEXT
  138. 1028 ON ERROR GOTO 0
  139. 1100 '
  140. 1105 '    get passwords & configuration parameters
  141. 1115 ' 1.10    ##
  142. 1120 NOFILE%=0
  143. 1125 OPEN "I", #2,DEFDRIVE$+PWDFILE$
  144. 1130    IF NOFILE%<>0 THEN CLOSE #1: RETURN
  145. 1135    INPUT #2, PWD1$, PWD2$, PWD3$, ALLOWNEW%, SIGNONMESS$, OPTIONMESS$
  146. 1140    INPUT #2,BULLFILE$, SUCESSFILE$, OPTIONFILE$, INSTRFILE$,
  147.          NEWCOMFILE$, NOACCESSFILE$, EXITFILE$,SPECIALFILE$
  148. 1145    INPUT #2,PWDACL%, MAXPW%, SYSOPSLVL%, USERNUMBER%, DENIEDCOMMENT%
  149. 1150    INPUT #2, CLEARSCR$,NOCLOCK%,SPECIALEVEL%
  150. 1155    INPUT #2, MUSTQUALIFY%, QUALQUESTION$, QUALANSWER1$, QUALANSWER2$,
  151.     QUALNONPWD%, MGRDRIVE$
  152. 1160    INPUT #2, SKIPFILES%,RAMPOKE%,RAMPOKEADDRESS%,TESTADDRESS
  153. 1165    INPUT #2, BYEPOKE%, BYEPARAMS%, BYEPROG$
  154. 1170    INPUT #2, SYSOPONLY%,WHEELOPTION%,WHEEL%,
  155.         RESTRICT%,UNRESTRICT%,MODEMCTLOPT%
  156. 1175    FOR INDEX%=0 TO 5:
  157.         FOR I%=0 TO 10:
  158.             INPUT #2,ACLARRAY%(INDEX%,I%):
  159.         NEXT I%:
  160.     NEXT INDEX%
  161. 1176    INPUT #2, MODEMPORT%, DISCONNECT%, PAGESIZE%
  162. 1180 CLOSE #2
  163. 1185 RETURN
  164. 1200 '
  165. 1204 ' find name - get record
  166. 1208 ' 1.2
  167. 1211 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  168. 1212 NOTFOUND%=0
  169. 1216 REC%=2
  170. 1220 LAST$=SPACE$(14): FIRST$=RIGHT$(LAST$,10)
  171. 1224 LSET FIRST$=FRNAME$: LSET LAST$=LNAME$
  172. 1228    GET #1,REC%
  173. 1232    IF EOF(1) THEN NOTFOUND%=1:RETURN
  174. 1236    IF FFNAME$=FIRST$ AND FLNAME$=LAST$ THEN GOSUB 1300: RETURN
  175. 1240    REC%=REC%+1
  176. 1244 GOTO 1228
  177. 1300 '
  178. 1302 ' 1300
  179. 1304 ' unpack user record
  180. 1306 ' 1.11 (1200.10)
  181. 1308 ACLVL%=VAL(FACLVL$)
  182. 1310 FRNAME$=FFNAME$
  183. 1312 IF RIGHT$(FRNAME$,1)=" " THEN FRNAME$=LEFT$(FRNAME$,LEN(FRNAME$)-1):
  184.         GOTO 1312
  185. 1314 LNAME$=FLNAME$
  186. 1316 IF RIGHT$(LNAME$,1)=" " THEN LNAME$=LEFT$(LNAME$,LEN(LNAME$)-1):
  187.         GOTO 1316
  188. 1318 LOCATION$=FLOCATION$
  189. 1320 SIGCNT=VAL(FSIGCNT$)
  190. 1322 LASTDATE$=FLASTDATE$
  191. 1324 LASTTIME$=FLASTIME$
  192. 1326 ELAPTIME%=VAL(FELAPTIME$)
  193. 1328 TOTALTIME=VAL(FTOTTIME$)
  194. 1330 PWD$=FPWD$
  195. 1332 FLAG%=VAL(FFLAG$)
  196. 1334 MASK=1
  197. 1336 FOR INDEX% = 14 TO 0 STEP -1
  198. 1337    MASK=2^INDEX%
  199. 1338    IF FLAG% AND MASK THEN FLAGS%(INDEX%)=1 ELSE FLAGS%(INDEX%)=0
  200. 1340    MASK=MASK * 2
  201. 1342 NEXT INDEX%
  202. 1344 EXPERT%=FLAGS%(0)
  203. 1360 OLDUSER%=FLAGS%(8)
  204. 1361 NEEDLOC%=FLAGS%(9)
  205. 1362 DELETED%=FLAGS%(10)
  206. 1374 RETURN
  207. 1400 '
  208. 1403 ' open USERS
  209. 1406 ' 1.7
  210. 1409 IF VIEWFILE$="" THEN SETUSERNUMBER%=USERNUMBER%
  211.     ELSE SETUSERNUMBER%=0
  212. 1410 GOSUB 300
  213. 1412 IF VIEWFILE$="" THEN
  214.     FILE$= DEFDRIVE$+USERFILE$
  215.     ELSE FILE$=MGRDRIVE$+VIEWFILE$
  216. 1413 OPEN "R", #1, FILE$, 88
  217. 1415 FIELD #1,
  218.     5 AS FUEXTUSER$,
  219.     1 AS FUSERSIG$,
  220.     6 AS FUDATE$,
  221.     6 AS FUTIME$,
  222.     2 AS FUCRLF$
  223. 1418 GET #1, 1
  224. 1421 NEXTUSER=VAL(FUEXTUSER$)
  225. 1424 UDATE$=FUDATE$
  226. 1425 UTIME$=FUTIME$
  227. 1427 IF FUSERSIG$ <> "*" THEN
  228.     NEXTUSER=2:
  229.     GOSUB 1600:
  230.     UDATE$ = DATE$:
  231.     UTIME$=TIME$
  232. 1430 FIELD #1,
  233.     3 AS FACLVL$,
  234.     10 AS FFNAME$,
  235.     14 AS FLNAME$,
  236.     15 AS FLOCATION$,
  237.     5  AS FSIGCNT$,
  238.     6  AS FLASTDATE$,
  239.     6  AS FLASTIME$,
  240.     6  AS FTOTTIME$,
  241.     3  AS FELAPTIME$,
  242.     13 AS FPWD$,
  243.     5  AS FFLAG$,
  244.     2  AS FCRLF$
  245. 1433    RETURN
  246. 1600 '
  247. 1602 ' date process and time
  248. 1604 ' 1.1
  249. 1642 '
  250. 1644 TIMEMD=TESTADDRESS
  251. 1646 DATEMD=TESTADDRESS+3
  252. 1648 DAYMD=TESTADDRESS+6
  253. 1650 IF NOCLOCK%<>0 THEN
  254.     DATE$="xxxxxx":
  255.     TIME$="xxxxxx":
  256.     DAY$="":
  257.     RETURN
  258. 1651 ODATE$=STRING$(12,"$")
  259. 1652 CALL DATEMD(ODATE$)
  260. 1654 DATE$=FNKILLSEP$(LEFT$(ODATE$,8))
  261. 1658 '    get time
  262. 1661 OTIME$=STRING$(12,"$")
  263. 1662 CALL TIMEMD(OTIME$)
  264. 1664 TIME$=FNKILLSEP$(LEFT$(OTIME$,8))
  265. 1668 '    get day of week
  266. 1672 DAY$=""
  267. 1674 IF GETDAY%=0 THEN RETURN
  268. 1676 ODAY$=STRING$(10,"$")
  269. 1678 CALL DAYMD(ODAY$)
  270. 1680 FOR I%=1 TO LEN(ODAY$)
  271. 1682    IF MID$(ODAY$,I%,1)<>"$" THEN DAY$=DAY$+MID$(ODAY$,I%,1)
  272. 1684 NEXT I%
  273. 1686 GETDAY%=0
  274. 1688 RETURN
  275. 1700 '
  276. 1705 '    set default values to working individual variables
  277. 1710 ' 1.1
  278. 1715 ACLVL%=0
  279. 1720 SIGCNT=0
  280. 1725 NEWCOMER%=0
  281. 1730 SYSOP%=0
  282. 1735 PWD$= STRING$(13,42) ' *s
  283. 1740 LOCATION$=""
  284. 1745 LTIME$="      "
  285. 1750 LDATE$="      "
  286. 1755 ELAPTIME%=0
  287. 1760 TOTALTIME=0
  288. 1765 NOTATION$="normal"
  289. 1766 EXPERT%=0
  290. 1767 OLDUSER%=0
  291. 1770 RETURN
  292. 2500 '
  293. 2503 '    display userfile$
  294. 2506 '1.8
  295. 2509 GOSUB 3100
  296. 2512 PRINT
  297. 2515 GOSUB 1400
  298. 2518 INDEX=1
  299. 2521 COUNTER%=0
  300. 2524 COUNTER1%=0
  301. 2527 SAVEDACLVL%=ACLVL%
  302. 2528 PRINT TAB(20);"Press ^K to abort listing."
  303. 2530 PRINT
  304. "rec    first last, location                 uses     last use      total time"+CRLF$
  305. 2533 GET #1,INDEX+1
  306. 2536    IF EOF(1) OR INDEX=NEXTUSER-1 THEN GOTO 2557
  307. 2537    IF INKEY$=CHR$(&HB) THEN ABORT%=1: GOTO 2557
  308.         ELSE ABORT%=0
  309. 2539    GOSUB 1300    'transfer to working vars
  310. 2542    IF RIGHT$(LOCATION$,1)=" " THEN
  311.         LOCATION$ = LEFT$(LOCATION$,LEN(LOCATION$)-1): GOTO 2542
  312. 2545    IF DELETED%=1 THEN LOCATION$= "**deleted**":
  313.          COUNTER%=COUNTER%+1
  314.         ELSE 
  315.          COUNTER1%=COUNTER1%+1
  316. 2548    PRINT USING "### \                                    \ ###  & &   #### ";
  317.         INDEX;FRNAME$+" "+LNAME$+", "+LOCATION$;
  318.         SIGCNT;FNADDSEP$(LASTDATE$,"/");
  319.         FNADDSEP$(LASTTIME$,":");
  320.         TOTALTIME
  321. 2551    INDEX=INDEX+1
  322. 2554 GOTO 2533
  323. 2557 PRINT
  324. 2560 IF VIEWFILE$="" THEN PRINT "User file reorganized";
  325.     ELSE PRINT "User archive made";: VIEWFILE$=""
  326. 2563 PRINT " on ";FNADDSEP$(UDATE$,"/"); " at ";FNADDSEP$(UTIME$,":");"."
  327. 2564 PRINT
  328. 2565 IF ABORT% THEN PRINT
  329.   TAB(35);"** Aborted **    (totals based on displayed data only)"+CRLF$
  330. 2566 PRINT " Active Users: ";COUNTER1%
  331. 2569 PRINT "Deleted Users: ";COUNTER%
  332. 2572 PRINT "Total Entries: ";COUNTER1%+COUNTER%
  333. 2575 GOSUB 4700
  334. 2578 CLOSE #1
  335. 2581 ACLVL%=SAVEDACLVL%
  336. 2584 RETURN
  337. 3100 '
  338. 3105 '    clear screen
  339. 3110 '
  340. 3115 A$=CLEARSCR$:CR%=1:GOSUB 400: RETURN
  341. 3300 '
  342. 3305 '    make selection
  343. 3310 '
  344. 3315 MAX%=0:GOSUB 500
  345. 3320 IF ANSWER$="" THEN SELECTION%=0: RETURN
  346. 3325 SELECTION%=ASC(ANSWER$)-64
  347. 3327 IF SELECTION% < 0 THEN SELECTION%=0
  348. 3330 RETURN
  349. 4700 '
  350. 4705 '    pause 
  351. 4710 '
  352. 4715 PRINT:PRINT TAB(25);
  353. 4720 LINE INPUT "Press RETURN to continue."; A$
  354. 4725 RETURN
  355. 5100 '
  356. 5104 '    Subsystem Manager - Main menu
  357. 5108 ' 1.0
  358. 5112 GOSUB 3100
  359. 5116 PRINT
  360. 5120 PRINT TAB(30);"USER Maintainer"
  361. 5124 PRINT TAB(30);"<version ";VERSION$;">"
  362. 5128 PRINT
  363. 5132 PRINT TAB(20);"a    Go back to subsystem manager."
  364. 5156 PRINT TAB(20);"b    Display the roster of users."
  365. 5160 PRINT TAB(20);"c    Sort USER file."
  366. 5164 PRINT TAB(20);"d    Remove deleted user's records."
  367. 5168 PRINT TAB(20);"e    View a USER archive file."
  368. 5172 ' PRINT TAB(20);"f    Fetch a user's record from an archive."
  369. 5180 ' PRINT TAB(20);"g    Time of day"
  370. 5182 PRINT: PRINT TAB(20);"q    Leave subsystem manager."
  371. 5184 PRINT:PRINT TAB(25);"Press the letter of your selection > ";
  372. 5188 GOSUB 3300    'selector
  373. 5192 RETURN
  374. 5300 '
  375. 5304 '    exit module
  376. 5308 '
  377. 5310 SETUSERNUMBER%=0:GOSUB 300
  378. 5316 END
  379. 7100 '
  380. 7105 '     back to POSYS
  381. 7110 '
  382. 7115 SETUSERNUMBER%=0: GOSUB 300
  383. 7120 JUMPFILE$="POSYS"
  384. 7125 GOSUB 7800
  385. 7130 RETURN
  386. 7800 '
  387. 7807 '    generalized jumpout (chain)
  388. 7814 '1.1
  389. 7821 GOSUB 3100
  390. 7828 PRINT FNLINES$(4)
  391. 7835 PRINT TAB(20);"Chaining to ";JUMPFILE$;"."
  392. 7842 PRINT FNLINES$(2)
  393. 7849 PRINT TAB(20);"Please wait."
  394. 7856 CHAIN JUMPFILE$
  395. 7863 GOSUB 3100
  396. 7870 PRINT FNLINES$(4)
  397. 7877 PRINT TAB(25); JUMPFILE$;" is not available."
  398. 7884 GOSUB 4700
  399. 7891 RETURN
  400. 8100 '
  401. 8104 '    close temp & change to new USERFILE$
  402. 8108 '1.1
  403. 8112 GOSUB 1600
  404. 8116 LSET TFUEXTUSER$=STR$(RECTEMP+1)    'NEXTuser
  405. 8120 LSET TFUSERSIG$="*"
  406. 8124 LSET TFUDATE$=DATE$
  407. 8128 LSET TFUTIME$=TIME$
  408. 8132 LSET TFUCRLF$=CRLF$
  409. 8136 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  410. 8140 PUT #2,1
  411. 8144 CLOSE #1: CLOSE #2
  412. 8147 KILL DEFDRIVE$+USERFILE$+".UBK"
  413. 8148 NAME DEFDRIVE$+USERFILE$ AS DEFDRIVE$+USERFILE$+".UBK"
  414. 8152 NAME DEFDRIVE$+USERFILE$+".$$$" AS DEFDRIVE$+USERFILE$
  415. 8156 RETURN
  416. 8300 '
  417. 8304 '    put into temp
  418. 8308 '
  419. 8312 LSET MSTRTEMP$=MSTRUSER$
  420. 8316 RECTEMP = RECTEMP+1
  421. 8320 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  422. 8324 PUT #2, RECTEMP
  423. 8328 RETURN
  424. 8400 '
  425. 8404 '    put into archive
  426. 8408 '
  427. 8412 LSET MSTRARCH$=MSTRUSER$
  428. 8416 RECARCH = RECARCH+1
  429. 8420 SETUSERNUMBER%=0: GOSUB 300
  430. 8424 PUT #3, RECARCH
  431. 8428 RETURN
  432. 8500 '
  433. 8504 '    open work file of USERS
  434. 8508 '
  435. 8512 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  436. 8516 OPEN "R", #2, DEFDRIVE$+USERFILE$+".$$$", 88
  437. 8520 FIELD #2, 88 AS MSTRTEMP$
  438. 8524 FIELD #2,
  439.     5 AS TFUEXTUSER$,
  440.     1 AS TFUSERSIG$,
  441.     6 AS TFUDATE$,    
  442.     6 AS TFUTIME$,
  443.     2 AS TFUCRLF$
  444. 8528 RECTEMP=1
  445. 8532 RETURN
  446. 8600 '
  447. 8604 '    open archive USERS
  448. 8608 '1.1
  449. 8612 SETUSERNUMBER%=0: GOSUB 300
  450. 8616 GOSUB 1600
  451. 8620 OPEN "R", #3, MGRDRIVE$+FNADDSEP$(DATE$,SEP$)+".USR", 88
  452. 8624 FIELD #3, 88 AS MSTRARCH$
  453. 8628 FIELD #3,
  454.     5 AS AFUEXTUSER$,
  455.     1 AS AFUSERSIG$,
  456.     6 AS AFUDATE$,
  457.     6 AS AFUTIME$,
  458.     2 AS AFUCRLF$
  459. 8632 RECARCH=1
  460. 8636 RETURN
  461. 9500 '
  462. 9503 '    read record from old users file
  463. 9506 '    transfer to working variables
  464. 9509 '    rbbent27.bas compatable version
  465. 9512 ' 0.1
  466. 9513    SETUSERNUMBER%=OLDUSERNUMBER%: GOSUB 300
  467. 9515    GET #2, I%
  468. 9518    SPACESEP%=INSTR(FRLNLOC$," ")
  469. 9521    OFIRST$=LEFT$(FRLNLOC$,SPACESEP%-1)
  470. 9524    SPCSEP2%=INSTR(SPACESEP%+2,FRLNLOC$," ")
  471. 9527    OLAST$=MID$(FRLNLOC$,SPACESEP%+1,SPCSEP2%-SPACESEP%-1)
  472. 9530    LOCLENGTH%=48-SPCSEP2%
  473. 9533    LOCATION$=RIGHT$(FRLNLOC$,LOCLENGTH%)
  474. 9536    IF RIGHT$(LOCATION$,1)=" " THEN
  475.         LOCATION$=LEFT$(LOCATION$,LEN(LOCATION$)-1): GOTO 9536
  476. 9537 REC%=I%
  477. 9538    ACLVL%=DEFACLVL%
  478. 9539    FOR J%=0 TO CLASSES%    'change access level from default
  479. 9540        IF CLASS$=ARYCLASS$(J%) THEN ACLVL%=ARYACLVL%(J%)
  480. 9541    NEXT J%
  481. 9542    COUNT%=VAL(COUNT$)
  482. 9543    PRINT "  record:";REC%
  483. 9544    PRINT "   class:>";CLASS$;"<"
  484. 9545    PRINT "    last:>";OLAST$;"<"
  485. 9548    PRINT "   first:>";OFIRST$;"<"
  486. 9551    PRINT "location:>";LOCATION$;"<"
  487. 9554    PRINT "   count:";COUNT%
  488. 9555    PRINT "acc levl:";ACLVL%
  489. 9557    PRINT "===================================="
  490. 9563    FRNAME$=OFIRST$        'first name
  491. 9566    LNAME$=OLAST$        'last name
  492. 9572    SIGCNT=COUNT%        'usage counter 
  493. 9574    OLDUSER%=1
  494. 9587 RETURN
  495. 9600 '
  496. 9610 '    open users.rbb file
  497. 9615 '    works with rbbrnt27.bas
  498. 9620 '0.2
  499. 9625 SETUSERNUMBER%=OLDUSERNUMBER%: GOSUB 300
  500. 9630 OPEN "r", #2, OLDUSER$, 62
  501. 9640 FIELD #2,
  502.     2  AS CLASS$,
  503.     48 AS FRLNLOC$,
  504.     4  AS COUNT$,
  505.     6  AS DATE$,
  506.     2  AS CR$
  507. 9650 GET #2,1    'read header
  508. 9660 FIELD #2, 5 AS USERS$
  509. 9670 USERS=VAL(USERS$)
  510. 9675 GOSUB 3100
  511. 9680 PRINT: PRINT OLDUSER$;" open.  - ";USERS;"in the file."
  512. 9685 PRINT:PRINT
  513. 9690 RETURN
  514. 9700 '
  515. 9701 '    request conversion parameters
  516. 9702 '
  517. 9703 GOSUB 3100        'clear screen
  518. 9704 PRINT:PRINT TAB(25);"USERS file convertor"
  519. 9705 PRINT TAB(20);"RBBENT27.BAS version ";VERSION$
  520. 9706 FOR I%=0 TO 10
  521. 9707    ARYCLASS$=""
  522. 9708 NEXT I%
  523. 9709 PRINT:PRINT: USERFILE$="USERS"
  524. 9710 PRINT TAB(24);"Name of old USERS file > ";
  525. 9711 MAX%=14: GOSUB 500
  526. 9712 IF NKEY%=0 THEN GOTO 9703 ELSE OLDUSER$=ANSWER$
  527. 9713 TABER%=15-LEN(OLDUSER$)
  528. 9714 PRINT: PRINT TAB(TABER%);"User number where ";OLDUSER$;" can be found > ";
  529. 9715 MAX%=2: GOSUB 500
  530. 9716 IF NKEY%=0 THEN GOTO 9703 ELSE
  531.     OLDUSERNUMBER%=VAL(ANSWER$)
  532. 9717 PRINT:PRINT
  533. 9718 PRINT TAB(20);"Assign SIGNON access levels to RBBENT27 classes."
  534. 9719 PRINT TAB(20);"Enter ** when finished with list."
  535. 9720 PRINT TAB(20);"Examples of classes are RG for regular, SP for special."
  536. 9721 PRINT:PRINT
  537.      "Remeber that access levels above";PWDACL%;"will have passwords."
  538. 9722 PRINT:PRINT
  539.     "and those from"; SPECIALEVEL%;"on up are special users."
  540. 9723 PRINT : PRINT TAB(6);"class"; TAB(18); "access level"
  541. 9724 FOR I%=0 TO 10
  542. 9725    PRINT TAB(5);"> ";
  543. 9726    MAX%=1: GOSUB 500
  544. 9727    IF NKEY%=0 THEN GOTO 9725
  545. 9728        ARYCLASS$(I%)=ANSWER$ 
  546. 9729    IF ANSWER$="**" THEN GOTO 9734
  547. 9730    PRINT TAB(20);"> ";
  548. 9731    MAX%=1: GOSUB 500
  549. 9732    IF NKEY%=0 THEN PRINT "Class ";ARYCLASS$;" ignored - re-enter":
  550.         GOTO 9725
  551.         ELSE ARYACLVL%(I%)=VAL(ANSWER$)
  552. 9733 NEXT I%
  553. 9734 PRINT:PRINT TAB(20);"Everyone else should be assigned access level > ";
  554. 9735 MAX%=2: GOSUB 500
  555. 9736 IF NKEY%=0 THEN GOTO 9734
  556. 9737 IF VAL(ANSWER$) > 10 THEN PRINT "Too high!": GOTO 9734
  557. 9738 DEFACLVL%=VAL(ANSWER$)
  558. 9739 '
  559. 9740 '    confirm selection
  560. 9741 '
  561. 9742 GOSUB 3100
  562. 9743 PRINT:PRINT:PRINT
  563. 9744 PRINT "Old USERS file: ";OLDUSER$;" in user";OLDUSERNUMBER%
  564. 9745 PRINT
  565. 9746 IF OLDUSER$=USERFILE$ AND OLDUSERNUMBER%=USERNUMBER% THEN
  566.     USERFILE$=USERFILE$+".NEW"
  567. 9747 PRINT: PRINT "New USERS file: ";USERFILE$;" in user";USERNUMBER%
  568. 9748 IF USERFILE$="USERS.NEW" THEN
  569.     PRINT:
  570.     PRINT TAB(10);"Since your old USERS file is the same name as":
  571.     PRINT TAB(10);"the new USERS and in the same user area,"
  572. 9749 IF USERFILE$="USERS.NEW" THEN
  573.     PRINT TAB(10);"the new USERS file is being re-named as":
  574.     PRINT TAB(10);"USERS.NEW. You'll have to change it to":
  575.     PRINT TAB(10);"USERS later."
  576. 9750 PRINT: PRINT "Default access level is";DEFACLVL%
  577. 9751 PRINT: PRINT "Other classes of users will be:"
  578. 9753 PRINT "class    level"
  579. 9754 FOR I%=0 TO 10
  580. 9755    IF ARYCLASS$(I%)<>"**" AND ARYCLASS$(I%)<>""
  581.          THEN PRINT ARYCLASS$(I%); TAB(11); ARYACLVL%(I%)
  582. 9756 NEXT I%
  583. 9757 PRINT:PRINT "Is all of this ok? > ";
  584. 9758 MAX%=0: GOSUB 500
  585. 9759 IF ANSWER$="N" THEN GOTO 9703
  586. 9760 RETURN
  587. 10000 '
  588. 10005 '    main program starts here
  589. 10010 ' 1.0
  590. 10020 GOSUB 1100    'get configuration parameters
  591. 10022 GOSUB 9700    'get parameters for conversion
  592. 10025 GOSUB 9600    'open old USERS file
  593. 10030 GOSUB 1400    'open new users file
  594. 10035 '
  595. 10040 ' main transfer loop
  596. 10045 '
  597. 10050 FOR I%=2 TO USERS
  598. 10052    GOSUB 1700        'assign default variables
  599. 10055    GOSUB 9500        'move to working
  600. 10060    GOSUB 200        'write to SIGNON users file
  601. 10065 NEXT I%
  602. 10070 '
  603. 10075 '    update new user file's header
  604. 10080 '
  605. 10085 NEXTUSER=I%    'next available slot in USERS file
  606. 10086 GOSUB 1600    'get date & time
  607. 10090 UDATE$=DATE$    'date file was re-organized
  608. 10095 UTIME$=TIME$    'time of re-org
  609. 10100 GOSUB 275        'finish up header & close file
  610. 10200 GOSUB 3100
  611. 10210 PRINT:PRINT:PRINT
  612. 10220 PRINT TAB(20);USERFILE$;" written.
  613. 10300 SETUSERNUMBER%=0: GOSUB 300
  614. 20000 END
  615.