Introduction

If you haven't heard of WMI, you might want to skim my previous article on the subject (it's been updated since it was first posted).

The Registry Provider is WMI's mechanism for accessing the system registry. This is what it can do:

  • Create and delete registry keys and values with full support for binary [REG_BINARY], expanded string [REG_EXPAND_SZ] and multiple string [REG_MULTI_SZ] data types as well as the usual string [REG_SZ] and DWORD [REG_DWORD] types
  • Enumerate registry keys and values
  • Query access permissions on registry keys and values

Typical of WMI, you can do a lot in a couple of lines of code: this would write a string value, if the example key existed.

oStdRegProv = getobject("winmgmts://./root/default:StdRegProv")
oStdRegProv.SetStringValue(0x80000001, "Software\ExampleKey", "ValueName", "The Value")

Nothing the provider does is much more complicated than that, but I've written a sample class showing off WMI's capabilities anyway. It all works fine on VFP7 and Windows 98 or better (not all functionality is available in Windows 95/98/Me (which have no concept of access permissions)) Enumerating registry values causes an "invalid array dimensions" error in VFP6 when the key contains no values: you can just trap this and ignore it, though. Some elements will still work in VFP5, I expect, but I haven't tried it as I can't find disk 1 of Visual Studio 97.

WMI Registry Class

* A complete implementation of the WMI registry provider in VFP.
* Stuart Dunkeld 2005. Even knowing your computer has a registry is dangerous.

* This is example code, free for use at your own risk.

* Version 1.2 - fixed typo in error method, tidied init [2005-11-05]
* Version 1.1 - moved demo code to a procedure below the class definition
* Version 1.0

do regdemo

*
* The WMI Class 
*

define class WMIRegistry as relation

	cComputer = "."
	oStdRegProv = .null.

	nLastError = 0
	cLastError = ""

	procedure init

		local oWMILocator, oWMI
		local cComputer

		cComputer = this.cComputer

		* Open root\default namespace to get registry provider
		oWMILocator = createobject("WbemScripting.SWbemLocator")
		oWMI = oWMILocator.ConnectServer(this.cComputer, "root\default")
		* We are getting a class, *not* an instance.
		this.oStdRegProv = oWMI.get("StdRegProv")

		* We need to use COMARRAY to change array behaviour to
		* zero-based arrays passed by reference.
		* Without this, the REG_BINARY and REG_MULTI_SZ types won't work.
		comarray(this.oStdRegProv, 10)

	endproc

	*
	* WMI Methods
	*

	*
	* Key methods
	*

	procedure CreateKey

		lparameters nHive, cKey

		local lSuccess, nResult
		nResult = this.oStdRegProv.CreateKey(nHive, cKey)
		if nResult = 0
			lSuccess = .t.
		else
			this.ProcessError(nResult, "CreateKey")
		endif
		return lSuccess

	endproc

	procedure DeleteKey

		lparameters nHive, cKey

		local lSuccess, nResult
		nResult = this.oStdRegProv.DeleteKey(nHive, cKey)
		if nResult = 0
			lSuccess = .t.
		else
			this.ProcessError(nResult, "DeleteKey")
		endif
		return lSuccess

	endproc


	*
	* Value methods
	*

	procedure SetValue

		lparameters nHive, cKey, cName, nType, vValue

		local lSuccess, nResult
		lSuccess = .f.

		do case

			case nType = 1 && REG_SZ
				* Setting a string value
				nResult = this.oStdRegProv.SetStringValue(nHive, cKey, cName, vValue)
				if nResult = 0
					lSuccess = .t.
				else
					this.ProcessError(nResult, "SetStringValue")
				endif

			case nType = 2 && REG_EXPAND_SZ
				* Setting an expanded string value (e.g. %PROGRAMFILES%)
				nResult = this.oStdRegProv.SetExpandedStringValue(nHive, cKey, cName, vValue)
				if nResult = 0
					lSuccess = .t.
				else
					this.ProcessError(nResult, "SetExpandedStringValue")
				endif

			case nType = 3 && REG_BINARY
				* We are passing an array of decimal numbers, maximum value 255 each, by reference
				nResult = this.oStdRegProv.SetBinaryValue(nHive, cKey, cName, @vValue)
				if nResult = 0
					lSuccess = .t.
				else
					this.ProcessError(nResult, "SetBinaryValue")
				endif

			case nType = 4 && REG_DWORD
				* A double word
				nResult = this.oStdRegProv.SetDWORDValue(nHive, cKey, cName, vValue)
				if nResult = 0
					lSuccess = .t.
				else
					this.ProcessError(nResult, "SetDWORDValue")
				endif

			case nType = 6 && REG_LINK
				* Not supported. If you really really need one see http://www.ntinternals.net/regln/

			case nType = 7 && REG_MULTI_SZ
				* We are passing an array of strings
				nResult = this.oStdRegProv.SetMultiStringValue(nHive, cKey, cName, @vValue)
				if nResult = 0
					lSuccess = .t.
				else
					this.ProcessError(nResult, "SetMultiStringValue")
				endif

			otherwise
				* The other types can't be set with these methods.

		endcase

		return lSuccess

	endproc


	procedure GetValue

		lparameters nHive, cKey, cName, nType, vReturnValue
		* vReturnValue must be passed by reference for array types

		local cValue, nValue, aValues[1], nResult, lSuccess
		lSuccess = .f.

		do case

			case nType = 0 && REG_NONE
				* Not supported
				vReturnValue = .f.

			case nType = 1 && REG_SZ
				cValue = space(0)
				nResult = this.oStdRegProv.GetStringValue(nHive, cKey, cName, @cValue)
				if nResult = 0
					vReturnValue = cValue
					lSuccess = .t.
				else
					this.ProcessError(nResult, "GetStringValue")
				endif

			case nType = 2 && REG_EXPAND_SZ
				cValue = space(0)
				nResult = this.oStdRegProv.GetExpandedStringValue(nHive, cKey, cName, @cValue)
				if nResult = 0
					vReturnValue = cValue
					lSuccess = .t.
				else
					this.ProcessError(nResult, "GetExpandedStringValue")
				endif

			case nType = 3 && REG_BINARY
				* The registry has an array of hex values (max value FF), we get an array of
				* decimal values.
				nResult = this.oStdRegProv.GetBinaryValue(nHive, cKey, cName, @aValues)
				if nResult = 0 and alen(aValues) # 0
					dimension vReturnValue[alen(aValues)]
					acopy(aValues, vReturnValue)
					lSuccess = .t.
				else
					this.ProcessError(nResult, "GetBinaryValue")

				endif

			case nType = 4 && REG_DWORD
				nValue = 0
				nResult = this.oStdRegProv.GetDWORDValue(nHive, cKey, cName, @nValue)
				if nResult = 0
					vReturnValue = nValue
					lSuccess = .t.
				else
					this.ProcessError(nResult, "GetDWORDValue")
				endif

			case nType = 7 && REG_MULTI_SZ
				nResult = this.oStdRegProv.GetMultiStringValue(nHive, cKey, cName, @aValues)
				if nResult = 0 and alen(aValues) # 0
					dimension vReturnValue[alen(aValues)]
					acopy(aValues, vReturnValue)
					lSuccess = .t.
				else
					this.ProcessError(nResult, "GetMultiStringValue")
				endif

			otherwise
				* The other types aren't supported by these methods
				vReturnValue = .f.
		endcase

		return lSuccess

	endproc


	procedure DeleteValue

		lparameters nHive, cKey, cName
		* You can pass an empty string as cName to reset
		* the default named value to 'value not set'

		local lSuccess, nResult
		nResult = this.oStdRegProv.DeleteValue(nHive, cKey, cName)
		if nResult = 0
			lSuccess = .t.
		else
			this.ProcessError(nResult, "DeleteValue")
		endif
		return lSuccess

	endproc

	procedure GetValueType

		lparameters nType

		local cType
		do case
			case nType = 0
				* No type. Consists of hex data.
				cType = "REG_NONE"
			case nType = 1
				* String
				cType = "REG_SZ"
			case nType = 2
				* Expanded string (expands environment variables)
				cType = "REG_EXPAND_SZ"
			case nType = 3
				* Array of binary values
				cType = "REG_BINARY"
			case nType = 4
				* A double word (32 bit value)
				cType = "REG_DWORD"
			case nType = 5
				* Big endian double word
				cType = "REG_DWORD_BIG_ENDIAN"
			case nType = 6
				* Symbolic link
				cType = "REG_LINK"
			case nType = 7
				* Array of strings
				cType = "REG_MULTI_SZ"
			case nType = 8
				* Resource list in the resource map.
				cType = "REG_RESOURCE_LIST"
			case nType = 9
				* The resource list in the hardware description key
				cType = "REG_FULL_RESOURCE_DESCRIPTOR"
			case nType = 10
				* As it says.
				cType = "REG_RESOURCE_REQUIREMENTS_LIST"
			case nType = 11
				* 64 Bit
				cType = "REG_QWORD"

		endcase

		return cType

	endproc

	*
	* Enumeration methods
	*

	procedure EnumKey

		lparameters nHive, cKey, aKeys
		* Pass aKeys by reference

		local nResult
		nResult = this.oStdRegProv.EnumKey(nHive, cKey, @aKeys)
		if nResult # 0
			* Call failed.
			dimension aKeys[1]
			aKeys = .null.
			this.ProcessError(nResult, "EnumKey")
		endif

		return not isnull(aKeys)

	endproc


	procedure EnumValues

		lparameters nHive, cKey, aValues, aTypes
		* Pass aValues and aTypes by reference

		local nResult
		nResult = this.oStdRegProv.EnumValues(nHive, cKey, @aValues, @aTypes)
		if nResult # 0
			* Call failed.
			dimension aValues[1], aTypes[1]
			store .null. to aValues, aTypes
			this.ProcessError(nResult, "EnumValues")
		endif

		return not isnull(aValues)

	endproc

	*
	* Access checking methods
	*

	procedure CheckAccess

		lparameters nHive, cKey, nPermission

		local lGranted, nResult
		lGranted = .f.
		nResult = this.oStdRegProv.CheckAccess(nHive, cKey, nPermission, @lGranted)
		if nResult # 0
			this.ProcessError(nResult, "CheckAccess")
			lGranted = .null.
		endif

		return lGranted

	endproc


	procedure HasReadAccess

		lparameters nHive, cKey

		return this.CheckAccess(nHive, cKey, 131072) && READ_CONTROL

	endproc

	procedure HasWriteAccess

		lparameters nHive, cKey

		return this.CheckAccess(nHive, cKey, 262144) && WRITE_DAC

	endproc

	*
	* The rest of the class methods
	*

	procedure destroy

		this.oStdRegProv = .null.

	endproc


	procedure error(nError, cMethod, nLine)

		* Just basic error handling for the sample.

		do case
			case nError = 1426
				* Usually, this is a problem instantiating the WMI control.

				* In this circumstance, you might be able to access the WMI LastError object. Note that
				* if you are using the moniker syntax then the description property will be empty.

				* Warning - if there is no valid LastError object available,
				* this will raise a new error. Uncomment to try it.

				* oWMIError = newobject("wbemscripting.swbemlasterror")

				messagebox("A 1426 error has occurred in " + cMethod)

			case nError = 1429
				* OLE error - e.g. requesting an invalid namespace.
				* I haven't been able to access LastError here
				messagebox("A 1429 error has occurred in " + cMethod)


			case nError = 1440
				* A 1440 error - "OLE object is corrupt" - caused by bad parameters.
				* You cannot access the LastError object here.
				messagebox("A 1440 error occurred in " + cMethod + ;
					". This is usually caused by invalid parameters.")

			case nError = 230
				* Array dimensions are invalid - if you try to enumerate the values
				* of a key which doesn't have any in VFP6 this error will fire.
				* When there are values, VFP6 enumerates them fine.

			otherwise
				* This is a coding error, or something else altogether
				messagebox("Error " + transform(nError) + " at " + transform(nLine) + " of " + cMethod)

		endcase

		debug
		suspend

	endproc

	procedure ProcessError

		lparameters nErrorCode, cMethodCalled

		local cErrorMessage
		cErrorMessage = this.GetErrorMessage(nErrorCode)

		* This is only sample code after all.
		? "Error"
		? "Method: " + cMethodCalled
		? "Error Number: " + transform(nErrorCode)
		? "Message: " + cErrorMessage

		this.nLastError = nErrorCode
		this.cLastError = cErrorMessage

	endproc

	procedure GetErrorMessage

		lparameters nErrorCode

		local cErrorDescription

		do case
			case nErrorCode = 0 && wbemNoErr
				cErrorDescription = "The call was successful."
			case nErrorCode = 1 && wbemErrFailed
				cErrorDescription = "The call failed."
			case nErrorCode = 2 && wbemErrNotFound
				cErrorDescription = "The object could not be found."
			case nErrorCode = 3 && wbemErrAccessDenied
				cErrorDescription = "The current user does not have permission to perform the action."
			case nErrorCode = 4 && wbemErrProviderFailure
				cErrorDescription = "The provider has failed at some time other than during initialization."
			case nErrorCode = 5 && wbemErrTypeMismatch
				cErrorDescription = "A type mismatch occurred."
			case nErrorCode = 6 && wbemErrOutOfMemory
				cErrorDescription = "There was not enough memory for the operation."
			otherwise
				cErrorDescription = "See the full list of error codes: error " + transform(nErrorCode)
		endcase



		return cErrorDescription

	endproc

enddefine


procedure regdemo


	*
	* Sample code using the WMIRegistry class.
	*

	* Define some constants. These aren't used by the class, but are in the sample code.

	* Hives
	#define HKCR 0x80000000 && HKEY_CLASSES_ROOT
	#define HKCU 0x80000001 && HKEY_CURRENT_USER (Can't easily be accessed remotely)
	#define HKLM 0x80000002 && HKEY_LOCAL_MACHINE
	#define HKU  0x80000003 && HKEY_USERS
	#define HKCC 0x80000005 && HKEY_CURRENT_CONFIG

	* Registry value types
	#define REG_NONE                             0
	#define REG_SZ                               1
	#define REG_EXPAND_SZ                        2
	#define REG_BINARY                           3
	#define REG_DWORD                            4
	#define REG_DWORD_BIG_ENDIAN                 5
	#define REG_LINK                             6
	#define REG_MULTI_SZ                         7
	#define REG_RESOURCE_LIST                    8
	#define REG_FULL_RESOURCE_DESCRIPTOR         9
	#define REG_RESOURCE_REQUIREMENTS_LIST       10
	#define REG_QWORD                            11

	* Access rights
	#define KEY_QUERY_VALUE         0x0001  && 1
	#define KEY_SET_VALUE           0x0002  && 2
	#define KEY_CREATE_SUB_KEY      0x0004  && 4
	#define KEY_ENUMERATE_SUB_KEYS  0x0008  && 8
	#define KEY_NOTIFY              0x0010  && 16
	#define KEY_CREATE_LINK         0x0020  && 32
	#define KEY_DELETE              0x10000 && 65536
	#define READ_CONTROL            0x20000 && 131072

	#define WRITE_DAC               0x40000 && 262144
	#define WRITE_OWNER             0x80000 && 524288


	*
	* sample code using the WMI class
	* tested in VFP7&9 on Win98&XP

	* supported on VFP6 with specific error handling for
	* a problem with EnumValues -- see below.

	clear

	local cKey, nHive
	local nValue, cValue, aValues [1]
	local cName, cDir, cFXP, nCount, cString, oByte
	local lWin9x, nType, lWriteAccess

	* Get our registry object
	oReg = newobject("WMIRegistry")

	* Define the key we are going to use. CreateKey will create as many subkeys as
	* specified, but we would have to remove each subkey with DeleteKey.
	cKey = "Software\WMITestKey"

	* Some methods don't work on Windows 95/98/Me
	if left(os(), 9) = "Windows 4"
		lWin9x = .t.
	endif

	* We can reasonably expect write permissions in HKEY_CURRENT_USER
	nHive = HKCU

	? "Hive: HKEY_CURRENT_USER"
	? "Key: " + cKey
	? replicate("-", len(cKey) + 5)
	?

	oReg.CreateKey(nHive, cKey)

	*
	* Create registry values.
	*

	* Create a value for each type supported.

	* REG_SZ
	cName = "String Value"
	cValue = "Foobar"
	oReg.SetValue(nHive, cKey, cName, REG_SZ, cValue)

	* REG_DWORD
	nValue = 0x000000EA && 234
	cName = "DWORD value"
	oReg.SetValue(nHive, cKey, cName, REG_DWORD, nValue)

	* REG_EXPAND_SZ
	cName = "Expanded String Value"
	cValue = "%TEMP%"
	oReg.SetValue(nHive, cKey, cName, REG_EXPAND_SZ, cValue)

	* REG_BINARY
	cName = "Binary Values"

	* I haven't another source of binary data, so here's how to store
	* VFP compiled code in the registry.

	* Skip to tempdir, create an FXP, and extract the contents
	cDir = sys(5) + sys(2003)
	cd sys(2023)

	=strtofile([? "Hello World!"],  "wmitempreg.prg")
	compile wmitempreg.prg
	cFXP = filetostr("wmitempreg.fxp")
	* Tidy up files.
	erase wmitempreg.*
	cd (cDir)

	* Assign each byte to an array element
	dimension aValues[len(cFXP)]

	for nCount = 1 to len(cFXP)
		aValues[nCount] = asc(substr(cFXP, nCount, 1))
	next

	* Set the value.
	oReg.SetValue(nHive, cKey, cName, REG_BINARY, @aValues)

	* REG_MULTI_SZ
	* Not supported by Windows 95/98
	if not lWin9x
		cName = "Multiple strings"
		dimension aValues[3]
		aValues[1] = "Foo"
		aValues[2] = "Bar"
		aValues[3] = "Foobar"
		oReg.SetValue(nHive, cKey, cName, REG_MULTI_SZ, @aValues)
	endif

	*
	* Written all the types we can
	*

	* If you suspended execution here you could look at the values
	* using regedit.exe

	*    if messagebox("Would you like to suspend?", 36+256) = 6
	*        suspend
	*    endif


	*
	* Now get our values back again
	*

	* REG_SZ
	cName = "String Value"
	cValue = ""
	oReg.GetValue(nHive, cKey, cName, REG_SZ, @cValue)
	? cName + ": " + cValue
	?

	* REG_DWORD
	cName = "DWORD Value"
	nValue = 0
	oReg.GetValue(nHive, cKey, cName, REG_DWORD, @nValue)
	? cName + ": " + transform(nValue)
	?

	* REG_EXPAND_SZ
	cName = "Expanded String Value"
	cValue = ""
	oReg.GetValue(nHive, cKey, cName, REG_EXPAND_SZ, @cValue)
	? cName + ": " + cValue
	?

	* REG_MULTI_SZ
	* Not supported by Windows 95/98
	if not lWin9x
		cName = "Multiple Strings"
		dimension aValues[1]
		aValues = .null.
		? "Multiple String Values:"
		oReg.GetValue(nHive, cKey, cName, REG_MULTI_SZ, @aValues)
		for each cString in aValues
			? space(4) + cString
		next
		?
	endif

	* REG_BINARY
	dimension aValues[1]
	aValues = .null.
	cName = "Binary Values"
	oReg.GetValue(nHive, cKey, cName, REG_BINARY, @aValues)

	for each oByte in aValues
		cFXP = cFXP + chr(oByte)
	next

	? "Executing code stored as binary values:"

	* Skip to temp, create FXP and execute it.
	cDir = sys(5) + sys(2003)
	cd sys(2023)
	=strtofile(cFXP,  "wmitempreg.fxp")
	do wmitempreg.fxp
	erase wmitempreg.fxp
	cd (cDir)
	?

	* Delete the binary value:
	oReg.DeleteValue(nHive, cKey, cName)

	* Delete our test key.
	oReg.DeleteKey(nHive, cKey)

	*
	* Done with getting values.
	*

	*
	* Illustrate access checking. Windows 95/98 doesn't support this
	* (CheckAccess returns 2, Not Found)
	*

	if not lWin9x

		* Example of why to check permissions:
		* NUMLOCK sometimes switches off after you have logged on.
		* This is controlled by this registry value:

		*    Key: HKEY_USERS\.DEFAULT\Control Panel\Keyboard
		*    Value Name: InitialKeyboardIndicators
		*    Data Type: REG_SZ
		*    Value Data: 0 = NUMLOCK is turned off after logon, 2 = NUMLOCK is turned on after logon

		* Check permissions on HKEY_USERS\.DEFAULT\Control Panel\Keyboard
		* to see if we can write this value for all users
		* If not, see if we can write to HKEY_CURRENT_USER\Control Panel\Keyboard
		* for the current user only

		nHive = HKU
		cKey = ".DEFAULT\Control Panel\Keyboard"
		cName = "InitialKeyboardIndicators"
		nType = REG_SZ
		cValue = "0"
		lWriteAccess = .f.

		if oReg.CheckAccess(nHive, cKey, KEY_SET_VALUE)
			* oReg.HasWriteAccess(nHive, cKey) is a blunter hammer:
			* User may not have full write access but can still set a value.
			lWriteAccess = .t.
		else
			nHive = HKCU
			cKey = "Control Panel\Keyboard"
			if oReg.CheckAccess(nHive, cKey, KEY_SET_VALUE)
				lWriteAccess = .t.
			endif
		endif

		if lWriteAccess = .t.
			* Uncomment if you want to actually write the value
			* oReg.SetValue(nHive, cKey, cName, nType, cValue)
			? "Could write value to " + iif(nHive = HKU, "HKEY_USERS\", "HKEY_CURRENT_USER\") + cKey
		else
			? "Write access denied twice"
		endif

	endif

	*
	* Enumerate the registry
	*

	* HKLM keeps the number of values down to a reasonable number.
	nHive = HKLM
	* Use whichever version we are running in.
	cKey = "Software\Microsoft\VisualFoxpro\" + substr(version(), 16, 1) + ".0"

	* If key doesn't exist in HKLM - VFP hasn't been installed and is being run from CD
	* or disk image or some such - then attempting to enumerate it will
	* cause errors. VFP6 will error when trying to enumerate a key with no values,
	* and doesn't create this key anyway.

	* So, do we have read access to this key?
	if isnull(oReg.HasReadAccess(nHive, cKey))
		* If the key doesn't exist, CheckAccess will raise a Not Found error
		? "Enumeration key not found or access denied"
		return
	endif

	?
	? "Enumerating subkeys of " + cKey


	EnumerateRegistry(nHive, cKey, 0)

procedure EnumerateRegistry

	lparameters nHive, cKey, nLevel


	local nCount, cName, nType, cType, vValue
	local aValues[1], aTypes[1], aKeys[1]

	if oReg.EnumValues(nHive, cKey, @aValues, @aTypes)

		for nCount = 1 to alen(aValues)
			cName = aValues[nCount]
			nType = aTypes[nCount]
			cType = oReg.GetValueType(nType)
			vValue = .null.
			if oReg.GetValue(nHive, cKey, cName, nType, @vValue)
				? "Value: ", cName, cType, vValue
			else
				? "Value: ", cName, cType, "[Not supported]"
			endif
			nCount = nCount + 1
		next

	endif

	if oReg.EnumKey(nHive, cKey, @aKeys)
		for nCount = 1 to alen(aKeys)
			? "Key: " + replicate("-", nLevel), cKey + "\" + aKeys[nCount]
			EnumerateRegistry(nHive, cKey + "\" + aKeys[nCount], nLevel + 1)
		endfor
	endif

endproc


The full error code procedure is posted as an article. Thanks to Calvin Hsia for showing me how to enumerate the registry.

Please feel free to leave comments with suggestions for improvement or corrections.

Leave a Reply

Your email address will not be published. Required fields are marked *