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