Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
How to read the value of a key from registry
Message
 
À
29/01/2004 13:23:39
Information générale
Forum:
Visual FoxPro
Catégorie:
Autre
Divers
Thread ID:
00871912
Message ID:
00871914
Vues:
22
>how to read the value of a key from registry:
>
>HKEY_LOCAL_MACHINE\Software\Jungclaus\Twain\SessionFinished either it should be 1 or 0
>
>1 means sessionfinished = true
>0 means sessionfinished = false
>
>Please let me know.Thank you very much.
* Operating System codes
#DEFINE	OS_W32S				1
#DEFINE	OS_NT				2
#DEFINE	OS_WIN95			3
#DEFINE	OS_MAC				4
#DEFINE	OS_DOS				5
#DEFINE	OS_UNIX				6

* DLL Paths for various operating systems
#DEFINE DLLPATH_NT			"\SYSTEM32\"
#DEFINE DLLPATH_WIN95		"\SYSTEM\"

* DLL files used to read INI files
#DEFINE	DLL_KERNEL_NT		"KERNEL32.DLL"
#DEFINE	DLL_KERNEL_WIN95	"KERNEL32.DLL"

* DLL files used to read registry
#DEFINE	DLL_ADVAPI_NT		"ADVAPI32.DLL"
#DEFINE	DLL_ADVAPI_WIN95	"ADVAPI32.DLL"

* DLL files used to read ODBC info
#DEFINE DLL_ODBC_NT			"ODBC32.DLL"
#DEFINE DLL_ODBC_WIN95		"ODBC32.DLL"

* Registry roots
#DEFINE HKEY_CLASSES_ROOT           -2147483648  && BITSET(0,31)
#DEFINE HKEY_CURRENT_USER           -2147483647  && BITSET(0,31)+1
#DEFINE HKEY_LOCAL_MACHINE          -2147483646  && BITSET(0,31)+2
#DEFINE HKEY_USERS                  -2147483645  && BITSET(0,31)+3

*  Added by Troy to stop error
#DEFINE CURRENT_USER         	  -2147483647  && BITSET(0,31)+1
#DEFINE LOCAL_MACHINE       	   -2147483646  && BITSET(0,31)+2


* Misc
#DEFINE APP_PATH_KEY		"\Shell\Open\Command"
#DEFINE OLE_PATH_KEY		"\Protocol\StdFileEditing\Server"
#DEFINE VFP_OPTIONS_KEY1	"Software\Microsoft\VisualFoxPro\"
#DEFINE VFP_OPTIONS_KEY2	"\Options"
#DEFINE CURVER_KEY			"\CurVer"
#DEFINE ODBC_DATA_KEY		"Software\ODBC\ODBC.INI\"
#DEFINE ODBC_DRVRS_KEY		"Software\ODBC\ODBCINST.INI\"
#DEFINE SQL_FETCH_NEXT		1
#DEFINE SQL_NO_DATA			100

* Error Codes
#DEFINE ERROR_SUCCESS		0	&& OK
#DEFINE ERROR_EOF 			259 && no more entries in key

* Note these next error codes are specific to this Class, not DLL
#DEFINE ERROR_NOAPIFILE		-101	&& DLL file to check registry not found
#DEFINE ERROR_KEYNOREG		-102	&& key not registered
#DEFINE ERROR_BADPARM		-103	&& bad parameter passed
#DEFINE ERROR_NOENTRY		-104	&& entry not found
#DEFINE	ERROR_BADKEY		-105	&& bad key passed
#DEFINE	ERROR_NONSTR_DATA	-106	&& data type for value is not a data string
#DEFINE ERROR_BADPLAT		-107	&& platform not supported
#DEFINE ERROR_NOINIFILE		-108	&& DLL file to check INI not found
#DEFINE ERROR_NOINIENTRY	-109	&& No entry in INI file
#DEFINE ERROR_FAILINI		-110	&& failed to get INI entry
#DEFINE ERROR_NOPLAT		-111	&& call not supported on this platform
#DEFINE ERROR_NOODBCFILE	-112	&& DLL file to check ODBC not found
#DEFINE ERROR_ODBCFAIL		-113	&& failed to get ODBC environment

* Data types for keys
#DEFINE REG_SZ 				1	&& Data string
#DEFINE REG_EXPAND_SZ 		2	&& Unicode string
#DEFINE REG_BINARY 			3	&& Binary data in any form.
#DEFINE REG_DWORD 			4	&& A 32-bit number.

* Data types labels
#DEFINE REG_BINARY_LOC		"*Binary*"			&& Binary data in any form.
#DEFINE REG_DWORD_LOC 		"*Dword*"			&& A 32-bit number.
#DEFINE REG_UNKNOWN_LOC		"*Unknown type*"	&& unknown type

* FoxPro ODBC drivers
#DEFINE FOXODBC_25			"FoxPro Files (*.dbf)"
#DEFINE FOXODBC_26			"Microsoft FoxPro Driver (*.dbf)"
#DEFINE FOXODBC_30			"Microsoft Visual FoxPro Driver"

#INCLUDE foxpro.h
Define CLASS registry AS custom
	**********************************************************************************************
	* Reads or Writes a value to the Windows Registry
	* Troy Murphy 07/15/1999
	* Read/Write Meghod Parameters:
	*	lcReadWrite		= 'READ' or 'WRITE' string
	*	lcUserMachine	= 'USER' or 'MACHINE' string
	*	lcRegPath		= Registry path (ex: 'Software\VL\Cleaning')
	*	lcOption		= Registry Value (ex: 'Version')
	*	luSetValue		= Used only in WRITE - sets the option to this value
	*	llAutoAdd		= Used only in WRITE - logical True will add the key if not already there
	* Examples:			--- Writes will return .t. if sucessful
	*	=oApp.oReg.Write('USER','Software\VL\Accounting\StateTax','CA','8.75')
	*	?oApp.oReg.Read('USER','Software\VL\Accounting\StateTax','CA')
	* Note: Registry Values are ALWAYS strings (character type)
	*
	* Encapsulates Registry Class that is bundled with VFP:
	* Copyright (c) 1995,1996 Sierra Systems, Microsoft Corporation
	* Written by Randy Brown
	* Contributions from Matt Oshry, Calvin Hsia
	* The Registry class provides a complete library of API
	* calls to access the Windows Registry. Support is provided
	* for Windows 32S, Windows NT amd Windows 95. Included for
	* backward compatibility with older applications which still
	* use INI files are several routines which access INI sections
	* and details. Finally, several valuable routines are included
	* for accessing ODBC drivers and data sources.
	**************************************************************************
	nUserKey 		= HKEY_CURRENT_USER
	cVFPOptPath 	= VFP_OPTIONS_KEY1
	cRegDLLFile	 	= ""
	cINIDLLFile 	= ""
	cODBCDLLFile 	= ""
	nCurrentOS 		= 0
	nCurrentKey 	= 0
	lLoadedDLLs 	= .F.
	lLoadedINIs 	= .F.
	lLoadedODBCs 	= .F.
	cAppPathKey 	= ""
	lCreateKey 		= .F.
	lhaderror 		= .f.

	Procedure Init
		Do CASE
			Case _DOS OR _UNIX OR _MAC
				Return .F.
			Case ATC("Windows 3",OS(1)) # 0
				This.nCurrentOS = OS_W32S
				This.cRegDLLFile = DLL_ADVAPI_W32S
				This.cINIDLLFile = DLL_KERNEL_W32S
				This.cODBCDLLFile = DLL_ODBC_W32S
				This.cVFPOptPath = VFP_OPT32S_KEY
				This.nUserKey = HKEY_CLASSES_ROOT
			Case ATC("Windows NT",OS(1)) # 0
				This.nCurrentOS = OS_NT
				This.cRegDLLFile = DLL_ADVAPI_NT
				This.cINIDLLFile = DLL_KERNEL_NT
				This.cODBCDLLFile = DLL_ODBC_NT
			Otherwise
				* Windows 95
				This.nCurrentOS = OS_WIN95
				This.cRegDLLFile = DLL_ADVAPI_WIN95
				This.cINIDLLFile = DLL_KERNEL_WIN95
				This.cODBCDLLFile = DLL_ODBC_WIN95
		Endcase
	Endproc

	Function Read (lcUserMachine,lcRegPath,lcOption)
		* Reads a value from the registry
		*	lcUserMachine	= 'USER' or 'MACHINE' string
		*	lcRegPath		= Registry path (ex: 'Software\VL\Cleaning')
		*	lcOption		= Registry Value (ex: 'Version')
		If type('lcUserMachine')#[C] or type('lcRegPath')#[C] or type('lcOption')#[C]
			Return .f.
		Endif
		lcUserMachine=upper(alltrim(lcUserMachine))
		lcRegPath=alltrim(lcRegPath)
		lcOption=alltrim(lcOption)
		If !lcUserMachine$[USER,MACHINE]
			Return .f.
		Endif
		Local luVlu,lnKey,lcReturnString
		lnKey=iif(lcUserMachine=[MACHINE],LOCAL_MACHINE,CURRENT_USER)
		Local luRetCode
		luVlu=space(255)
		luRetCode=this.getregkey(lcOption,@luVlu,lcRegPath,lnKey)
		lcReturnString=alltrim(luVlu)
		Return lcReturnString
	Endfunc

	Function Write (lcUserMachine,lcRegPath,lcOption,luSetValue)
		* Writes a value to the registry
		*	lcUserMachine	= 'USER' or 'MACHINE' string
		*	lcRegPath		= Registry path (ex: 'Software\VL\Cleaning')
		*	lcOption		= Registry Value (ex: 'Version')
		*	luSetValue		= Sets the option to this value
		Local llAutoAdd,luVlu,lnKey,lcReturnString,luRetCode
		llAutoAdd=.T.	&& If True, this key and value will be added if not already present
		If type('lcUserMachine')#[C] or type('lcRegPath')#[C] or type('lcOption')#[C]
			Return .f.
		Endif
		lcUserMachine=upper(alltrim(lcUserMachine))
		lcRegPath=alltrim(lcRegPath)
		lcOption=alltrim(lcOption)
		If empty(lcUserMachine) or empty(lcRegPath) or empty(lcOption)
			Return .f.
		Endif
		If !lcUserMachine$[USER,MACHINE]
			Return .f.
		Endif
		lnKey=iif(lcUserMachine=[MACHINE],LOCAL_MACHINE,CURRENT_USER)
		This.lCreateKey=llAutoAdd
		luVlu=space(255)
		luRetCode=this.setregkey(lcOption,luSetValue,lcRegPath,lnKey)
		lcReturnString=alltrim(luVlu)
		Return lcReturnString
	Endfunc

	Procedure Error
		Lparameters nError, cMethod, nLine
		This.lhaderror = .T.
		=MESSAGEBOX(MESSAGE())
	Endproc

	Procedure LoadRegFuncs
		* Loads funtions needed for Registry
		Local nHKey,cSubKey,nResult
		Local hKey,iValue,lpszValue,lpcchValue,lpdwType,lpbData,lpcbData
		Local lpcStr,lpszVal,nLen,lpdwReserved
		Local lpszValueName,dwReserved,fdwType
		Local iSubKey,lpszName,cchName

		If THIS.lLoadedDLLs
			Return ERROR_SUCCESS
		Endif

		Declare Integer RegOpenKey IN Win32API ;
			Integer nHKey, String @cSubKey, Integer @nResult

		If THIS.lhaderror && error loading library
			Return -1
		Endif

		Declare Integer RegCreateKey IN Win32API ;
			Integer nHKey, String @cSubKey, Integer @nResult

		Declare Integer RegDeleteKey IN Win32API ;
			Integer nHKey, String @cSubKey

		Declare Integer RegDeleteValue IN Win32API ;
			Integer nHKey, String cSubKey

		Declare Integer RegCloseKey IN Win32API ;
			Integer nHKey

		Declare Integer RegSetValueEx IN Win32API ;
			Integer hKey, String lpszValueName, Integer dwReserved,;
			Integer fdwType, String lpbData, Integer cbData

		Declare Integer RegQueryValueEx IN Win32API ;
			Integer nHKey, String lpszValueName, Integer dwReserved,;
			Integer @lpdwType, String @lpbData, Integer @lpcbData

		Declare Integer RegEnumKey IN Win32API ;
			Integer nHKey,Integer iSubKey, String @lpszName, Integer @cchName

		Declare Integer RegEnumKeyEx IN Win32API ;
			Integer nHKey,Integer iSubKey, String @lpszName, Integer @cchName,;
			Integer dwReserved,String @lpszName, Integer @cchName,String @cchName

		Declare Integer RegEnumValue IN Win32API ;
			Integer hKey, Integer iValue, String @lpszValue, ;
			Integer @lpcchValue, Integer lpdwReserved, Integer @lpdwType, ;
			String @lpbData, Integer @lpcbData

		This.lLoadedDLLs = .T.

		* Need error check here
		Return ERROR_SUCCESS
	Endproc

	Procedure OpenKey
		* Opens a registry key
		Lparameter cLookUpKey,nRegKey,lCreateKey

		Local nSubKey,nErrCode,nPCount,lSaveCreateKey
		nSubKey = 0
		nPCount = PARAMETERS()

		If TYPE("m.nRegKey") # "N" OR EMPTY(m.nRegKey)
			m.nRegKey = HKEY_CLASSES_ROOT
		Endif

		* Load API functions
		nErrCode = THIS.LoadRegFuncs()
		If m.nErrCode # ERROR_SUCCESS
			Return m.nErrCode
		Endif

		lSaveCreateKey = THIS.lCreateKey
		If m.nPCount>2 AND TYPE("m.lCreateKey") = "L"
			This.lCreateKey = m.lCreateKey
		Endif

		If THIS.lCreateKey
			* Try to open or create registry key
			nErrCode = RegCreateKey(m.nRegKey,m.cLookUpKey,@nSubKey)
		Else
			* Try to open registry key
			nErrCode = RegOpenKey(m.nRegKey,m.cLookUpKey,@nSubKey)
		Endif

		This.lCreateKey = m.lSaveCreateKey

		If nErrCode # ERROR_SUCCESS
			Return m.nErrCode
		Endif

		This.nCurrentKey = m.nSubKey
		Return ERROR_SUCCESS
	Endproc

	Procedure CloseKey
		* Closes a registry key
		=RegCloseKey(THIS.nCurrentKey)
		This.nCurrentKey =0
	Endproc

	Procedure setregkey
		* This routine sets a registry key setting
		* ex. THIS.SetRegKey("ResWidth","640",;
		*		"Software\Microsoft\VisualFoxPro\4.0\Options",;
		*		HKEY_CURRENT_USER)
		Lparameter cOptName,cOptVal,cKeyPath,nUserKey
		Local iPos,cOptKey,cOption,nErrNum
		iPos = 0
		cOption = ""
		nErrNum = ERROR_SUCCESS

		* Open registry key
		m.nErrNum = THIS.OpenKey(m.cKeyPath,m.nUserKey)
		If m.nErrNum # ERROR_SUCCESS
			Return m.nErrNum
		Endif

		* Set Key value
		nErrNum = THIS.SetKeyValue(m.cOptName,m.cOptVal)

		* Close registry key
		This.CloseKey()		&&close key
		Return m.nErrNum
	Endproc

	Procedure getregkey
		* This routine gets a registry key setting
		* ex. THIS.GetRegKey("ResWidth",@cValue,;
		*		"Software\Microsoft\VisualFoxPro\4.0\Options",;
		*		HKEY_CURRENT_USER)
		Lparameter cOptName,cOptVal,cKeyPath,nUserKey
		Local iPos,cOptKey,cOption,nErrNum
		iPos = 0
		cOption = ""
		nErrNum = ERROR_SUCCESS

		* Open registry key
		m.nErrNum = THIS.OpenKey(m.cKeyPath,m.nUserKey)
		If m.nErrNum # ERROR_SUCCESS
			Return m.nErrNum
		Endif

		* Get the key value
		nErrNum = THIS.GetKeyValue(cOptName,@cOptVal)

		* Close registry key
		This.CloseKey()		&&close key
		Return m.nErrNum
	Endproc

	Procedure GetKeyValue
		* Obtains a value from a registry key
		* Note: this routine only handles Data strings (REG_SZ)
		Lparameter cValueName,cKeyValue

		Local lpdwReserved,lpdwType,lpbData,lpcbData,nErrCode
		Store 0 TO lpdwReserved,lpdwType
		Store SPACE(256) TO lpbData
		Store LEN(m.lpbData) TO m.lpcbData

		Do CASE
			Case TYPE("THIS.nCurrentKey")#'N' OR THIS.nCurrentKey = 0
				Return ERROR_BADKEY
			Case TYPE("m.cValueName") #"C"
				Return ERROR_BADPARM
		Endcase

		m.nErrCode=RegQueryValueEx(THIS.nCurrentKey,m.cValueName,;
			m.lpdwReserved,@lpdwType,@lpbData,@lpcbData)

		* Check for error
		If m.nErrCode # ERROR_SUCCESS
			Return m.nErrCode
		Endif

		* Make sure we have a data string data type
		If lpdwType # REG_SZ
			Return ERROR_NONSTR_DATA
		Endif

		m.cKeyValue = LEFT(m.lpbData,m.lpcbData-1)
		Return ERROR_SUCCESS
	Endproc

	Procedure SetKeyValue
		* This routine sets a key value
		* Note: this routine only handles data strings (REG_SZ)
		Lparameter cValueName,cValue
		Local nValueSize,nErrCode

		Do CASE
			Case TYPE("THIS.nCurrentKey")#'N' OR THIS.nCurrentKey = 0
				Return ERROR_BADKEY
			Case TYPE("m.cValueName") #"C" OR TYPE("m.cValue")#"C"
				Return ERROR_BADPARM
			Case EMPTY(m.cValueName) OR EMPTY(m.cValue)
				Return ERROR_BADPARM
		Endcase

		* Make sure we null terminate this guy
		cValue = m.cValue+CHR(0)
		nValueSize = LEN(m.cValue)

		* Set the key value here
		m.nErrCode = RegSetValueEx(THIS.nCurrentKey,m.cValueName,0,;
			REG_SZ,m.cValue,m.nValueSize)

		* Check for error
		If m.nErrCode # ERROR_SUCCESS
			Return m.nErrCode
		Endif

		Return ERROR_SUCCESS
	Endproc

	Procedure DeleteKey
		* This routine deletes a Registry Key
		Lparameter nUserKey,cKeyPath
		Local nErrNum
		nErrNum = ERROR_SUCCESS

		* Delete key
		m.nErrNum = RegDeleteKey(m.nUserKey,m.cKeyPath)
		Return m.nErrNum
	Endproc

	Procedure EnumOptions
		* Enumerates through all entries for a key and populates array
		Lparameter aRegOpts,cOptPath,nUserKey,lEnumKeys
		Local iPos,cOptKey,cOption,nErrNum
		iPos = 0
		cOption = ""
		nErrNum = ERROR_SUCCESS

		If PARAMETERS()<4 OR TYPE("m.lEnumKeys") # "L"
			lEnumKeys = .F.
		Endif

		* Open key
		m.nErrNum = THIS.OpenKey(m.cOptPath,m.nUserKey)
		If m.nErrNum # ERROR_SUCCESS
			Return m.nErrNum
		Endif

		* Enumerate through keys
		If m.lEnumKeys
			* Enumerate and get key names
			nErrNum = THIS.EnumKeys(@aRegOpts)
		Else
			* Enumerate and get all key values
			nErrNum = THIS.EnumKeyValues(@aRegOpts)
		Endif

		* Close key
		This.CloseKey()		&&close key
		Return m.nErrNum
	Endproc

	Function IsKey
		* Checks to see if a key exists
		Lparameter cKeyName,nRegKey

		* Open extension key
		nErrNum = THIS.OpenKey(m.cKeyName,m.nRegKey)
		If m.nErrNum  = ERROR_SUCCESS
			* Close extension key
			This.CloseKey()
		Endif

		Return m.nErrNum = ERROR_SUCCESS
	Endfunc

	Procedure EnumKeys
		Parameter aKeyNames
		Local nKeyEntry,cNewKey,cNewSize,cbuf,nbuflen,cRetTime
		nKeyEntry = 0
		Dimension aKeyNames[1]
		Do WHILE .T.
			nKeySize = 0
			cNewKey = SPACE(100)
			nKeySize = LEN(m.cNewKey)
			cbuf=space(100)
			nbuflen=len(m.cbuf)
			cRetTime=space(100)

			m.nErrCode = RegEnumKeyEx(THIS.nCurrentKey,m.nKeyEntry,@cNewKey,@nKeySize,0,@cbuf,@nbuflen,@cRetTime)

			Do CASE
				Case m.nErrCode = ERROR_EOF
					Exit
				Case m.nErrCode # ERROR_SUCCESS
					Exit
			Endcase

			cNewKey = ALLTRIM(m.cNewKey)
			cNewKey = LEFT(m.cNewKey,LEN(m.cNewKey)-1)
			If !EMPTY(aKeyNames[1])
				Dimension aKeyNames[ALEN(aKeyNames)+1]
			Endif
			aKeyNames[ALEN(aKeyNames)] = m.cNewKey
			nKeyEntry = m.nKeyEntry + 1
		Enddo

		If m.nErrCode = ERROR_EOF AND m.nKeyEntry # 0
			m.nErrCode = ERROR_SUCCESS
		Endif
		Return m.nErrCode
	Endproc

	Procedure EnumKeyValues
		* Enumerates through values of a registry key
		Lparameter aKeyValues

		Local lpszValue,lpcchValue,lpdwReserved
		Local lpdwType,lpbData,lpcbData
		Local nErrCode,nKeyEntry,lArrayPassed

		Store 0 TO nKeyEntry

		If TYPE("THIS.nCurrentKey")#'N' OR THIS.nCurrentKey = 0
			Return ERROR_BADKEY
		Endif

		* Sorry, Win32s does not support this one!
		If THIS.nCurrentOS = OS_W32S
			Return ERROR_BADPLAT
		Endif

		Do WHILE .T.

			Store 0 TO lpdwReserved,lpdwType,nErrCode
			Store SPACE(256) TO lpbData, lpszValue
			Store LEN(lpbData) TO m.lpcchValue
			Store LEN(lpszValue) TO m.lpcbData

			nErrCode=RegEnumValue(THIS.nCurrentKey,m.nKeyEntry,@lpszValue,;
				@lpcchValue,m.lpdwReserved,@lpdwType,@lpbData,@lpcbData)

			Do CASE
				Case m.nErrCode = ERROR_EOF
					Exit
				Case m.nErrCode # ERROR_SUCCESS
					Exit
			Endcase

			nKeyEntry = m.nKeyEntry + 1

			* Set array values
			Dimension aKeyValues[m.nKeyEntry,2]
			aKeyValues[m.nKeyEntry,1] = LEFT(m.lpszValue,m.lpcchValue)
			Do CASE
				Case lpdwType = REG_SZ
					aKeyValues[m.nKeyEntry,2] = LEFT(m.lpbData,m.lpcbData-1)
				Case lpdwType = REG_BINARY
					* Don't support binary
					aKeyValues[m.nKeyEntry,2] = REG_BINARY_LOC
				Case lpdwType = REG_DWORD
					* You will need to use ASC() to check values here.
					aKeyValues[m.nKeyEntry,2] = LEFT(m.lpbData,m.lpcbData-1)
				Otherwise
					aKeyValues[m.nKeyEntry,2] = REG_UNKNOWN_LOC
			Endcase
		Enddo

		If m.nErrCode = ERROR_EOF AND m.nKeyEntry # 0
			m.nErrCode = ERROR_SUCCESS
		Endif
		Return m.nErrCode
	Endproc

Enddefine
Précédent
Répondre
Fil
Voir

Click here to load this message in the networking platform