WMI part 2 - The WMI Registry Provider
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
* 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
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.