1000 ! * CHMOD.BAC
1005 INTEGER : EXTEND 
1010 ; '** Change protection on file **'
1020 ; '   Ver X.03, 1985-04-24'
1030 ; '   Copyright 1984 Dataindustrier AB'
1040 ; 
1050 ! *  Written by Benny L|fgren
1060 ! ** ** ** ** ** ** ** ** ** ** **
1070 ! *
1080 ! * Ver date / Ver nb / Sign / Note
1090 ! * 84-08-01 /  X.00  /  BL  / Main
1100 ! * 85-01-28 /  X.01  /  GN  / New program
1110 ! * 85-03-26 /  X.02  /  GN  / Change .Ufd privilegie
1120 ! * 85-04-24 /  X.03  /  BL  / Accessible from DOS, FNStartpar$ handling
1130 ! *
1140 ! ** ** ** ** ** ** ** ** ** ** **
1150 ! *
1160 ! EJECT
1170 ! ********************************
1180 ! *
1190 ! *  Main routine
1200 ! *
1210 IF FNChmod THEN ; 'CHMOD abort'
1220 ; FNExit
1230 ! EJECT
1240 ! *******************************
1250 ! *
1260 ! *  Change mod for file
1270 ! *
1280 DEF FNChmod
1290   IF FNInitialize THEN RETURN T
1300   Fd$=FNStartpar$ : IF Fd$='' INPUT 'File: 'Fd$
1310   IF Fd$='-?' THEN RETURN FNHelp
1320   Lft=FNOpen(Fd$,Lus)
1330   IF Lft=T THEN RETURN T
1340   IF FNTalknet(14,11,Lft,128+3,0,0) THEN RETURN T ! Read RIB
1350   Fprot=ASCII(MID$(Dosbuff$,256,1))
1360   ; #Lud 'New protection (';
1370   IF Fprot AND 64 THEN ; #Lud 'L'; ELSE ; #Lud '-';
1380   FOR Prottype=0 TO 2
1390     IF Fprot AND (2^(Prottype*2+1)) THEN ; #Lud '-'; ELSE ; #Lud 'W';
1400     IF Fprot AND (2^(Prottype*2)) THEN ; #Lud '-'; ELSE ; #Lud 'R';
1410   NEXT Prottype 
1420   ; #Lud '): ';
1430   GET Temp$
1440   IF Temp$=CHR$(13) THEN ; #Lud : RETURN T
1450   Fprot=0
1460   IF INSTR(1,'LlYyJjXx',Temp$) THEN ; #Lud 'L'; : Fprot=Fprot OR 64 ELSE ; #Lud '-';
1470   FOR Prottype=0 TO 2
1480     GET Temp$
1490     IF INSTR(1,'WwYyJjXx',Temp$) THEN ; #Lud 'W'; ELSE ; #Lud '-'; : Fprot=Fprot OR (2^(Prottype*2+1))
1500     GET Temp$
1510     IF INSTR(1,'RrYyJjXx',Temp$) THEN ; #Lud 'R'; ELSE ; #Lud '-'; : Fprot=Fprot OR (2^(Prottype*2))
1520   NEXT Prottype 
1530   ; #Lud
1540   IF FNTalknet(14,11,Lft,3,0,Fprot) THEN RETURN T
1550   RETURN F
1560 FNEND 
1570 ! ********************************
1580 ! *
1590 ! *  All initialisations
1600 ! *
1610 DEF FNInitialize
1620   F=0
1630   T=NOT F
1640   Dosbuff$=' '
1650   POKE VAROOT(Dosbuff$),0,1,0,245,0,1
1660   Lus=1
1670   Lud=Lus+1
1680   OPEN 'CON:' AS FILE Lud
1690   RETURN F
1700 FNEND 
1710 ! ******************************
1720 ! *
1730 ! *  Help texts
1740 ! *
1750 DEF FNHelp
1760   ; #Lud 'CHMOD is a utility to change privilegies for files. It'
1770   ; #Lud 'will ask for filename and new file privilegie. New user'
1780   ; #Lud 'privilegie is in in form ' Lwrwrwr ' where ' L ' means readable'
1790   ; #Lud 'when no logged in. ' Wr ' menas write and read privilegie'
1800   ; #Lud 'for user, group and others respectivily'
1810   RETURN F
1820 FNEND 
1830 ! *****************************
1840 ! *
1850 ! *  Open long file name
1860 ! *
1870 ! *  At exit  :  If error, exit T else exit LFT-number
1880 ! *
1890 DEF FNOpen(Fdp$,Luo) LOCAL Fpnt,Error,Opencode$=11,Fd$=256
1900   Fd$=FNCapstr$(Fdp$)+CHR$(13)
1910   IF LEN(Fd$)>4 THEN IF MID$(Fd$,LEN(Fd$)-4,4)='.UFD' THEN MID$(Fd$,LEN(Fd$)-4,4)='.Ufd'
1920   IF INSTR(1,Fd$,':')=0 THEN Devnr=255 ELSE IF FNDevnamenr(LEFT$(Fd$,INSTR(1,Fd$,':')-1)) THEN RETURN T ELSE Fd$=RIGHT$(Fd$,INSTR(1,Fd$,':')+1)
1930   OPEN 'DR0:' AS FILE Luo
1940   Fpnt=PEEK2(65344)
1950   WHILE PEEK(Fpnt+2)<>Luo
1960     Fpnt=PEEK2(Fpnt)
1970   WEND 
1980   Opencode$=CHR$(1,Devnr,PEEK(Fpnt+21),205,24,96,208,192,46,21,201) ! LDI BC,Lft:Devnr/CALL OPEN./RNC/RNZ/LI L,21/RET
1990   Error=CALL(VARPTR(Opencode$),VARPTR(Fd$))
2000   IF Error THEN CLOSE Luo : ; 'Error' Error 'during open of ''' Fdp$ '''' : RETURN T
2010   RETURN PEEK(Fpnt+21)
2020 FNEND 
2030 ! ******************************************
2040 ! *
2050 ! *  Convert device name to number
2060 ! *
2070 DEF FNDevnamenr(Devname$)
2080   Devpnt=PEEK2(-133)
2090   WHILE FNGetdev=F
2100     IF Dev$=Devname$ THEN Devnr=Devnumber : RETURN F
2110   WEND 
2120   ; 'Can''t find device ''' Devname$ ''''
2130   RETURN T
2140 FNEND 
2150 ! ********************************
2160 ! *
2170 ! *  Get next device
2180 ! *
2190 DEF FNGetdev
2200   IF Devpnt=0 THEN RETURN T
2210   Dev$=CHR$(PEEK(Devpnt+2),PEEK(Devpnt+3),PEEK(Devpnt+4))
2220   Devhandler=PEEK2(Devpnt+5)
2230   Devnumber=PEEK(Devpnt+7)
2240   Devpnt=PEEK2(Devpnt)
2250   RETURN F
2260 FNEND 
2270 ! **************************************
2280 ! *
2290 ! *  Make string block letters
2300 ! *
2310 DEF FNCapstr$(Str$)
2320   FOR Strpnt=1 TO LEN(Str$)
2330     IF MID$(Str$,Strpnt,1)>=CHR$(97) THEN MID$(Str$,Strpnt,1)=CHR$(ASCII(MID$(Str$,Strpnt,1)) AND 223)
2340   NEXT Strpnt 
2350   RETURN Str$
2360 FNEND 
2370 ! ********************************
2380 ! *
2390 ! *  Do communication with net central.
2400 ! *
2410 DEF FNTalknet(Fc,Sfc,B,C,D,E) LOCAL Z,Error
2420   POKE 64961,Fc ! FC -> MSG.FC (Function code).
2430   POKE 64962,Sfc ! SFC -> MSG.SFC (Subfunction code).
2440   POKE 64963,C,B ! MSG.PDN, MSG.ERRB (BC register to/from central).
2450   POKE 64965,E,D ! Register DE to/from central.
2460   POKE 64798,255 ! TFT fake => BSAVE.
2470   Z=CALL(24615) ! NETCALL. => Talk to the central.
2480   Error=PEEK(64962)
2490   IF Error>128 THEN Error=Error-128+35
2500   IF Error THEN ; 'Net error' Error : RETURN T
2510   RETURN F
2520 FNEND 
2530 ! 
2540 ! *********************************
2550 ! *
2560 ! *  Check if user entered from DOS or BASIC
2570 ! *
2580 DEF FNChkdos LOCAL I
2590   I=PEEK2(65302)-160
2600   WHILE I<160 : IF PEEK2(I)=-212 RETURN -1
2610   IF PEEK(I)<>13 I=I+1 : WEND 
2620   RETURN 0
2630 FNEND 
2640 ! 
2650 ! **********************************
2660 ! *
2670 ! *  Get start parameter string (if any)
2680 ! *
2690 DEF FNStartpar$ LOCAL Cmdsp,I,Cmd$=160
2700   Cmdsp=PEEK2(65302)-160
2710   WHILE I<160 : I=I+1 : IF PEEK(Cmdsp+I-1)=44 GOTO 2740
2720     IF PEEK(Cmdsp+I-1)=13 RETURN '' ! No startpar string
2730   WEND : RETURN '' ! No startpar string
2740   IF PEEK(Cmdsp+I)=255 I=I+1 ! Skip DOS-entry flag
2750   WHILE I<160 : IF PEEK(Cmdsp+I)=13 GOTO 2780
2760     IF PEEK(Cmdsp+I)<32 OR PEEK(Cmdsp+I)>127 RETURN ''
2770   Cmd$=Cmd$+CHR$(PEEK(Cmdsp+I)) : I=I+1 : WEND 
2780   RETURN Cmd$
2790 FNEND 
2800 ! 
2810 ! *************************************
2820 ! *
2830 ! *  Exit to DOS or BASIC
2840 ! *
2850 DEF FNExit LOCAL A$=21,A
2860   IF FNChkdos=0 GOTO 2910 ELSE CLOSE ! We MUST close ALL files!!!
2870   A$='CMDINT  SYS'+CHR$(14,255,205,27,96,216,195,3,193)
2880   A=VARPTR(A$)
2890   IF CALL(A+11,A) ; "Can't load CMDINT.SYS, press any key for RESET!";
2900   GET A$ : IF CALL(0) REM Just a miracle would get through here...
2910   END ! End to get out of a function is ugly but...
2920 FNEND