Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Registry Class
Message
General information
Forum:
Visual FoxPro
Category:
Classes - VCX
Title:
Miscellaneous
Thread ID:
01561535
Message ID:
01561544
Views:
96
The code sample below saves HKEY_CURRENT_USER\Software\Microsoft\VisualFoxPro keys and values to c:\temp\reg.xml file
#DEFINE ERROR_SUCCESS       0
#DEFINE KEY_ALL_ACCESS      0xF003F
#DEFINE HKEY_CURRENT_USER   0x80000001
#DEFINE HKEY_LOCAL_MACHINE  0x80000002
#DEFINE HKEY_USERS          0x80000003

#DEFINE REG_SZ        1
#DEFINE REG_EXPAND_SZ 2
#DEFINE REG_BINARY    3
#DEFINE REG_DWORD     4
#DEFINE REG_MULTI_SZ  7

DO decl

LOCAL oReg
oReg = CreateObject("Tregister", HKEY_CURRENT_USER, "Software\Microsoft\VisualFoxPro")

IF TYPE("oReg") = "O"
	oReg.SaveToFile("c:\temp\reg.xml")
ENDIF
* end of main

DEFINE CLASS Tregister As Custom
	oXml=.F.

PROCEDURE Init(hParentKey, cSubkey)
	LOCAL hKey, oXml, oKey
	hKey = 0
	IF RegOpenKeyEx(hParentKey, cSubkey, 0, KEY_ALL_ACCESS, @hKey) <> ERROR_SUCCESS
		RETURN .F.
	ENDIF
	
	THIS.oXml = CreateObject("Microsoft.XMLDOM")
	THIS.oXml.LoadXML(CHR(60) + "Registry" + CHR(47) + CHR(62))

	WITH THIS.oXml.documentElement()
		.SetAttribute("name", cSubkey)
		.SetAttribute("parent", hParentKey)
	ENDWITH

	oKey = CreateObject("Tkey", THIS.oXml, THIS.oXml.documentElement(), hKey)

PROCEDURE SaveToFile(cFilename)
	IF FILE(cFilename)
		DELETE FILE(cFilename)
	ENDIF
	THIS.oXml.Save(cFilename)
	= ShellExecute(0,"open", cFilename, "", "", 3)

ENDDEFINE

DEFINE CLASS Tkey As Custom
	oXml=.F.
	parentnode=.F.
	hKey=0

PROCEDURE Init(oXml, oParentNode, hKey)
	THIS.oXml = oXml
	THIS.parentnode = oParentNode
	THIS.hKey = hKey

	THIS.EnumValues
	THIS.EnumSubKeys

	= RegCloseKey(THIS.hKey)

PROCEDURE EnumValues
	LOCAL nIndex, nNameLen, nDataLen, nType, cName, cData, objProperty
	nIndex = 0
	DO WHILE .T.
		STORE 4096 TO nNameLen, nDataLen
		STORE Repli(Chr(0), nDataLen) TO cName, cData
		nType = 0

		IF RegEnumValue(THIS.hKey, nIndex, @cName, @nNameLen,;
			0, @nType, @cData, @nDataLen) <> ERROR_SUCCESS
			EXIT
		ENDIF

		cName = SUBSTR(cName, 1, AT(Chr(0),cName)-1)
		cData = SUBSTR(cData, 1, AT(Chr(0),cData)-1)

		IF Not EMPTY(cName)
			objProperty = THIS.oXml.CreateElement("Value")
			objProperty.SetAttribute("name", cName)
			objProperty.SetAttribute("type", nType)

			IF nType = REG_DWORD
				cData = buf2dword(PADR(cData,4,Chr(0)))
			ENDIF
			objProperty.SetAttribute("Data", cData)

			THIS.parentnode.AppendChild(objProperty)
		ENDIF
		nIndex = nIndex + 1
	ENDDO

PROCEDURE EnumSubKeys
	LOCAL nIndex, cBuffer, nResult, hKey, objSubnode, oKey
	nIndex = 0
	DO WHILE .T.
		cBuffer = Repli(Chr(0), 512)
		nResult = RegEnumKey(THIS.hKey, nIndex, @cBuffer, Len(cBuffer))
		IF nResult <> ERROR_SUCCESS
			EXIT
		ENDIF

		cBuffer = SUBSTR(cBuffer, 1, AT(Chr(0),cBuffer)-1)
		hKey = 0

		IF RegOpenKeyEx(THIS.hKey, cBuffer, 0, KEY_ALL_ACCESS, @hKey) = ERROR_SUCCESS
			objSubnode = THIS.oXml.CreateElement("Key")
			objSubnode.SetAttribute("name", cBuffer)
			THIS.parentnode.AppendChild(objSubNode)
			oKey = CreateObject("Tkey", THIS.oXml, objSubNode, hKey)
		ENDIF
		nIndex = nIndex + 1
	ENDDO

ENDDEFINE

PROCEDURE decl
	DECLARE INTEGER RegEnumKey IN advapi32;
		INTEGER hKey, INTEGER dwIndex, STRING @lpName,;
		INTEGER cchName

	DECLARE INTEGER RegOpenKeyEx IN advapi32;
		INTEGER hKey, STRING lpSubKey, INTEGER ulOptions,;
		INTEGER samDesired, INTEGER @phkResult

	DECLARE INTEGER RegEnumValue IN advapi32;
		INTEGER hKey, INTEGER dwIndex, STRING @lpValueName,;
		INTEGER @lpcValueName, INTEGER lpReserved, INTEGER @lpType,;
		STRING @lpData, INTEGER @lpcbData

	DECLARE INTEGER ShellExecute IN shell32;
		INTEGER hwnd, STRING lpOperation, STRING lpFile,;
		STRING lpParams, STRING lpDir, INTEGER nShowCmd

	DECLARE INTEGER RegCloseKey IN advapi32 INTEGER hKey

FUNCTION buf2dword(lcBuffer)
RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
	BitLShift(Asc(SUBSTR(lcBuffer, 2,1)),  8) +;
	BitLShift(Asc(SUBSTR(lcBuffer, 3,1)), 16) +;
	BitLShift(Asc(SUBSTR(lcBuffer, 4,1)), 24)
http://www.news2news.com/vfp/?example=379
Previous
Reply
Map
View

Click here to load this message in the networking platform