romfast/comun
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
989c3dd6f4227a8095d6263de2d5b1aeee777ae0
comun/clase/registry.vc2

925 lines
25 KiB
Plaintext
Raw Blame History

*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!!
*--------------------------------------------------------------------------------------------------------------------------------------------------------
*< FOXBIN2PRG: Version="1.21" SourceFile="registry.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
*
*
DEFINE CLASS filereg AS registry OF "registry.vcx"
*< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" />
#INCLUDE "registry.h"
*<DefinedPropArrayMethod>
*m: getapplication && Retrieves application key.
*m: getapppath && Checks and returns path of application associated with a particular extension (e.g., XLS, DOC).
*m: getlatestversion && Returns latest version for a specified application.
*</DefinedPropArrayMethod>
*<PropValue>
Name = "filereg"
*</PropValue>
PROCEDURE getapplication && Retrieves application key.
LPARAMETERS cExtnKey,cAppKey,lServer
LOCAL nErrNum,cOptName
cOptName = ""
* lServer - checking for OLE server.
IF TYPE("m.lServer") = "L" AND m.lServer
THIS.cAppPathKey = OLE_PATH_KEY
ELSE
THIS.cAppPathKey = APP_PATH_KEY
ENDIF
* Open extension app key
m.nErrNum = THIS.OpenKey(m.cExtnKey+THIS.cAppPathKey)
IF m.nErrNum # ERROR_SUCCESS
RETURN m.nErrNum
ENDIF
* Get application path
nErrNum = THIS.GetKeyValue(cOptName,@cAppKey)
* Close application path key
THIS.CloseKey()
RETURN m.nErrNum
ENDPROC
PROCEDURE getapppath && Checks and returns path of application associated with a particular extension (e.g., XLS, DOC).
* Checks and returns path of application
* associated with a particular extension (e.g., XLS, DOC).
LPARAMETER cExtension,cExtnKey,cAppKey,lServer
LOCAL nErrNum,cOptName
cOptName = ""
* Check Extension parameter
IF TYPE("m.cExtension") # "C" OR LEN(m.cExtension) > 3
RETURN ERROR_BADPARM
ENDIF
m.cExtension = "."+m.cExtension
* Open extension key
nErrNum = THIS.OpenKey(m.cExtension)
IF m.nErrNum # ERROR_SUCCESS
RETURN m.nErrNum
ENDIF
* Get key value for file extension
nErrNum = THIS.GetKeyValue(cOptName,@cExtnKey)
* Close extension key
THIS.CloseKey()
IF m.nErrNum # ERROR_SUCCESS
RETURN m.nErrNum
ENDIF
RETURN THIS.GetApplication(cExtnKey,@cAppKey,lServer)
ENDPROC
PROCEDURE getlatestversion && Returns latest version for a specified application.
LPARAMETER cClass,cExtnKey,cAppKey,lServer
LOCAL nErrNum,cOptName
cOptName = ""
* Open class key (e.g., Excel.Sheet)
nErrNum = THIS.OpenKey(m.cClass+CURVER_KEY)
IF m.nErrNum # ERROR_SUCCESS
RETURN m.nErrNum
ENDIF
* Get key value for file extension
nErrNum = THIS.GetKeyValue(cOptName,@cExtnKey)
* Close extension key
THIS.CloseKey()
IF m.nErrNum # ERROR_SUCCESS
RETURN m.nErrNum
ENDIF
RETURN THIS.GetApplication(cExtnKey,@cAppKey,lServer)
ENDPROC
ENDDEFINE
DEFINE CLASS foxreg AS registry OF "registry.vcx"
*< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" />
#INCLUDE "registry.h"
*<DefinedPropArrayMethod>
*m: enumfoxoptions
*m: getfoxoption && Retrieves an option from FoxPro registry settings.
*m: setfoxoption && Sets an option from FoxPro registry settings.
*</DefinedPropArrayMethod>
*<PropValue>
Name = "foxreg"
*</PropValue>
PROCEDURE enumfoxoptions
LPARAMETER aFoxOpts
RETURN THIS.EnumOptions(@aFoxOpts,THIS.cVFPOptPath,THIS.nUserKey,.F.)
ENDPROC
PROCEDURE getfoxoption && Retrieves an option from FoxPro registry settings.
LPARAMETER cOptName,cOptVal
RETURN THIS.GetRegKey(cOptName,@cOptVal,THIS.cVFPOptPath,THIS.nUserKey)
ENDPROC
PROCEDURE setfoxoption && Sets an option from FoxPro registry settings.
LPARAMETER cOptName,cOptVal
RETURN THIS.SetRegKey(cOptName,cOptVal,THIS.cVFPOptPath,THIS.nUserKey)
ENDPROC
ENDDEFINE
DEFINE CLASS odbcreg AS registry OF "registry.vcx"
*< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" />
#INCLUDE "registry.h"
*<DefinedPropArrayMethod>
*m: enumodbcdata && Enumerates through ODBC data sources.
*m: enumodbcdrvrs && Enumerates through ODBC drivers.
*m: getodbcdrvrs && Retrieves ODBC drivers.
*m: loadodbcfuncs && Loads ODBC registry functions.
*</DefinedPropArrayMethod>
*<PropValue>
Name = "odbcreg"
*</PropValue>
PROCEDURE enumodbcdata && Enumerates through ODBC data sources.
LPARAMETER aDrvrOpts,cDataSource
LOCAL cSourceKey
cSourceKey = ODBC_DATA_KEY+cDataSource
RETURN THIS.EnumOptions(@aDrvrOpts,m.cSourceKey,HKEY_CURRENT_USER,.F.)
ENDPROC
PROCEDURE enumodbcdrvrs && Enumerates through ODBC drivers.
LPARAMETER aDrvrOpts,cODBCDriver
LOCAL cSourceKey
cSourceKey = ODBC_DRVRS_KEY+m.cODBCDriver
RETURN THIS.EnumOptions(@aDrvrOpts,m.cSourceKey,HKEY_LOCAL_MACHINE,.F.)
ENDPROC
PROCEDURE getodbcdrvrs && Retrieves ODBC drivers.
LPARAMETERS aDrvrs,lDataSources
LOCAL nODBCEnv,nRetVal,dsn,dsndesc,mdsn,mdesc
lDataSources = IIF(TYPE("m.lDataSources")="L",m.lDataSources,.F.)
* Load API functions
nRetVal = THIS.LoadODBCFuncs()
IF m.nRetVal # ERROR_SUCCESS
RETURN m.nRetVal
ENDIF
* Get ODBC environment handle
nODBCEnv=VAL(SYS(3053))
* -- Possible error messages
* 527 "cannot load odbc library"
* 528 "odbc entry point missing"
* 182 "not enough memory"
IF INLIST(nODBCEnv,527,528,182)
* Failed
RETURN ERROR_ODBCFAIL
ENDIF
DIMENSION aDrvrs[1,IIF(m.lDataSources,2,1)]
aDrvrs[1] = ""
DO WHILE .T.
dsn=space(100)
dsndesc=space(100)
mdsn=0
mdesc=0
* Return drivers or data sources
IF m.lDataSources
nRetVal = SQLDataSources(m.nODBCEnv,SQL_FETCH_NEXT,@dsn,100,@mdsn,@dsndesc,255,@mdesc)
ELSE
nRetVal = SQLDrivers(m.nODBCEnv,SQL_FETCH_NEXT,@dsn,100,@mdsn,@dsndesc,100,@mdesc)
ENDIF
DO CASE
CASE m.nRetVal = SQL_NO_DATA
nRetVal = ERROR_SUCCESS
EXIT
CASE m.nRetVal # ERROR_SUCCESS AND m.nRetVal # 1
EXIT
OTHERWISE
IF !EMPTY(aDrvrs[1])
IF m.lDataSources
DIMENSION aDrvrs[ALEN(aDrvrs,1)+1,2]
ELSE
DIMENSION aDrvrs[ALEN(aDrvrs,1)+1,1]
ENDIF
ENDIF
dsn = ALLTRIM(m.dsn)
aDrvrs[ALEN(aDrvrs,1),1] = UPPER(LEFT(m.dsn,LEN(m.dsn)-1))
IF m.lDataSources
dsndesc = ALLTRIM(m.dsndesc)
aDrvrs[ALEN(aDrvrs,1),2] = LEFT(m.dsndesc,LEN(m.dsndesc)-1)
ENDIF
ENDCASE
ENDDO
RETURN nRetVal
ENDPROC
PROCEDURE loadodbcfuncs && Loads ODBC registry functions.
IF THIS.lLoadedODBCs
RETURN ERROR_SUCCESS
ENDIF
* Check API file containing functions
IF EMPTY(THIS.cODBCDLLFile)
RETURN ERROR_NOODBCFILE
ENDIF
LOCAL henv,fDirection,szDriverDesc,cbDriverDescMax
LOCAL pcbDriverDesc,szDriverAttributes,cbDrvrAttrMax,pcbDrvrAttr
LOCAL szDSN,cbDSNMax,pcbDSN,szDescription,cbDescriptionMax,pcbDescription
DECLARE Short SQLDrivers IN (THIS.cODBCDLLFile) ;
Integer henv, Integer fDirection, ;
String @ szDriverDesc, Integer cbDriverDescMax, Integer pcbDriverDesc, ;
String @ szDriverAttributes, Integer cbDrvrAttrMax, Integer pcbDrvrAttr
IF THIS.lhaderror && error loading library
RETURN -1
ENDIF
DECLARE Short SQLDataSources IN (THIS.cODBCDLLFile) ;
Integer henv, Integer fDirection, ;
String @ szDSN, Integer cbDSNMax, Integer @ pcbDSN, ;
String @ szDescription, Integer cbDescriptionMax,Integer pcbDescription
THIS.lLoadedODBCs = .T.
RETURN ERROR_SUCCESS
ENDPROC
ENDDEFINE
DEFINE CLASS oldinireg AS registry OF "registry.vcx"
*< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" />
#INCLUDE "registry.h"
*<DefinedPropArrayMethod>
*m: getinientry && Retrieves information from INI entry.
*m: getinisection && Retrieves information from INI section.
*m: loadinifuncs && Loads functions needed for reading INI files.
*m: writeinientry && Writes a specific INI entry.
*</DefinedPropArrayMethod>
*<PropValue>
Name = "oldinireg"
*</PropValue>
PROCEDURE getinientry && Retrieves information from INI entry.
LPARAMETER cValue,cSection,cEntry,cINIFile
* Get entry from INI file
LOCAL cBuffer,nBufSize,nErrNum,nTotParms
nTotParms = PCOUNT()
* Load API functions
nErrNum= THIS.LoadINIFuncs()
IF m.nErrNum # ERROR_SUCCESS
RETURN m.nErrNum
ENDIF
* Parameter checks here
IF m.nTotParms < 3
m.cEntry = 0
ENDIF
m.cBuffer=space(2000)
IF EMPTY(m.cINIFile)
* WIN.INI file
m.nBufSize = GetWinINI(m.cSection,m.cEntry,"",@cBuffer,LEN(m.cBuffer))
ELSE
* Private INI file
m.nBufSize = GetPrivateINI(m.cSection,m.cEntry,"",@cBuffer,LEN(m.cBuffer),m.cINIFile)
ENDIF
IF m.nBufSize = 0 &&could not find entry in INI file
RETURN ERROR_NOINIENTRY
ENDIF
m.cValue=LEFT(m.cBuffer,m.nBufSize)
** All is well
RETURN ERROR_SUCCESS
ENDPROC
PROCEDURE getinisection && Retrieves information from INI section.
LPARAMETERS aSections,cSection,cINIFile
LOCAL cINIValue, nTotEntries, i, nLastPos
cINIValue = ""
IF TYPE("m.cINIFile") # "C"
cINIFile = ""
ENDIF
IF THIS.GetINIEntry(@cINIValue,cSection,0,m.cINIFile) # ERROR_SUCCESS
RETURN ERROR_FAILINI
ENDIF
nTotEntries=OCCURS(CHR(0),m.cINIValue)
DIMENSION aSections[m.nTotEntries]
nLastPos = 1
FOR i = 1 TO m.nTotEntries
nTmpPos = AT(CHR(0),m.cINIValue,m.i)
aSections[m.i] = SUBSTR(m.cINIValue,m.nLastPos,m.nTmpPos-m.nLastPos)
nLastPos = m.nTmpPos+1
ENDFOR
RETURN ERROR_SUCCESS
ENDPROC
PROCEDURE loadinifuncs && Loads functions needed for reading INI files.
* Loads funtions needed for reading INI files
IF THIS.lLoadedINIs
RETURN ERROR_SUCCESS
ENDIF
DECLARE integer GetPrivateProfileString IN Win32API ;
AS GetPrivateINI string,string,string,string,integer,string
IF THIS.lhaderror && error loading library
RETURN -1
ENDIF
DECLARE integer GetProfileString IN Win32API ;
AS GetWinINI string,string,string,string,integer
DECLARE integer WriteProfileString IN Win32API ;
AS WriteWinINI string,string,string
DECLARE integer WritePrivateProfileString IN Win32API ;
AS WritePrivateINI string,string,string,string
THIS.lLoadedINIs = .T.
* Need error check here
RETURN ERROR_SUCCESS
ENDPROC
PROCEDURE writeinientry && Writes a specific INI entry.
LPARAMETER cValue,cSection,cEntry,cINIFile
* Get entry from INI file
LOCAL nErrNum
* Load API functions
nErrNum = THIS.LoadINIFuncs()
IF m.nErrNum # ERROR_SUCCESS
RETURN m.nErrNum
ENDIF
IF EMPTY(m.cINIFile)
* WIN.INI file
nErrNum = WriteWinINI(m.cSection,m.cEntry,m.cValue)
ELSE
* Private INI file
nErrNum = WritePrivateINI(m.cSection,m.cEntry,m.cValue,m.cINIFile)
ENDIF
** All is well
RETURN IIF(m.nErrNum=1,ERROR_SUCCESS,m.nErrNum)
ENDPROC
ENDDEFINE
DEFINE CLASS registry AS custom
*< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" />
#INCLUDE "registry.h"
*<DefinedPropArrayMethod>
*m: closekey && Closes a registry key.
*m: deletekey && Deletes a registry key.
*m: deletekeyvalue && Deletes value from registry key.
*m: enumkeys && Enumerates through a registry key.
*m: enumkeyvalues && Enumerates through values of a registry key
*m: enumoptions && Enumerates through all entries for a key and populates array.
*m: getkeyvalue && Obtains a value from a registry key.
*m: getregkey && Gets a registry key setting.
*m: iskey && Checks to see if a key exists.
*m: loadregfuncs && Loads funtions needed for Registry.
*m: openkey && Opens a registry key.
*m: setkeyvalue && Sets a key value.
*m: setregkey && Sets a registry key setting.
*p: capppathkey && Application path registry key.
*p: cinidllfile && DLL file for INI functions.
*p: codbcdllfile && DLL file for ODBC functions.
*p: cregdllfile && DLL file for registry functions.
*p: cvfpoptpath && Registry path to VFP options settings.
*p: lcreatekey && Whether to create key if one does not already exist.
*p: ldisallowexpanded
*p: lhaderror && Whether an error occurred.
*p: lhasdllloaded
*p: lloadeddlls && Whether registry key functions loaded.
*p: lloadedinis && Whether INI functions loaded.
*p: lloadedodbcs && Whether ODBC functions loaded.
*p: ncurrentkey && Current registry key.
*p: ncurrentos && Current operating system code.
*p: nuserkey && User registry key.
*</DefinedPropArrayMethod>
*<PropValue>
capppathkey =
cinidllfile =
codbcdllfile =
cregdllfile =
cvfpoptpath =
Name = "registry"
ncurrentkey = 0
ncurrentos = 0
nuserkey = 0
*</PropValue>
PROCEDURE closekey && Closes a registry key.
* Closes a registry key
=RegCloseKey(THIS.nCurrentKey)
THIS.nCurrentKey =0
ENDPROC
PROCEDURE deletekey && Deletes a registry key.
* 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 deletekeyvalue && Deletes value from registry key.
LPARAMETER cOptName,cKeyPath,nUserKey
LOCAL cOption,nErrNum
cOption = cOptName
nErrNum = ERROR_SUCCESS
* Open key
m.nErrNum = THIS.OpenKey(m.cKeyPath,m.nUserKey)
IF m.nErrNum # ERROR_SUCCESS
RETURN m.nErrNum
ENDIF
* Delete the key value
m.nErrNum = RegDeleteValue(THIS.nCurrentKey,m.cOption)
* Close key
THIS.CloseKey() && close key
RETURN m.nErrNum
ENDPROC
PROCEDURE Destroy
IF !THIS.lHasDllLoaded
CLEAR DLLS RegOpenKey
CLEAR DLLS RegCreateKey
CLEAR DLLS RegDeleteKey
CLEAR DLLS RegDeleteValue
CLEAR DLLS RegCloseKey
CLEAR DLLS RegSetValueEx
CLEAR DLLS RegQueryValueEx
CLEAR DLLS RegEnumKey
CLEAR DLLS RegEnumKeyEx
CLEAR DLLS RegEnumValue
ENDIF
ENDPROC
PROCEDURE enumkeys && Enumerates through a registry key.
LPARAMETERS aKeyNames
LOCAL nKeyEntry,cNewKey,cbuf,nbuflen,cRetTime, nKeySize, nErrCode
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
* Enumerates through values of a registry key
LPARAMETER aKeyValues
LOCAL lpszValue,lpcchValue,lpdwReserved
LOCAL lpdwType,lpbData,lpcbData
LOCAL nErrCode,nKeyEntry
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_EXPAND_SZ AND !THIS.lDisAllowExpanded
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
PROCEDURE enumoptions && Enumerates through all entries for a key and populates array.
* Enumerates through all entries for a key and populates array
LPARAMETER aRegOpts,cOptPath,nUserKey,lEnumKeys
LOCAL iPos,cOption,nErrNum
iPos = 0
cOption = ""
nErrNum = ERROR_SUCCESS
IF PCOUNT()<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
PROCEDURE Error
LPARAMETERS nError, cMethod, nLine
THIS.lhaderror = .T.
=MESSAGEBOX(MESSAGE())
ENDPROC
PROCEDURE getkeyvalue && Obtains a value from a registry key.
* 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 m.lpdwType # REG_SZ AND m.lpdwType # REG_EXPAND_SZ
RETURN ERROR_NONSTR_DATA
ENDIF
m.cKeyValue = LEFT(m.lpbData,m.lpcbData-1)
*!* RETURN ERROR_SUCCESS &&intoarce 0
RETURN m.cKeyValue
ENDPROC
PROCEDURE getregkey && Gets a registry key setting.
* 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,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 Init
LOCAL laTmpDLLs,lnDlls
DIMENSION laTmpDLLs[1]
THIS.nUserKey = HKEY_CURRENT_USER
THIS.cVFPOptPath = VFP_OPTIONS_KEY1 + _VFP.VERSION + VFP_OPTIONS_KEY2
DO CASE
CASE _DOS OR _UNIX OR _MAC
RETURN .F.
CASE ATC("Windows 3",OS(1)) # 0
THIS.nCurrentOS = OS_W32S
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
* Check if DLLs already loaded so we don't unload when done.
lnDlls = ADLLS(laTmpDLLs)
IF lnDlls > 0
IF ASCAN(laTmpDLLs,"RegOpenKey",-1,-1,-1,1)#0
THIS.lHasDllLoaded=.T.
ENDIF
ENDIF
ENDPROC
PROCEDURE iskey && Checks to see if a key exists.
* Checks to see if a key exists
LPARAMETER cKeyName,nRegKey
LOCAL nErrNum
* 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
ENDPROC
PROCEDURE loadregfuncs && Loads funtions needed for Registry.
* 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.
* Opens a registry key
LPARAMETER cLookUpKey,nRegKey,lCreateKey
LOCAL nSubKey,nErrCode,nPCount,lSaveCreateKey
nSubKey = 0
nPCount = PCOUNT()
IF TYPE("m.nRegKey") # "N" OR EMPTY(m.nRegKey)
m.nRegKey = HKEY_CURRENT_USER
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 setkeyvalue && Sets a key value.
* 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)
*!* 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 setregkey && Sets a registry key setting.
* This routine sets a registry key setting
* ex. THIS.SetRegKey("ResWidth","640",;
* "Software\Microsoft\VisualFoxPro\6.0\Options",;
* HKEY_CURRENT_USER)
LPARAMETER cOptName,cOptVal,cKeyPath,nUserKey,lCreateKey
LOCAL iPos,cOptKey,cOption,nErrNum
iPos = 0
cOption = ""
nErrNum = ERROR_SUCCESS
* Open registry key
m.nErrNum = THIS.OpenKey(m.cKeyPath,m.nUserKey,m.lCreateKey)
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
ENDDEFINE
Reference in New Issue View Git Blame Copy Permalink