1000 ! * PASSWD.BAC 1005 INTEGER : EXTEND 1010 ; '** Change password **' 1020 ; ' Ver X.02, 1985-02-15' 1030 ; ' Copyright 1984 Dataindustrier AB' 1040 ; 1050 ! * Written by G|ran Nordenborg 1060 ! ** ** ** ** ** ** ** ** ** ** ** 1070 ! * 1080 ! * Ver date / Ver nb / Sign / Note 1090 ! * 84-10-24 / X.00 / GN / Main 1100 ! * 85-02-15 / X.01 / BL / Talknet calls NETCALL + check if Lux-net 1110 ! * 85-02-15 / X.02 / BL / Accessible from DOS 1120 ! * 1130 ! ** ** ** ** ** ** ** ** ** ** ** 1140 ! * 1150 ! EJECT 1160 ! ******************************** 1170 ! * 1180 ! * Main routine 1190 ! * 1200 IF FNPasswd THEN ; 'PASSWD abort' 1210 ; FNExit 1220 ! EJECT 1230 ! ************************************ 1240 ! * 1250 ! * Change password and file default prot 1260 ! * 1270 DEF FNPasswd 1280 IF FNInitialize THEN RETURN T 1290 IF FNGetstat(254) THEN RETURN T 1300 ; 'Old password: '; 1310 Oldpsw$=FNCapstr$(LEFT$(FNInputstar$+SPACE$(8),8)) 1320 ; 1330 ; 'New password: '; 1340 Newpsw$=FNCapstr$(LEFT$(FNInputstar$+SPACE$(8),8)) 1350 ; 1360 ; 'New password one more time: '; 1370 Newchk$=FNCapstr$(LEFT$(FNInputstar$+SPACE$(8),8)) 1380 ; 1390 IF Newpsw$<>Newchk$ THEN ; 'Double check not equal' : RETURN T 1400 ; 'Old file default privilege '''; 1410 IF Fprot AND 128 THEN ; 'D'; ELSE ; '-'; 1420 IF Fprot AND 64 THEN ; 'L'; ELSE ; '-'; 1430 FOR Prottype=0 TO 2 1440 IF Fprot AND (2^(Prottype*2+1)) THEN ; '-'; ELSE ; 'W'; 1450 IF Fprot AND (2^(Prottype*2)) THEN ; '-'; ELSE ; 'R'; 1460 NEXT Prottype 1470 ; '''' 1480 ; 'New file privilege ''LWRWRWR'': '; 1490 ! * 1500 ! * Get default file protection 1510 ! * 1520 GET Temp$ 1530 IF Temp$=CHR$(13) THEN 1630 1540 Fprot=0 1550 IF INSTR(1,'LlYyJjXx',Temp$) THEN ; 'L'; : Fprot=Fprot OR 64 ELSE ; '-'; 1560 FOR Prottype=0 TO 2 1570 GET Temp$ 1580 IF INSTR(1,'WwYyJjXx',Temp$) THEN ; 'W'; ELSE ; '-'; : Fprot=Fprot OR (2^(Prottype*2+1)) 1590 GET Temp$ 1600 IF INSTR(1,'RrYyJjXx',Temp$) THEN ; 'R'; ELSE ; '-'; : Fprot=Fprot OR (2^(Prottype*2)) 1610 NEXT Prottype 1620 ; 1630 ! * 1640 ! * Time to form net message 1650 ! * 1660 Buff$=Username$+Oldpsw$+Newpsw$+CHR$(Fprot) 1670 Error=FNTalknet(64+14,13,0,0,0,Chpasswd+Chdefpri) 1680 IF Error THEN ; 'Error' Error 'during net execute' : RETURN T 1690 RETURN F 1700 FNEND 1710 ! ************************************ 1720 ! * 1730 ! * All initialisations 1740 ! * 1750 DEF FNInitialize 1760 F=0 1770 T=-1 1780 Chpasswd=1 ! Do change password flag 1790 Chdefpri=2 ! Do change default file priv flag 1800 OPEN 'CON:' AS FILE Lud 1810 Buff$=' ' 1820 POKE VAROOT(Buff$),0,1,0,245,0,1 ! DOS buffer 0 (F500) 1830 RETURN F 1840 FNEND 1850 ! ************************************** 1860 ! * 1870 ! * Make string block letters 1880 ! * 1890 DEF FNCapstr$(Str$) 1900 FOR Strpnt=1 TO LEN(Str$) 1910 IF MID$(Str$,Strpnt,1)>=CHR$(97) THEN MID$(Str$,Strpnt,1)=CHR$(ASCII(MID$(Str$,Strpnt,1)) AND 223) 1920 NEXT Strpnt 1930 RETURN Str$ 1940 FNEND 1950 ! ********************************** 1960 ! * 1970 ! * Input string, echo stars 1980 ! * 1990 DEF FNInputstar$ 2000 Star$='' 2010 GET Startemp$ 2020 WHILE Startemp$<>CHR$(13) 2030 IF Startemp$=CHR$(8) THEN IF LEN(Star$) THEN ; CHR$(8,32,8); : Star$=LEFT$(Star$,LEN(Star$)-1) : GOTO 2080 2040 IF Startmp$=CHR$(24) THEN ; STRING$(LEN(Star$),8) SPACE$(LEN(Star$)) STRING$(LEN(Star$),8); : Star$='' : GOTO 2080 2050 IF Startemp$<' ' OR LEN(Star$)>8 THEN 2080 2060 Star$=Star$+Startemp$ 2070 ; '*'; 2080 GET Startemp$ 2090 WEND 2100 RETURN Star$ 2110 FNEND 2120 ! ******************************** 2130 ! * 2140 ! * Do communication with net central. 2150 ! * 2160 DEF FNTalknet(Fc,Sfc,B,C,D,E) LOCAL Z 2170 IF PEEK(PEEK2(24616))=201 RETURN -1 ! This is not a Lux-net!!! 2180 POKE 64961,Fc ! FC -> MSG.FC (Function code). 2190 POKE 64962,Sfc ! SFC -> MSG.SFC (Subfunction code). 2200 POKE 64963,C,B ! MSG.PDN, MSG.ERRB (BC register to/from central). 2210 POKE 64965,E,D ! Register DE to/from central. 2220 POKE 64798,255 ! TFT fake => BSAVE. 2230 Z=CALL(24615) ! NETCALL => Talk to the central. 2240 RETURN PEEK(64962) 2250 FNEND 2260 ! ****************************************** 2270 ! * 2280 ! * Get status for user 2290 ! * 2300 DEF FNGetstat(Usernr) 2310 IF FNTalknet(14,0,0,0,0,Usernr) THEN RETURN T 2320 Lpriv=ASCII(MID$(Buff$,51,1)) 2330 IF (Lpriv AND 1)=0 THEN ; 'You must be logged in' : RETURN T 2340 Username$=MID$(Buff$,40,8) 2350 Group=CVT$%(MID$(Buff$,48,2)) 2360 Fprot=ASCII(MID$(Buff$,52,1)) 2370 RETURN F 2380 FNEND 2390 ! 2400 ! ********************************* 2410 ! * 2420 ! * Check if user entered from DOS or BASIC 2430 ! * 2440 DEF FNChkdos LOCAL I 2450 I=PEEK2(65302)-160 2460 WHILE I<160 : IF PEEK2(I)=-212 RETURN -1 2470 IF PEEK(I)<>13 I=I+1 : WEND 2480 RETURN 0 2490 FNEND 2500 ! 2510 ! ********************************** 2520 ! * 2530 ! * Get start parameter string (if any) 2540 ! * 2550 DEF FNStartpar$ LOCAL Cmdsp,I,Cmd$=160 2560 Cmdsp=PEEK2(65302)-160 2570 WHILE I<160 : I=I+1 : IF PEEK(Cmdsp+I-1)=44 GOTO 2600 2580 IF PEEK(Cmdsp+I-1)=13 RETURN '' ! No startpar string 2590 WEND : RETURN '' ! No startpar string 2600 IF PEEK(Cmdsp+I)=255 I=I+1 ! Skip DOS-entry flag 2610 WHILE I<160 : IF PEEK(Cmdsp+I)=13 GOTO 2640 2620 IF PEEK(Cmdsp+I)<32 OR PEEK(Cmdsp+I)>127 RETURN '' 2630 Cmd$=Cmd$+CHR$(PEEK(Cmdsp+I)) : I=I+1 : WEND 2640 RETURN Cmd$ 2650 FNEND 2660 ! 2670 ! ************************************* 2680 ! * 2690 ! * Exit to DOS or BASIC 2700 ! * 2710 DEF FNExit LOCAL A$=21,A 2720 IF FNChkdos=0 GOTO 2770 ELSE CLOSE ! We MUST close ALL files!!! 2730 A$='CMDINT SYS'+CHR$(14,255,205,27,96,216,195,3,193) 2740 A=VARPTR(A$) 2750 IF CALL(A+11,A) ; "Can't load CMDINT.SYS, press any key for RESET!"; 2760 GET A$ : IF CALL(0) REM Just a miracle would get through here... 2770 END ! End to get out of a function is ugly but... 2780 FNEND