home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol130 / tos.bas < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  2.3 KB  |  85 lines
  1. 1 '    signon subsystem -- time on system
  2. 4 VERSION$="1.4 {10/14/82}"    '1.00 was initial release
  3. 7 '    by dick lieber
  4. 12 MODNAME$="TOS"
  5. 22 '
  6. 27 PWDFILE$="pwds"    'subsystem configuration file
  7. 32 LASTCALRFILE$="LASTCALR. "+CHR$(&HA0)+" "
  8. 37 COMMENTFILE$="COMMENTS"
  9. 42 CRLF$=CHR$(&HD)+CHR$(&HA)
  10. 47 BSTRING$=CHR$(8)+" "+CHR$(8)
  11. 52 DEFDRIVE$="A:"
  12. 57 DIM ACLARRAY%(5,11)
  13. 88 DEF FNHOURS$(TIME)=STR$(INT(TIME/60))+":"+
  14.  
  15.     RIGHT$("00"+MID$(STR$(TIME-(INT(TIME/60)*60)),2),2)
  16. 100 '
  17. 101 '    function definition
  18. 102 '
  19. 103 '    add deliminators to time or date
  20. 104 DEF FNADDSEP$(DS$,DELIM$)=
  21.  
  22.     LEFT$(DS$,2)+DELIM$+MID$(DS$,3,2)+DELIM$+RIGHT$(DS$,2)
  23. 105 '    remove date or time deliminators
  24. 106 DEF FNKILLSEP$(DS$)=LEFT$(DS$,2)+MID$(DS$,4,2)+RIGHT$(DS$,2)
  25. 107 DEF FNLINES$(NLINES%)=STRING$(NLINES%,CRLF$)
  26. 112 ON ERROR GOTO 1000
  27. 115 GOTO 10000    ' main program begins after sub routines
  28. 118 '
  29. 121 ' routines used by signon
  30. 124 '
  31. 300 '
  32. 302 '    set user number
  33. 304 '
  34. 306 USERMD=TESTADDRESS+9
  35. 312 CALL USERMD(SETUSERNUMBER%)
  36. 345 RETURN
  37. 400 %INCLUDE 400500.SSB
  38. 1000 '
  39. 1004 '    Error handler
  40. 1008 '1.1
  41. 1012 A$="Error Trap":CR%=2: GOSUB 400
  42. 1020 PRINT "ERR = ";ERR, "ERL = ";ERL
  43. 1023 IF ERR=53 THEN NOFILE%=1
  44. 1024 IF ERR = 53 THEN RESUME NEXT    ' file not found
  45. 1028 END
  46. 1100 %INCLUDE 1100.SSB
  47. 1600 %INCLUDE 1600.SSB
  48. 2100 %include 2100.SSB
  49. 8000 %include 8000.SSB
  50. 9000 '
  51. 9005 '    get lastcal info
  52. 9010 '
  53. 9012 SETUSERNUMBER%=0: GOSUB 300
  54. 9015 OPEN "I", #1, DEFDRIVE$+LASTCALRFILE$
  55. 9025    INPUT #1, FRNAME$, LNAME$, ACLVL%, LDATE$, LTIME$
  56. 9035 CLOSE #1
  57. 9045 RETURN
  58. 9100 %INCLUDE 9100.SSB
  59. 10000 '
  60. 10010 '    main program
  61. 10020 '1.1
  62. 10025 NOFILE%=0
  63. 10030 GOSUB 1100
  64. 10031 ' WARNING - the next line won't work in interp. 
  65. 10032 IF NOFILE%<>0 THEN SETUSERNUMBER%=0:GOSUB 300: GOSUB 10025
  66. 10035 PRINT
  67. 10040 IF NOCLOCK% <> 0 THEN 
  68.  
  69.     A$="Sorry, the system clock is not available.":
  70.  
  71.     CR%=2: GOSUB 400:
  72.  
  73.     GOTO 10120
  74. 10050 GETDAY%=1
  75. 10060 GOSUB 1600
  76. 10065 STIME$=TIME$
  77. 10070 A$=FNADDSEP$(TIME$,":")+" "+DAY$+" "+FNADDSEP$(DATE$,"/"):
  78.  
  79.     CR%=2: GOSUB 400
  80. 10080 GOSUB 9000    'get user name etc
  81. 10085 IF LEFT$(FRNAME$,1)="~" THEN
  82.  
  83.     A$="No one is signed on!": CR%=2: GOSUB 400: GOTO 10120
  84. 10090 GOSUB 9100    'calc elapsed time
  85. 10100 A$="You've been on for"+FNHOURS$(ELAPMINUTES)+" (hr:mn).":
  86.  
  87.     CR%=2: GOSUB 400
  88. 10120 ASKFORCOM%=1
  89. 10130 NOTATION$="via TOS"
  90. 10140 GOSUB 2100    'comment
  91. 10145 SETUSERNUMBER%=0: GOSUB 300    'makes testing easier
  92. 10150 END
  93.