1000 ! USERS.BAC
1005 INTEGER : EXTEND 
1010 ; '** List current users **'
1020 ; '   Ver X.05, 1985-02-15'
1030 ; '   Copyright 1984 Dataindustrier AB'
1040 ! *
1050 ! *  Written by G|ran Nordenborg
1060 ! ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** 
1070 ! *
1080 ! * Rev date / Rev nr / Sign / Note
1090 ! * 84-07-30 /  X.00  /  GN  / Main
1100 ! * 84-08-20 /  X.01  /  GN  / No disabled UFD listings
1110 ! * 84-08-21 /  X.02  /  GN  / Include central login priority
1120 ! * 84-09-05 /  X.03  /  GN  / Correct 'Own' listing when logged out
1130 ! * 85-02-15 /  X.04  /  BL  / Talknet calls NETCALL, check if Lux-net
1140 ! * 85-02-15 /  X.05  /  BL  / Accessible from DOS, FNStartpar$ handling
1150 ! *
1160 ! ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
1170 ! *
1180 ! *  Main routine
1190 ! *
1200 IF FNInitialize ; 'Error during USERS initalize' : GOTO 1240
1210 ; 
1220 IF FNListusers THEN ; 'Error during users list'
1230 IF Option AND Optlive THEN IF SYS(5)=0 THEN ; TAB(79); : GOTO 1220 ELSE GET Buff$
1240 ; FNExit
1250 ! *********************************
1260 ! *
1270 ! *  All initialisations
1280 ! *
1290 DEF FNInitialize
1300   F=0
1310   T=-1
1320   DIM Hmonth.(12)
1330   Lud=1
1340   Tbusn=1
1350   Tbuna=Tbusn+5
1360   Tbgnr=Tbuna+9
1370   Tbdir=Tbgnr
1380   Tblpi=Tbgnr+7
1390   Tbltm=Tblpi+7
1400   Tbetm=Tbltm+14
1410   Tbwtm=Tbetm+13
1420   Tbown=Tbwtm+13
1430   Tbend=Tbown+6
1440   Optdir=1
1450   Optlive=2
1460   FOR Month=2 TO 12
1470     READ Days.
1480     Hmonth.(Month)=Hmonth.(Month-1)+Days.*24.
1490   NEXT Month 
1500   Month$='JanFebMarAprMayJunJulAugSepOctNovDec'
1510   Maxuser=32
1520   OPEN 'CON:' AS FILE Lud
1530   Buff$=''
1540   POKE VAROOT(Buff$),0,1,0,245,0,1
1550   IF FNGetstat(254) THEN RETURN T
1560   Ownuser=User
1570   Ownpriv=Lpriv
1580   IF (Ownpriv AND (8+4))<>8+4 THEN RETURN F
1590   ! *
1600   ! *  Super user, ask for options
1610   ! *
1620   Option$=FNStartpar$ : IF LEN(Option$)=0 GOTO 1660
1630   WHILE ASCII(Option$)=32 : Option$=RIGHT$(Option$,2) : WEND 
1640   IF ASCII(Option$)=45 Option$=RIGHT$(Option$,2)
1650   GOTO 1710
1660   ; : ; 'D  - List directory names and status'
1670   ; 'L  - Live'
1680   ; 'Options (D,L,none) ';
1690   INPUT LINE Option$
1700   Option$=LEFT$(Option$,LEN(Option$)-2)
1710   IF LEN(Option$)=0 THEN RETURN F
1720   IF LEFT$(Option$,1)='D' OR LEFT$(Option$,1)='d' THEN Option=Optdir : Option$=RIGHT$(Option$,2)
1730   IF LEN(Option$)=0 THEN RETURN F
1740   IF LEFT$(Option$,1)='L' OR LEFT$(Option$,1)='l' THEN Option=Option OR Optlive : ; #Lud CHR$(12);
1750   IF INSTR(1,Option$,',') THEN OPEN RIGHT$(Option$,INSTR(1,Option$,',')+1) AS FILE Lud
1760   RETURN F
1770   DATA 31,28,31,30,31,30,31,31,30,31,30,31
1780 FNEND 
1790 ! *********************************
1800 ! *
1810 ! *  List user status
1820 ! *
1830 DEF FNListusers
1840   IF Option AND Optlive THEN ; #Lud CUR(0,0);
1850   ; #Lud TAB(Tbusn) 'User' TAB(Tbuna) 'Name' TAB(Tbgnr) '   Grp' TAB(Tblpi) 'Priv';
1860   ; #Lud TAB(Tbltm) 'Login time' TAB(Tbetm) 'Elapsed time' TAB(Tbwtm) 'Acc wait'
1870   FOR Usernr=0 TO Maxuser
1880     IF FNGetstat(Usernr) THEN RETURN T
1890     IF (Lpriv AND 1)=0 THEN 2130
1900     ; #Lud TAB(Tbusn);
1910     ; #Lud USING '####' User;
1920     ; #Lud TAB(Tbuna) Username$;
1930     ; #Lud TAB(Tbgnr);
1940     ; #Lud USING '######' FNNsgn.(Group);
1950     ; #Lud TAB(Tblpi) Lpriv$;
1960     ; #Lud TAB(Tbltm) Ltime$;
1970     ; #Lud TAB(Tbetm);
1980     IF Ehtime.<>0. THEN ; #Lud NUM$(Ehtime.);':';
1990     ; #Lud RIGHT$(NUM$(100+Estime/60),2);'.';RIGHT$(NUM$(100+MOD(Estime,60)),2);
2000     ; #Lud TAB(Tbwtm);
2010     IF Wstime=-1 THEN ; #Lud '**.**'; : GOTO 2040
2020     IF Whtime.<>0. THEN ; #Lud NUM$(Whtime.);':';
2030     ; #Lud RIGHT$(NUM$(100+Wstime/60),2);'.';RIGHT$(NUM$(100+MOD(Wstime,60)),2);
2040     IF User=Ownuser THEN ; #Lud TAB(Tbown) 'Own ';
2050     ; #Lud TAB(Tbend)
2060     IF (Option AND Optdir)=0 THEN 2130
2070     ! *
2080     ! *  List directory names
2090     ! *
2100     IF Ufdent THEN IF FNGetufd(Ufdent,Ufdpdn) THEN RETURN T ELSE ; #Lud TAB(Tbdir) 'UFD: - ';Ufd$ TAB(Tbend)
2110     IF Lfdent THEN IF FNGetufd(Lfdent,Lfdpdn) THEN RETURN T ELSE ; #Lud TAB(Tbdir) 'LFD: - ';Ufd$ TAB(Tbend)
2120     IF Pfdent THEN IF FNGetufd(Pfdent,Pfdpdn) THEN RETURN T ELSE ; #Lud TAB(Tbdir) 'PFD: - ';Ufd$ TAB(Tbend)
2130   NEXT Usernr 
2140   RETURN F
2150 FNEND 
2160 ! ******************************************
2170 ! *
2180 ! *  Get status for user
2190 ! *
2200 DEF FNGetstat(Usernr)
2210   IF FNTalknet(14,0,0,0,0,Usernr) THEN RETURN T
2220   Lpriv=ASCII(MID$(Buff$,51,1))
2230   IF (Lpriv AND 1)=0 THEN User=-1 : RETURN F ! Logged out
2240   Htime.=ASCII(MID$(Buff$,33,1))*8760.+Hmonth.(ASCII(MID$(Buff$,34,1)))+(ASCII(MID$(Buff$,35,1))-1)*24.+ASCII(MID$(Buff$,36,1))
2250   Stime=ASCII(MID$(Buff$,37,1))*60+ASCII(MID$(Buff$,38,1))
2260   User=ASCII(MID$(Buff$,39,1))
2270   Username$=MID$(Buff$,40,8)
2280   Group=CVT$%(MID$(Buff$,48,2))
2290   Lprot=ASCII(MID$(Buff$,50,1))
2300   Lpriv=ASCII(MID$(Buff$,51,1))
2310   Fprot=ASCII(MID$(Buff$,52,1))
2320   Ltime$=FNTime$(MID$(Buff$,53,6))
2330   Ehtime.=Htime.-ASCII(MID$(Buff$,53,1))*8760.-Hmonth.(ASCII(MID$(Buff$,54,1)))-(ASCII(MID$(Buff$,55,1))-1)*24.-ASCII(MID$(Buff$,56,1))
2340   Estime=Stime-ASCII(MID$(Buff$,57,1))*60-ASCII(MID$(Buff$,58,1))
2350   IF Estime<0 THEN Estime=Estime+3600 : Ehtime.=Ehtime.-1.
2360   Ufdprot=ASCII(MID$(Buff$,66,1))
2370   Ufdent=CVT$%(MID$(Buff$,67,2))
2380   Ufdpdn=ASCII(MID$(Buff$,69,1))
2390   Lfdprot=ASCII(MID$(Buff$,74,1))
2400   Lfdent=CVT$%(MID$(Buff$,75,2))
2410   Lfdpdn=ASCII(MID$(Buff$,77,1))
2420   Pfdprot=ASCII(MID$(Buff$,78,1))
2430   Pfdent=CVT$%(MID$(Buff$,79,2))
2440   Pfdpdn=ASCII(MID$(Buff$,81,1))
2450   Whtime.=Htime.-ASCII(MID$(Buff$,59,1))*8760.-Hmonth.(ASCII(MID$(Buff$,60,1)))-(ASCII(MID$(Buff$,61,1))-1)*24.-ASCII(MID$(Buff$,62,1))
2460   Wstime=Stime-ASCII(MID$(Buff$,63,1))*60-ASCII(MID$(Buff$,64,1))
2470   IF Wstime<0 THEN Wstime=Wstime+3600 : Whtime.=Whtime.-1.
2480   IF MID$(Buff$,59,6)=CHR$(0,0,0,0,0,0) THEN Wstime=-1
2490   ! *
2500   ! *  convert user privilegie to string
2510   ! *
2520   Lpriv$='------'
2530   IF Lpriv AND 32 THEN MID$(Lpriv$,1,1)='C' ! Central login
2540   IF Lpriv AND 16 THEN MID$(Lpriv$,2,1)='X' ! Central task
2550   IF Lpriv AND 8 THEN MID$(Lpriv$,3,1)='D' ! Direct access
2560   IF Lpriv AND 4 THEN MID$(Lpriv$,4,1)='S' ! Super user
2570   IF Lpriv AND 2 THEN MID$(Lpriv$,5,1)='G' ! Group master
2580   IF Lpriv AND 1 THEN MID$(Lpriv$,6,1)='U' ! Logged in user
2590   RETURN F
2600 FNEND 
2610 ! *********************************
2620 ! *
2630 ! *  Do communication with net central.
2640 ! *
2650 DEF FNTalknet(Fc,Sfc,B,C,D,E) LOCAL Z
2660   IF PEEK(PEEK2(24616))=201 RETURN -1 ! This is not a Lux-net!!!
2670   POKE 64798,255 ! 0FFH -> BSAVE. => TFT. fake (use DOSBUF0).
2680   POKE 64961,Fc ! FC -> MSG.FC (Function code).
2690   POKE 64962,Sfc ! SFC -> MSG.SFC (Subfunction code).
2700   POKE 64963,C,B ! MSG.PDN, MSG.ERRB (BC register to/from central).
2710   POKE 64965,E,D ! Register DE to/from central.
2720   Z=CALL(24615) ! NETCALL => Talk to the central.
2730   RETURN PEEK(64962)
2740 FNEND 
2750 ! **********************************
2760 ! *
2770 ! *  Calculate a time string
2780 ! *
2790 DEF FNTime$(Timebuff$)
2800   Month=ASCII(MID$(Timebuff$,2,1))
2810   Day=ASCII(MID$(Timebuff$,3,1))
2820   Year=ASCII(MID$(Timebuff$,1,1))
2830   Hour=ASCII(MID$(Timebuff$,4,1))
2840   Minute=ASCII(MID$(Timebuff$,5,1))
2850   IF Month>12 OR Month=0 OR Day>31 OR Day=0 OR Hour>23 OR Minute>59 THEN RETURN ''
2860   Tm$=MID$(Month$,Month*3-2,3)+' '+RIGHT$(NUM$(100+Day),2)
2870   IF Year<80 THEN Year=Year+100
2880   IF MOD(Year,100)<>PEEK(-17) THEN Tm$=Tm$+'  '+NUM$(1900+Year) ELSE Tm$=Tm$+' '+RIGHT$(NUM$(100+Hour),2)+':'+RIGHT$(NUM$(100+Minute),2)
2890   RETURN Tm$
2900 FNEND 
2910 ! ****************************************
2920 ! *
2930 ! *  Get UFD name
2940 ! *
2950 DEF FNGetufd(Ufd,Devnr) LOCAL Buff$=256
2960   ! *
2970   ! *  Find device name
2980   ! *
2990   Devpnt=PEEK2(-133)
3000   WHILE FNGetdev=0
3010   IF Dev$<>'DR0' THEN WEND 
3020   Floppyhandler=Devhandler
3030   Devpnt=PEEK2(-133)
3040   WHILE FNGetdev=F
3050   IF Devhandler<>Floppyhandler OR Devnumber<>Devnr THEN WEND 
3060   Dev$=Dev$+':'
3070   ON ERROR GOTO 3290
3080   OPEN Dev$ AS FILE 99
3090   Ufd$=''
3100   WHILE Ufd<>0
3110     POKE -767,Devnr
3120     POSIT #99 (Ufd-1)*253. ! Read UFD header
3130     GET #99 Buff$ COUNT 253
3140     IF PEEK(-747) THEN RETURN PEEK(-747)
3150     Ufd=CVT$%(MID$(Buff$,1,2))
3160     Pfn=ASCII(MID$(Buff$,3,1))
3170     POSIT #99,(Ufd+(Pfn AND 15)-(Ufd=0)*16)*253.
3180     GET #99 Buff$ COUNT 253
3190     Buff$=MID$(Buff$,(Pfn AND 240)+1,8)
3200     FOR Pnt=1 TO 7
3210       IF MID$(Buff$,Pnt,1)=' ' THEN 3230
3220     NEXT Pnt 
3230     Pnt=Pnt-1
3240     IF Ufd$<>'' THEN Ufd$='/'+Ufd$
3250     Ufd$=LEFT$(Buff$,Pnt)+Ufd$
3260   WEND 
3270   Ufd$=Dev$+Ufd$
3280   RETURN F
3290   RESUME 3300
3300   RETURN T
3310 FNEND 
3320 ! ********************************
3330 ! *
3340 ! *  Get next device
3350 ! *
3360 DEF FNGetdev
3370   IF Devpnt=0 THEN RETURN T
3380   Dev$=CHR$(PEEK(Devpnt+2),PEEK(Devpnt+3),PEEK(Devpnt+4))
3390   Devhandler=PEEK2(Devpnt+5)
3400   Devnumber=PEEK(Devpnt+7)
3410   Devpnt=PEEK2(Devpnt)
3420   RETURN F
3430 FNEND 
3440 ! **************************************
3450 ! *
3460 ! *  Unsign integer
3470 ! *
3480 DEF FNNsgn.(Intgr)
3490   IF Intgr<0 THEN RETURN Intgr+65536. ELSE RETURN Intgr
3500 FNEND 
3510 ! 
3520 ! *********************************
3530 ! *
3540 ! *  Check if user entered from DOS or BASIC
3550 ! *
3560 DEF FNChkdos LOCAL I
3570   I=PEEK2(65302)-160
3580   WHILE I<160 : IF PEEK2(I)=-212 RETURN -1
3590   IF PEEK(I)<>13 I=I+1 : WEND 
3600   RETURN 0
3610 FNEND 
3620 ! 
3630 ! **********************************
3640 ! *
3650 ! *  Get start parameter string (if any)
3660 ! *
3670 DEF FNStartpar$ LOCAL Cmdsp,I,Cmd$=160
3680   Cmdsp=PEEK2(65302)-160
3690   WHILE I<160 : I=I+1 : IF PEEK(Cmdsp+I-1)=44 GOTO 3720
3700     IF PEEK(Cmdsp+I-1)=13 RETURN '' ! No startpar string
3710   WEND : RETURN '' ! No startpar string
3720   IF PEEK(Cmdsp+I)=255 I=I+1 ! Skip DOS-entry flag
3730   WHILE I<160 : IF PEEK(Cmdsp+I)=13 GOTO 3760
3740     IF PEEK(Cmdsp+I)<32 OR PEEK(Cmdsp+I)>127 RETURN ''
3750   Cmd$=Cmd$+CHR$(PEEK(Cmdsp+I)) : I=I+1 : WEND 
3760   RETURN Cmd$
3770 FNEND 
3780 ! 
3790 ! *************************************
3800 ! *
3810 ! *  Exit to DOS or BASIC
3820 ! *
3830 DEF FNExit LOCAL A$=21,A
3840   IF FNChkdos=0 GOTO 3890 ELSE CLOSE ! We MUST close ALL files!!!
3850   A$='CMDINT  SYS'+CHR$(14,255,205,27,96,216,195,3,193)
3860   A=VARPTR(A$)
3870   IF CALL(A+11,A) ; "Can't load CMDINT.SYS, press any key for RESET!";
3880   GET A$ : IF CALL(0) REM Just a miracle would get through here...
3890   END ! End to get out of a function is ugly but...
3900 FNEND