* 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