PROGRAM NEW_FREE1
! Purpose:      Produce a listing depicting the Used, Free and Total blocks available on all mounted disks
! Date:         2008-03-08
! Author:       Art Wiens
!
! Notes:        A "simple" program to teach myself Basic and learn system services.
!
        OPTION TYPE = EXPLICIT

        PRINT 
        PRINT "Initializing variables and structures ..."
        PRINT
        
        ! Include the necessary symbols from the BASIC Run-time library
        
        %INCLUDE "$DCDEF"  %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
        %INCLUDE "$DEVDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
        %INCLUDE "$DVIDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
        %INCLUDE "$DVSDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
        %INCLUDE "$SSDEF"  %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	
	! The two system services we will be learning about
	
        EXTERNAL LONG FUNCTION SYS$DEVICE_SCAN
        
        EXTERNAL LONG FUNCTION SYS$GETDVIW
        
        ! Variables
	
	DECLARE DOUBLE	DEV_PCTFREE,			&
			DEV_PCTUSED,			&
			TOT_PCTFREE,			&
			TOT_PCTUSED
			
	DECLARE QUAD	DEV_FREEBLCKS,			&
			DEV_MAXBLCKS,			&
			DEV_USEDBLCKS,			&
			TOT_FREEBLCKS,			&
			TOT_MAXBLCKS,			&
			TOT_USEDBLCKS,			&
			FIND_CONTEXT

        DECLARE LONG    DEVTYPE_LENGTH_RETURNED,	&
        		GET_STATUS,			&
        		FD_STATUS,			&
        		GD_STATUS,			&
        		DISK_NAME_LENGTH,		&
        		GD_DEVCHAR,			&
        		GD_DEVCHAR2,			&
        		GD_FREEBLCKS,			&
        		GD_MAXBLCKS,			&
        		GD_SHDWMEMBER
        
        ! DC$_DISK = 1 indicates device is a disk		
        
        DECLARE WORD	DISK_CL
        		DISK_CL = DC$_DISK
	
	DECLARE STRING CONSTANT THOU = "###,###,###,###"
	
	! Maximum device name length returned by SYS$DEVICE_SCAN is 64 bytes
	
        MAP (MAP1)	STRING  DEV_NAME$ = 64
        		DEV_NAME$ = ""

	! Define item_list_3 descriptor for $DEVICE_SCAN system service (Find Disk)
	
	RECORD FD_IL_3
		GROUP ITEM(1)
                VARIANT
                   CASE
                        WORD    BUFFER_LENGTH
                        WORD    ITEM_CODE
                        LONG    BUFFER_ADDRESS
                        LONG    RETURN_LENGTH_ADDRESS
                   CASE
                        LONG    LIST_TERMINATOR
                END VARIANT
                END GROUP
        END RECORD FD_IL_3

	! Create item_list_3 descriptor for Find Disk
	
        COMMON (FD_ITEM_BLOCK) FD_IL_3 FD_IL3

	FD_IL3::ITEM(0)::BUFFER_LENGTH		= 64
        FD_IL3::ITEM(0)::ITEM_CODE              = DVS$_DEVCLASS
        FD_IL3::ITEM(0)::BUFFER_ADDRESS         = LOC(DISK_CL)
        FD_IL3::ITEM(0)::RETURN_LENGTH_ADDRESS  = LOC(FD_IL3::ITEM(0)::BUFFER_LENGTH)
        FD_IL3::ITEM(1)::LIST_TERMINATOR        = 0

	! Define item_list_3 descriptor for $GETDVIW system service (Get Device info)
	
	RECORD GD_IL_3
		GROUP ITEM(5)
                VARIANT
                   CASE
                        WORD    BUFFER_LENGTH
                        WORD    ITEM_CODE
                        LONG    BUFFER_ADDRESS
                        LONG    RETURN_LENGTH_ADDRESS
                   CASE
                        LONG    LIST_TERMINATOR
                END VARIANT
                END GROUP
        END RECORD GD_IL_3

	! Create item_list_3 descriptor for Get Device info
	
        COMMON (GD_ITEM_BLOCK) GD_IL_3 GD_IL3

	GD_IL3::ITEM(0)::BUFFER_LENGTH		= 4
        GD_IL3::ITEM(0)::ITEM_CODE              = DVI$_DEVCHAR
        GD_IL3::ITEM(0)::BUFFER_ADDRESS         = LOC(GD_DEVCHAR)
        GD_IL3::ITEM(0)::RETURN_LENGTH_ADDRESS  = LOC(GD_IL3::ITEM(0)::BUFFER_LENGTH)

	GD_IL3::ITEM(1)::BUFFER_LENGTH		= 4
        GD_IL3::ITEM(1)::ITEM_CODE              = DVI$_DEVCHAR2
        GD_IL3::ITEM(1)::BUFFER_ADDRESS         = LOC(GD_DEVCHAR2)
        GD_IL3::ITEM(1)::RETURN_LENGTH_ADDRESS  = LOC(GD_IL3::ITEM(1)::BUFFER_LENGTH)

	GD_IL3::ITEM(2)::BUFFER_LENGTH		= 4
        GD_IL3::ITEM(2)::ITEM_CODE              = DVI$_FREEBLOCKS
        GD_IL3::ITEM(2)::BUFFER_ADDRESS         = LOC(GD_FREEBLCKS)
        GD_IL3::ITEM(2)::RETURN_LENGTH_ADDRESS  = LOC(GD_IL3::ITEM(2)::BUFFER_LENGTH)

	GD_IL3::ITEM(3)::BUFFER_LENGTH		= 4
        GD_IL3::ITEM(3)::ITEM_CODE              = DVI$_MAXBLOCK
        GD_IL3::ITEM(3)::BUFFER_ADDRESS         = LOC(GD_MAXBLCKS)
        GD_IL3::ITEM(3)::RETURN_LENGTH_ADDRESS  = LOC(GD_IL3::ITEM(3)::BUFFER_LENGTH)

	GD_IL3::ITEM(4)::BUFFER_LENGTH		= 4
        GD_IL3::ITEM(4)::ITEM_CODE              = DVI$_SHDW_MEMBER
        GD_IL3::ITEM(4)::BUFFER_ADDRESS         = LOC(GD_SHDWMEMBER)
        GD_IL3::ITEM(4)::RETURN_LENGTH_ADDRESS  = LOC(GD_IL3::ITEM(4)::BUFFER_LENGTH)

        GD_IL3::ITEM(5)::LIST_TERMINATOR        = 0

FIND_DISK:

	FD_STATUS = SYS$DEVICE_SCAN(DEV_NAME$, DEVTYPE_LENGTH_RETURNED, , FD_IL3, FIND_CONTEXT)
	
	SELECT FD_STATUS
		CASE SS$_NORMAL
			GOSUB CHECK_DISK
		CASE SS$_ACCVIO
			PRINT "FD ACCVIO status"
			GOTO FAIL_EXIT
		CASE SS$_BADPARAM
			PRINT "FD BADPARAM status"
			GOTO FAIL_EXIT
		CASE SS$_NOSUCHDEV
			PRINT "FD NOSUCHDEV status"
			GOTO FAIL_EXIT
		CASE SS$_NOMOREDEV
			PRINT "FD NOMOREDEV status"
			GOTO TOTAL_IT
		CASE ELSE
			GOTO FAIL_EXIT
	END SELECT
	
	GOTO FIND_DISK

CHECK_DISK:

	GD_STATUS = SYS$GETDVIW(,, DEV_NAME$, GD_IL3,,,,)
	
	SELECT GD_STATUS
		CASE SS$_NORMAL
			IF ((GD_DEVCHAR AND DEV$M_MNT) AND (GD_DEVCHAR2 AND DEV$M_VRT)) OR ((GD_DEVCHAR AND DEV$M_MNT) AND NOT (GD_DEVCHAR2 AND DEV$M_SSM))
				THEN

					PRINT "DEVCHAR characteristics : "
					PRINT "GD_DEVCHAR  is : ";GD_DEVCHAR
					PRINT "DEVCHAR2 characteristics : "
					PRINT "GD_DEVCHAR2 is : ";GD_DEVCHAR2
					PRINT "SHDW_MEMBER characteristic : "
					PRINT "GD_SHDWMEMBER is : ";GD_SHDWMEMBER
					GOSUB SPACE_CALC
				ELSE
					RETURN
			END IF
			RETURN
		CASE SS$_ACCVIO
			PRINT "GD ACCVIO status"
		CASE SS$_BADPARAM
			PRINT "GD BADPARAM status"
		CASE SS$_EXASTLM
			PRINT "GD EXASTLM status"
		CASE SS$_IVCHAN
			PRINT "GD IVCHAN status"
		CASE SS$_IVDEVNAM
			PRINT "GD IVDEVNAM status"
		CASE SS$_IVLOGNAM
			PRINT "GD IVLOGNAM status"
		CASE SS$_NONLOCAL
			PRINT "GD NONLOCAL status"
		CASE SS$_NOPRIV
			PRINT "GD NOPRIV status"
		CASE SS$_NOSUCHDEV
			PRINT "GD NOSUCHDEV status"
	END SELECT

	RETURN

SPACE_CALC:

	DEV_FREEBLCKS	= GD_FREEBLCKS
	DEV_MAXBLCKS	= GD_MAXBLCKS
	DEV_USEDBLCKS	= DEV_MAXBLCKS   - DEV_FREEBLCKS
	DEV_PCTFREE	= ((DEV_MAXBLCKS - DEV_USEDBLCKS) * 100) / DEV_MAXBLCKS
	DEV_PCTUSED	= ((DEV_MAXBLCKS - DEV_FREEBLCKS) * 100) / DEV_MAXBLCKS
	
	TOT_FREEBLCKS	= TOT_FREEBLCKS  + DEV_FREEBLCKS
	TOT_MAXBLCKS	= TOT_MAXBLCKS   + DEV_MAXBLCKS
	TOT_USEDBLCKS	= TOT_USEDBLCKS  + DEV_USEDBLCKS
	TOT_PCTFREE	= ((TOT_MAXBLCKS - TOT_USEDBLCKS) * 100) / TOT_MAXBLCKS
	TOT_PCTUSED	= ((TOT_MAXBLCKS - TOT_FREEBLCKS) * 100) / TOT_MAXBLCKS
	
        PRINT TRM$(DEV_NAME$),
        PRINT USING THOU, GD_FREEBLCKS,DEV_USEDBLCKS,GD_MAXBLCKS
	
	RETURN

FAIL_EXIT:

	PRINT "FAIL_EXIT:"
	PRINT "Last Status : ";FD_STATUS

	GOTO END_IT

TOTAL_IT:

        PRINT USING THOU, TOT_FREEBLCKS,TOT_USEDBLCKS,TOT_MAXBLCKS,
        PRINT "Free % : ";TOT_PCTFREE;" Used % : ";TOT_PCTUSED
	GOTO END_IT

END_IT:

	PRINT "END_IT:"

END PROGRAM