home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol130 / finish.bas < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  5.1 KB  |  196 lines
  1. 1 '    signon subsystem -- finish (update user's record)
  2. 2 MODNAME$="FINISH"
  3. 4 VERSION$="1.4 {10/14/82}"    'not in 1.0
  4. 7 '    by dick lieber
  5. 13 '
  6. 28 '
  7. 49 PWDFILE$="pwds"    'subsystem configuration file
  8. 50 COMMENTFILE$="COMMENTS"
  9. 52 CALLERFILE$="CALLERS" 'log of users
  10. 55 USERFILE$="USERS"    'roster of users
  11. 56 LASTCALRFILE$="LASTCALR"
  12. 80 '
  13. 81 '    function definition
  14. 82 '
  15. 83 '    add deliminators to time or date
  16. 84 DEF FNADDSEP$(DS$,DELIM$)=
  17.  
  18.     LEFT$(DS$,2)+DELIM$+MID$(DS$,3,2)+DELIM$+RIGHT$(DS$,2)
  19. 85 '    remove date or time deliminators
  20. 86 DEF FNKILLSEP$(DS$)=LEFT$(DS$,2)+MID$(DS$,4,2)+RIGHT$(DS$,2)
  21. 88 DEF FNHOURS$(TIME)=STR$(INT(TIME/60))+":"+
  22.  
  23.     RIGHT$("00"+MID$(STR$(TIME-(INT(TIME/60)*60)),2),2)
  24. 90 DEF FNEROR$(SERRNUMB$)="System Error ("+SERRNUMB$+")."
  25. 94 '    constants:
  26. 96 CRLF$=CHR$(&HD)+CHR$(&HA)
  27. 97 BSTRING$=CHR$(8)+" "+CHR$(8)
  28. 98 DEFDRIVE$="A:"
  29. 99 DIM ACLARRAY%(5,11)
  30. 100 DIM FLAGS%(14)
  31. 103 '
  32. 106 '
  33. 109 '
  34. 112 ON ERROR GOTO 1000
  35. 115 GOTO 10000    ' main program begins after sub routines
  36. 118 '
  37. 121 ' routines used by signon
  38. 124 '
  39. 200 %INCLUDE 200.SSB
  40. 300 '
  41. 302 '    set user number
  42. 304 '
  43. 306 USERMD=TESTADDRESS+9
  44. 312 CALL USERMD(SETUSERNUMBER%)
  45. 345 RETURN
  46. 1000 '
  47. 1004 '    Error handler
  48. 1008 '1.1
  49. 1010 IF ERR=53 THEN NOFILE%=1: RESUME NEXT
  50. 1012 PRINT "Error Trap"
  51. 1020 PRINT "ERR = ";ERR, "ERL = ";ERL
  52. 1028 END
  53. 1100 %INCLUDE 1100.SSB
  54. 1200 '
  55. 1204 ' find name - get record
  56. 1208 ' 1.3
  57. 1211 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  58. 1212 NOTFOUND%=0
  59. 1216 REC%=2
  60. 1220 LAST$=SPACE$(14): FIRST$=RIGHT$(LAST$,10)
  61. 1224 LSET FIRST$=FRNAME$: LSET LAST$=LNAME$
  62. 1228    GET #1,REC%
  63. 1232    IF EOF(1) THEN NOTFOUND%=1:RETURN
  64. 1236    IF FFNAME$=FIRST$ AND FLNAME$=LAST$ THEN GOSUB 1300: RETURN
  65. 1240    REC%=REC%+1
  66. 1244 GOTO 1228
  67. 1300 %INCLUDE 1300.SSB
  68. 1400 %INCLUDE 1400.SSB
  69. 1600 %INCLUDE 1600.SSB
  70. 1900 '
  71. 1905 '    get date into sdate$ (sdate$ looks nice to print)
  72. 1910 '
  73. 1915 SDATE$=LEFT$(LDATE$,2)+"/"+MID$(LDATE$,3,2)+"/"+RIGHT$(LDATE$,2)
  74. 1920 RETURN
  75. 2300 %INCLUDE 2300.SSB
  76. 3100 %INCLUDE 3100.SSB
  77. 3200 '
  78. 3205 '    turn off status line
  79. 3206 ' 1.1
  80. 3210 A$=STATQUIT$ : GOSUB 3100
  81. 3215 RETURN
  82. 8000 %INCLUDE 8000.SSB
  83. 8500 '
  84. 8510 '    put information into CALLERFILE$
  85. 8520 '
  86. 8530 GET #3, NEXTRECORD
  87. 8540 LSET CTIMEON$ = STR$(ELAPTIME%)
  88. 8550 PUT #3, NEXTRECORD
  89. 8560 GET #3,1    'just to flush buffer
  90. 8570 CLOSE #3
  91. 8580 RETURN
  92. 8600 '
  93. 8605 '    open CALLERFILE$
  94. 8610 ' 1.0
  95. 8611 NOFILE%=0
  96. 8615 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
  97. 8620 OPEN "R",#3, DEFDRIVE$+CALLERFILE$, 75
  98. 8625 FIELD #3,
  99.  
  100.     8  AS CLOGCNT$,
  101.  
  102.     6  AS FCALDATE$,
  103.  
  104.     6  AS FCALTIME$,
  105.  
  106.     1  AS SIGNATURE$,
  107.  
  108.     8  AS CLREC$
  109. 8630 GET #3,1
  110. 8635 IF SIGNATURE$<>"*" THEN
  111.  
  112.     CLOSE #3:
  113.  
  114.     NOFILE%=1:
  115.  
  116.     COMMENT$=A$:GOSUB 8000:
  117.  
  118.     KILL DEFDRIVE$+CALLERFILE$:
  119.  
  120.     RETURN
  121. 8640 LOGCNT#=VAL(CLOGCNT$)
  122. 8645 NEXTRECORD = VAL(CLREC$)
  123. 8650 IF NOFIELD%<>0 THEN NOFIELD%=0: RETURN
  124. 8655 FIELD #3, 20 AS CFNAME$,
  125.  
  126.         20 AS CLNAME$,
  127.  
  128.         6  AS CDATE$,
  129.  
  130.         6  AS CTIME$,
  131.  
  132.         6  AS CTIMEON$,
  133.  
  134.         10 AS CNOTATION$,
  135.  
  136.         2  AS CCRLF$
  137. 8660 RETURN
  138. 9000 '
  139. 9005 '    get lastcal info
  140. 9010 '1.3    #
  141. 9012 SETUSERNUMBER%=0: GOSUB 300
  142. 9013 NOFILE%=0
  143. 9015 OPEN "I", #1, DEFDRIVE$+LASTCALRFILE$
  144. 9017 IF NOFILE%<>0 THEN
  145.  
  146.     CLOSE #1:
  147.  
  148.     COMMENT$="LASTCALR file not found":
  149.  
  150.     PRINT COMMENT$:
  151.  
  152.     GOSUB 8000: RETURN
  153. 9025 INPUT #1, FRNAME$, LNAME$, ACLVL%, LDATE$, LTIME$
  154. 9035 CLOSE #1
  155. 9045 RETURN
  156. 9100 %INCLUDE 9100.SSB
  157. 9900 '
  158. 9903 '    select default disk
  159. 9906 '    1.0    #
  160. 9909 SELDSK=TESTADDRESS+&HF
  161. 9912 CALL SELDSK(SELDRIVE%)
  162. 9915 RETURN
  163. 10000 '
  164. 10010 '    main program
  165. 10020 '1.11
  166. 10030 PRINT "FINISH version ";VERSION$;" is updating user's records."
  167. 10040 GOSUB 1100    'get configuration data
  168. 10050 IF NOFILE%<>0 THEN SETUSERNUMBER%=0: GOSUB 300: GOTO 10000
  169. 10060 NOTATION$="finish"
  170. 10070 GOSUB 9000    'get user
  171. 10080 IF NOFILE%<>0 THEN GOTO 10330
  172. 10085 IF LEFT$(FRNAME$,1)="~" THEN
  173.  
  174.     PRINT "Records previously updated.":
  175.  
  176.     GOTO 10330
  177. 10090 GOSUB 1600    'get time/date
  178. 10093 STIME$=TIME$
  179. 10100 GOSUB 9100    'calc elapsed time
  180. 10110 '     put information into users record
  181. 10120 GOSUB 1400    'open users
  182. 10130 GOSUB 1200    'search for users record
  183. 10140 IF NOTFOUND% <>0 THEN
  184.  
  185.     COMMENT$="Couldn't find "+FRNAME$+" "+LNAME$+"'s records.":
  186.  
  187.     PRINT COMMENT$:
  188.  
  189.     GOSUB 8000
  190. 10150 GOSUB 1300    'transfer to working vars
  191. 10160 ELAPTIME%=ELAPMINUTES
  192. 10180 TOTALTIME = TOTALTIME + ELAPMINUTES
  193. 10190 GOSUB 200        'put & close users records
  194. 10200 '    put information into CALLERFILE$
  195. 10210 GOSUB 8600    'open CALLERFILE$
  196. 10220 IF NOFILE%=0 THEN GOSUB 8500    'only update if file exists
  197. 10225 SETUSERNUMBER%=0: GOSUB 300
  198. 10227 SELDRIVE%=0: GOSUB 9900
  199. 10230 FCBNAME$ = LASTCALRFILE$
  200. 10240 RO%=0: GOSUB 2300
  201. 10250 OPEN "O", #1, DEFDRIVE$ + LASTCALRFILE$
  202. 10251    PRINT  #1, "~"; ",";
  203.  
  204.         "already"; ","; "updated"; ",";
  205.  
  206.         0; ",";"xxxxxxxx"; ","; "xxxxxxxx"
  207. 10252 CLOSE #1
  208. 10253 RO%=1: GOSUB 2300
  209. 10290 SETUSERNUMBER%=0: GOSUB 300
  210. 10310 PRINT "Records for ";FRNAME$;" ";LNAME$;" updated."
  211. 10320 PRINT "Signed off at ";FNADDSEP$(TIME$,":");
  212.  
  213.     " after";FNHOURS$(ELAPMINUTES);" (hr:mn)"
  214. 10322 IF STATUSLINE%<>0 THEN GOSUB 3200
  215. 10325 '    end processing
  216. 10330 PRINT: PRINT "Loading BYE..."
  217. 10340 NOFILE%=0
  218. 10350 RUN DEFDRIVE$+BYEPROG$
  219. 10360 IF NOFILE%<>0 THEN
  220.  
  221.     COMMENT$="Couldn't find "+DEFDRIVE$+BYEPROG$+".COM":
  222.  
  223.     PRINT COMMENT$:
  224.  
  225.     GOSUB 8000
  226. 10400 SETUSERNUMBER%=0: GOSUB 300
  227. 10420 POKE 4,0
  228. 20000 '
  229.