Hi,

I have the following code that I use to create and update registry keys for our in-house applications done in Vfp6. They work fine for 95 / 98 OS but for Windows2000 they do not create the keys in the registry. Is there an update for this code that I find so useful for Windows 2000?



* 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.
*


* 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_32S "\SYSTEM\" &&used for ODBC only
#DEFINE DLLPATH_NT "\SYSTEM32\"
#DEFINE DLLPATH_WIN95 "\SYSTEM\"
suspend
* DLL files used to read INI files
#DEFINE DLL_KERNEL_W32S "W32SCOMB.DLL"
#DEFINE DLL_KERNEL_NT "KERNEL32.DLL"
#DEFINE DLL_KERNEL_WIN95 "KERNEL32.DLL"

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

* DLL files used to read ODBC info
#DEFINE DLL_ODBC_W32S "ODBC32.DLL"
#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

* Misc
#DEFINE APP_PATH_KEY "\Shell\Open\Command"
#DEFINE OLE_PATH_KEY "\Protocol\StdFileEditing\Server"
#DEFINE VFP_OPTIONS_KEY "Software\Microsoft\VisualFoxPro\5.0\Options"
#DEFINE VFP_OPT32S_KEY "VisualFoxPro\5.0\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_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"


DEFINE CLASS registry AS custom

nUserKey = HKEY_CURRENT_USER
cVFPOptPath = VFP_OPTIONS_KEY
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

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


DEFINE CLASS oldinireg AS registry

PROCEDURE GetINISection
PARAMETERS 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 GetINIEntry
LPARAMETER cValue,cSection,cEntry,cINIFile

* Get entry from INI file
LOCAL cBuffer,nBufSize,nErrNum,nTotParms
nTotParms = PARAMETERS()

* 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 WriteINIEntry
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

PROCEDURE LoadINIFuncs
* 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

ENDDEFINE

DEFINE CLASS foxreg AS registry

PROCEDURE SetFoxOption
LPARAMETER cOptName,cOptVal
RETURN THIS.SetRegKey(cOptName,cOptVal,THIS.cVFPOptPath,THIS.nUserKey)
ENDPROC

PROCEDURE GetFoxOption
LPARAMETER cOptName,cOptVal
RETURN THIS.GetRegKey(cOptName,@cOptVal,THIS.cVFPOptPath,THIS.nUserKey)
ENDPROC

PROCEDURE EnumFoxOptions
LPARAMETER aFoxOpts
RETURN THIS.EnumOptions(@aFoxOpts,THIS.cVFPOptPath,THIS.nUserKey,.F.)
ENDPROC

ENDDEFINE

DEFINE CLASS odbcreg AS registry

PROCEDURE LoadODBCFuncs
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

PROCEDURE GetODBCDrvrs
PARAMETER 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] = 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 EnumODBCDrvrs
LPARAMETER aDrvrOpts,cODBCDriver
LOCAL cSourceKey
cSourceKey = ODBC_DRVRS_KEY+m.cODBCDriver
RETURN THIS.EnumOptions(@aDrvrOpts,m.cSourceKey,HKEY_LOCAL_MACHINE,.F.)
ENDPROC

PROCEDURE EnumODBCData
LPARAMETER aDrvrOpts,cDataSource
LOCAL cSourceKey
cSourceKey = ODBC_DATA_KEY+cDataSource
RETURN THIS.EnumOptions(@aDrvrOpts,m.cSourceKey,HKEY_CURRENT_USER,.F.)
ENDPROC

ENDDEFINE

DEFINE CLASS filereg AS registry

PROCEDURE GetAppPath
* 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
* Checks and returns path of application
* associated with a particular extension (e.g., XLS, DOC).
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

PROCEDURE GetApplication
PARAMETER 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

ENDDEFINE