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