1000 ! * DF.BAC 1005 INTEGER : EXTEND 1010 ; '** Disc space utility **' 1020 ; ' Ver X.02, 1985-04-24' 1030 ; ' Copyright 1984 Dataindustrier AB' 1040 ! * 1050 ! * Written by G|ran Nordenborg 1060 ! ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** 1070 ! * 1080 ! * Rev date / Rev nr / Sign / Note 1090 ! * 85-02-04 / X.00 / GN / Main 1100 ! * 85-02-25 / X.01 / GN / Handles many bitmaps and correct MO handling 1110 ! * 85-04-24 / X.02 / BL / Accessible from DOS, FNStartpar$ handling 1120 ! * 1130 ! ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** 1140 ! * 1150 ! EJECT 1160 ! ****************************** 1170 ! * 1180 ! * Main routine 1190 ! * 1200 IF FNDf THEN ; 'DF abort' 1210 ; FNExit 1220 ! * EJECT 1230 ! ********************************* 1240 ! * 1250 ! * List disc free space 1260 ! * 1270 DEF FNDf 1280 IF FNInitialize THEN RETURN T 1290 Cmd$=FNStartpar$+'**' : IF Cmd$<>'**' GOTO 1330 1300 ; 'Command :'; 1310 INPUT LINE Cmd$ 1320 ; 1330 Cmd$=FNCapstr$(LEFT$(Cmd$,LEN(Cmd$)-2)) 1340 IF FNCmdscan(Cmd$) THEN RETURN T 1350 IF INSTR(1,Option$,'?') THEN Option=Opthelp : RETURN FNHelp 1360 IF INSTR(1,Option$,'L') THEN Option=Option OR Optlive : Outfile$='CON:' : ; CHR$(12); 1370 WHILE T 1380 IF FNListfree THEN RETURN T 1390 IF (Option AND Optlive)=0 THEN RETURN F 1400 ; #Lud SPACE$(159); 1410 Waittime$=TIME$ 1420 ! * 1430 ! * Wait 10 seconds 1440 ! * 1450 WHILE MID$(Waittime$,18,1)=MID$(TIME$,18,1) 1460 IF SYS(5) THEN GET Dummy$ : RETURN F 1470 WEND 1480 ; #Lud CUR(1,0); 1490 WEND 1500 FNEND 1510 ! ************************************* 1520 ! * 1530 ! * List free space on devices 1540 ! * 1550 DEF FNListfree 1560 Dev$=LEFT$(Selfile$,INSTR(1,Selfile$,':')) 1570 IF Dev$<>'' THEN Error=FNListdev(Dev$) : IF Error=42 THEN ; 'Drive ''' Selfile$ ''' is off line' : RETURN T ELSE RETURN F 1580 Devpnt=PEEK2(-133) 1590 Mfdcnt=0 1600 Tfree.=0. 1610 Ttotal.=0. 1620 WHILE FNGetdev=F 1630 Scanpnt=Devpnt 1640 Dev$=Dev$+':' 1650 IF Devhandler=Floppyhandler AND LEFT$(Dev$,2)<>'DR' AND Dev$<>' :' AND Dev$<>'MFD:' THEN Error=FNListdev(Dev$) 1660 IF Error<>0 AND Error<>35 AND Error<>42 AND Error<>45 AND Error<>46 THEN RETURN T 1670 Devpnt=Scanpnt 1680 WEND 1690 IF Mfdcnt>1 THEN ; #Lud USING 'Total ###.#% ##,###,### bytes',Tfree./Ttotal.*100.,Tfree.*256 1700 RETURN F 1710 FNEND 1720 ! ***************************** 1730 ! * 1740 ! * All initialisations 1750 ! * 1760 DEF FNInitialize 1770 F=0 1780 T=-1 1790 Lus=1 1800 Lud=2 1810 Luv=3 ! Volume name read 1820 Dosbuff$=' ' 1830 POKE VAROOT(Dosbuff$),0,1,0,246,0,1 ! 256 long, pointing to DOS buffer 1 1840 ! * 1850 ! * Define options 1860 ! * 1870 Opthelp=1 1880 Optlive=Opthelp+1 1890 ! * 1900 ! * Bitmap and lokout map count code 1910 ! * 1920 ! * LDI HL,0 1930 ! * LI B,239 1940 ! *L = * 1950 ! * LI C,8 1960 ! * L A,(DE) 1970 ! * INDE DE 1980 ! *L1= * 1990 ! * RRCA 2000 ! * JCS L2 2010 ! * INCD HL 2020 ! *L2= * 2030 ! * DECR C 2040 ! * JNZS L1 2050 ! * DJNZ L 2060 ! * RET 2070 ! * 2080 Countcode$=CHR$(33,0,0,6,239,14,8,26,19,15,56,1,35,13,32,249,16,243,201) 2090 Devpnt=PEEK2(-133) 2100 WHILE FNGetdev=0 2110 IF Dev$='DR0' THEN Floppyhandler=Devhandler : Devpnt=PEEK2(-133) : RETURN F 2120 WEND 2130 ; 'Can''t find disk handler address' 2140 RETURN T 2150 FNEND 2160 ! ****************************** 2170 ! * 2180 ! * List free space on specified disc 2190 ! * 2200 DEF FNListdev(Dev$) 2210 Listdev$=Dev$ 2220 ON ERROR GOTO 2730 2230 OPEN Listdev$ AS FILE Lus 2240 Pdn=PEEK(-767) AND 31 2250 Dev=PEEK(64783) AND 31 2260 Conttype=PEEK(PEEK2(24683)+(Dev AND 28)) AND 192 2270 Clusize=2^(PEEK(PEEK2(24683)+(Dev AND 28)+1) AND 7) 2280 Ldadiv=32/Clusize 2290 Ldamask=31 2300 Header=F 2310 Dacc=T 2320 Listnr=0 2330 Nameend=1 2340 Totsize.=0. 2350 IF Pdn=30 OR Pdn=31 OR Pdn=27 THEN POSIT #Lus,253-17 : Mfd=F ELSE Mfd=T : IF Conttype=128 THEN POSIT #Lus,7*253-17 ELSE POSIT #Lus,15*253-17 2360 IF Mfd=F THEN Vol$='' : GOTO 2440 2370 ! * 2380 ! * MFD directory. Try to list volume name 2390 ! * 2400 ON ERROR GOTO 2770 2410 OPEN Listdev$+'SYSDIR.SYS' AS FILE Luv 2420 GET #Luv Vol$ COUNT 253 2430 IF MID$(Vol$,252,1)=CHR$(165) THEN Vol$=LEFT$(Vol$,INSTR(1,Vol$,CHR$(0))-3) ELSE Vol$='' 2440 ON ERROR GOTO 2730 2450 GET #Lus Dirmap$ COUNT 16 2460 GET #Lus Redclu$ 2470 IF ASCII(Redclu$) AND 32 THEN Ldadiv=1 : Ldamask=Clusize-1 2480 Dirent=0 2490 FOR Dirsec=0 TO 15 2500 Dirent=Dirent+ASCII(MID$(Dirmap$,Dirsec+1,1)) 2510 NEXT Dirsec 2520 IF Mfd=F THEN IF FNDevnrname(Dev) THEN RETURN T ELSE OPEN Dev$ AS FILE Lus : IF Conttype=128 THEN POSIT #Lus,7*253 ELSE POSIT #Lus,15*253 2530 POSIT #Lus,POSIT(Lus)-253 2540 GET #Lus Bitmap$ COUNT 253 2550 Free.=FNNsgn.(CALL(VARPTR(Countcode$),VARPTR(Dosbuff$))) 2560 Link=CVT$%(MID$(Dosbuff$,238,2)) 2570 WHILE Link<>-1 2580 POSIT #Lus,Link*253 2590 GET #Lus Bitmap$ COUNT 253 2600 Free.=Free.+FNNsgn.(CALL(VARPTR(Countcode$),VARPTR(Dosbuff$))) 2610 Link=CVT$%(MID$(Dosbuff$,238,2)) 2620 WEND 2630 IF Conttype=128 THEN POSIT #Lus,7*253 ELSE POSIT #Lus 15*253 2640 GET #Lus Lokmap$ COUNT 253 2650 Total.=CVT$%(MID$(Dosbuff$,254,2))/Clusize 2660 IF Total.=0. THEN Total.=FNNsgn.(CALL(VARPTR(Countcode$),VARPTR(Dosbuff$))) 2670 IF Outfileopen=F THEN OPEN Outfile$ AS FILE Lud : Outfileopen=T : ; #Lud 'Dev Free space Entries Volume name' 2680 ON ERROR GOTO 2820 2690 ; #Lud USING '\ \ ###.#% ##,###,### bytes ### &',Listdev$,Free./Total.*100.,Free.*256.*Clusize,256-Dirent,Vol$; 2700 ; #Lud TAB(1); 2710 IF Mfd THEN Mfdcnt=Mfdcnt+1 : Tfree.=Tfree.+Free.*Clusize : Ttotal.=Ttotal.+Total.*Clusize 2720 RETURN F 2730 RESUME 2740 2740 Error=ERRCODE 2750 CLOSE Lus 2760 RETURN ERRCODE 2770 ! * 2780 ! * Error during open of 'SYSDIR.SYS' 2790 ! * 2800 Vol$='' 2810 RESUME 2440 2820 ! * 2830 ! * Error during outfile open 2840 ! * 2850 ; 'Error' ERRCODE 'during open of print file ''' Outfile$ '''' 2860 RESUME 2870 2870 RETURN T 2880 FNEND 2890 ! ********************************** 2900 ! * 2910 ! * Get next device 2920 ! * 2930 DEF FNGetdev 2940 IF Devpnt=0 THEN RETURN T 2950 Dev$=CHR$(PEEK(Devpnt+2),PEEK(Devpnt+3),PEEK(Devpnt+4)) 2960 Devhandler=PEEK2(Devpnt+5) 2970 Devnumber=PEEK(Devpnt+7) 2980 Devpnt=PEEK2(Devpnt) 2990 RETURN F 3000 FNEND 3010 ! ******************************** 3020 ! * 3030 ! * Scan input string 3040 ! * 3050 DEF FNCmdscan(Str$) 3060 Selfile$='' 3070 Infile$='CON:' 3080 Outfile$='CON:' 3090 File$='' 3100 FOR Pnt=1 TO LEN(Str$) 3110 IF MID$(Str$,Pnt,1)>=CHR$(97) THEN MID$(Str$,Pnt,1)=CHR$(ASCII(MID$(Str$,Pnt,1)) AND 223) 3120 NEXT Pnt 3130 FOR Pnt=1 TO LEN(Str$) 3140 ON INSTR(1,' <>-',MID$(Str$,Pnt,1))+1 GOSUB 3180,3230,3280,3410,3540 3150 NEXT Pnt 3160 GOSUB 3230 3170 RETURN Error 3180 ! * 3190 ! * No special but ascii character cound 3200 ! * 3210 File$=File$+MID$(Str$,Pnt,1) 3220 RETURN 3230 ! * 3240 ! * ' ' found 3250 ! * 3260 IF Termcont=0 THEN IF File$='' THEN RETURN ELSE Selfile$=File$ : File$='' : RETURN 3270 ON Termcont GOTO 3330,3460,3590 3280 ! * 3290 ! * '<' found. Infile descriptor 3300 ! * 3310 Termcont=1 3320 RETURN 3330 ! * 3340 ! * '<' termination 3350 ! * 3360 IF Infile$<>'CON:' THEN Error=3 : RETURN 3370 Infile$=File$ 3380 File$='' 3390 Termcont=0 3400 RETURN 3410 ! * 3420 ! * '>' found. Out file descriptor 3430 ! * 3440 Termcont=2 3450 RETURN 3460 ! * 3470 ! * '>' termination 3480 ! * 3490 IF Outfile$<>'CON:' THEN Error=4 : RETURN 3500 Outfile$=File$ 3510 File$='' 3520 Termcont=0 3530 RETURN 3540 ! * 3550 ! * '-' found. Option descriptor 3560 ! * 3570 Termcont=3 3580 RETURN 3590 ! * 3600 ! * '-' termination 3610 ! * 3620 Option$=Option$+File$ 3630 File$='' 3640 Termcont=0 3650 RETURN 3660 FNEND 3670 ! ************************************** 3680 ! * 3690 ! * Make string block letters 3700 ! * 3710 DEF FNCapstr$(Str$) 3720 FOR Strpnt=1 TO LEN(Str$) 3730 IF MID$(Str$,Strpnt,1)>=CHR$(97) THEN MID$(Str$,Strpnt,1)=CHR$(ASCII(MID$(Str$,Strpnt,1)) AND 223) 3740 NEXT Strpnt 3750 RETURN Str$ 3760 FNEND 3770 ! *********************************** 3780 ! * 3790 ! * Help text 3800 ! * 3810 DEF FNHelp 3820 OPEN Outfile$ AS FILE Lud 3830 ; #Lud 'DF is a utility to list free space on disc devices. It will' 3840 ; #Lud 'report how many percent of disc that is used, number of free' 3850 ; #Lud 'bytes and number of free directory entries. If the listed' 3860 ; #Lud 'device is a master file directory, even the volume name will' 3870 ; #Lud 'be listed. Command syntax is DEVICE -OPTION. If no device is' 3880 ; #Lud 'specified, all mounted devices will be listed. Optiones:' 3890 ; #Lud '? - This help text' 3900 ; #Lud 'L - Live, list updated list each 10 seconds' 3910 RETURN F 3920 RETURN F 3930 FNEND 3940 ! ********************************** 3950 ! * 3960 ! * Convert device number to name 3970 ! * 3980 DEF FNDevnrname(Devnr) 3990 Devpnt=PEEK2(-133) 4000 WHILE FNGetdev=F 4010 IF Devhandler<>Floppyhandler OR Devnumber<>Devnr THEN WEND 4020 Dev$=Dev$+':' 4030 RETURN F 4040 FNEND 4050 ! ************************************* 4060 ! * 4070 ! * Unsign integer 4080 ! * 4090 DEF FNNsgn.(Intgr) 4100 IF Intgr<0 THEN RETURN Intgr+65536. ELSE RETURN Intgr 4110 FNEND 60000 ! 60010 ! ********************************* 60020 ! * 60030 ! * Check if user entered from DOS or BASIC 60040 ! * 60050 DEF FNChkdos LOCAL I 60060 I=PEEK2(65302)-160 60070 WHILE I<160 : IF PEEK2(I)=-212 RETURN -1 60080 IF PEEK(I)<>13 I=I+1 : WEND 60090 RETURN 0 60100 FNEND 60110 ! 60120 ! ********************************** 60130 ! * 60140 ! * Get start parameter string (if any) 60150 ! * 60160 DEF FNStartpar$ LOCAL Cmdsp,I,Cmd$=160 60170 Cmdsp=PEEK2(65302)-160 60180 WHILE I<160 : I=I+1 : IF PEEK(Cmdsp+I-1)=44 GOTO 60210 60190 IF PEEK(Cmdsp+I-1)=13 RETURN '' ! No startpar string 60200 WEND : RETURN '' ! No startpar string 60210 IF PEEK(Cmdsp+I)=255 I=I+1 ! Skip DOS-entry flag 60220 WHILE I<160 : IF PEEK(Cmdsp+I)=13 GOTO 60250 60230 IF PEEK(Cmdsp+I)<32 OR PEEK(Cmdsp+I)>127 RETURN '' 60240 Cmd$=Cmd$+CHR$(PEEK(Cmdsp+I)) : I=I+1 : WEND 60250 RETURN Cmd$ 60260 FNEND 60270 ! 60280 ! ************************************* 60290 ! * 60300 ! * Exit to DOS or BASIC 60310 ! * 60320 DEF FNExit LOCAL A$=21,A 60330 IF FNChkdos=0 GOTO 60380 ELSE CLOSE ! We MUST close ALL files!!! 60340 A$='CMDINT SYS'+CHR$(14,255,205,27,96,216,195,3,193) 60350 A=VARPTR(A$) 60360 IF CALL(A+11,A) ; "Can't load CMDINT.SYS, press any key for RESET!"; 60370 GET A$ : IF CALL(0) REM Just a miracle would get through here... 60380 END ! End to get out of a function is ugly but... 60390 FNEND