OpenVMS Source-Code Demos

DEVICE_SCAN_DEMO.BAS

1000	%title "device_scan_demo_xxx.bas"					!
	%ident                      "version 100.1"				! <<<---+--- these must match
	declare string constant k_version = "100.1"			,	! <<<---+			&
				k_program = "device_scan_demo"			!
	!=======================================================================
	! title  : device_scan_demo_xxx.bas
	! author : Neil Rieck (n.rieck@sympatico.ca)
	! created: 2012.03.24
	! ver who when     what
	! --- --- -------- -----------------------------------------------------
	! 100 NSR 20120324 1. original work
	!
	!	remember to update k_version above
	!=======================================================================
	option type=explicit							! no kid stuff
	!
	declare long		rc%		,	&
				i%		,	&
				ef%		,	&
		basic$quadword	ctx		,	&
				ctx_zero
	!
	!	pull in some stuff from STARTLET (the compiler is our friend)
	!
	%include "starlet"      %from %library "sys$library:basic$starlet"      ! system services
	%include "$ssdef"       %from %library "sys$library:basic$starlet"      ! ss$
	%include "$efndef"      %from %library "sys$library:basic$starlet"      ! efn$
	%include "$dcdef"       %from %library "sys$library:basic$starlet"      ! dc$
	%include "$iledef"      %from %library "sys$library:basic$starlet"      ! ile$
	%include "$dvsdef"      %from %library "sys$library:basic$starlet"      ! dvs$
	%include "$iosbdef"     %from %library "sys$library:basic$starlet"      ! iosb$
	!
	!	create a new record called ItemRec
	!	(I did this just to show how it could be done,
	!	 it would be better if you used the ILE3 predefined structure in starlet)
	!
%if %declared (%ITEMREC) = 0 %then
        record ItemRec								! structure of item record
            variant
		case
		    group one
		        word    BuffLen
		        word    ItemCode
		        long    BuffAddr
		        long    RtnLenAdr
		    end group one
		case
		    group two
		        long    List_Terminator
		        long    Junk1
		        long    Junk2
		    end group two
            end variant
        end record ItemRec
%let %ITEMREC = 1
%end %if
	!
	!	create a new datatype called DevScanRec
	!
	record DevScanList							! structure of DevScan List
!~~~	   ile3    ItemVar(?)							x ile3 is defined in starlet
	   ItemRec ItemVar(0)							! 0 -> 0 items (increase as necessary)
	   long    list_term							! for end-of-list marker
	end record								!
	!
	!	now use the new datatype in a declaration statement
	!
	declare	DevScanList	DevScanBuf					! Now declare a variable using it
	!
	map(devnam)string	w_device_name=255				!
	declare word		w_device_name_len			,	&
		long		r_device_class					!
	!
	!=======================================================================
	!	Main
	!=======================================================================
	main:
	print k_program +"_"+ k_version
	print string$(len(k_program +"_"+ k_version), asc("="))			! what will the optimizer do with this?
	!
	DevScanBuf::ItemVar(0)::BuffLen		= 4				! byte-size of data buffer
	DevScanBuf::ItemVar(0)::ItemCode	= DVS$_DEVCLASS			! requested data or operation
	DevScanBuf::ItemVar(0)::BuffAddr	= loc( r_device_class )		! address of our read-only storage
	DevScanBuf::ItemVar(0)::RtnLenAdr	= 0				! address of bytes written (0=don't care)
	!
	DevScanBuf::LIST_TERM			= 0				! end of list
	!
	r_device_class				= DC$_DISK			! we only want disks
	!
	!	docs:	SYS$DEVICE_SCAN return_devnam ,retlen ,[search_devnam] ,[itmlst] ,[contxt]
	!
	ctx = ctx_zero								! init context
	while 1									!
	     rc% = sys$device_scan(w_device_name,w_device_name_len,"*",DevScanBuf,ctx)
	     select rc%								!
		case SS$_NORMAL							!
		     print "disk name>"+ left$(w_device_name,w_device_name_len)
		case SS$_NOMOREDEV						!
		    goto done_scan						!
		case SS$_NOSUCHDEV						!
		    goto done_scan						!
		case else							!
		    print "-e-error: "+str$(rc%)				!
		    goto done_scan						!
	     end select								!
	next									!
	done_scan:								!
	!
	end									!