Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Connect to SQL server
Message
De
05/11/2015 14:53:41
 
 
À
05/11/2015 13:59:17
Information générale
Forum:
Visual FoxPro
Catégorie:
Codage, syntaxe et commandes
Versions des environnements
Visual FoxPro:
VFP 9 SP2
OS:
Windows 7
Network:
Windows 2008 Server
Database:
MS SQL Server
Application:
Desktop
Divers
Thread ID:
01627022
Message ID:
01627108
Vues:
87
I use the following code to get the correct driver, I haven't had any problem with it. It checks the registry to see which driver is installed, and uses the newest.
m.loReg = Newobject([ODBCReg], [registry.prg])
Dimension m.laODBCData[1]
m.lnErrNum = loReg.GetODBCDrvrs(@laODBCData)
do case 
   case ascan(laODBCData,'ODBC Driver 11 for SQL Server',-1,-1,1,1) > 0
      lcDriver = 'ODBC Driver 11 for SQL Server'
   case ascan(laODBCData,'SQL Server Native Client 11.0',-1,-1,1,1) > 0
      lcDriver = 'SQL Server Native Client 11.0'
   case ascan(laODBCData,'SQL Server Native Client 10.0',-1,-1,1,1) > 0
      lcDriver = 'SQL Server Native Client 10.0'
   otherwise 
      lcDriver = ''
Endcase
This is registry.prg.
* 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\"

* 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\6.0\Options"
#DEFINE VFP_OPT32S_KEY		"VisualFoxPro\6.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
#DEFINE VFP_OPTIONS_KEY1	"Software\Microsoft\VisualFoxPro\"
#DEFINE VFP_OPTIONS_KEY2	"\Options"


* 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 = ""
	cRegDLLFile = ""
	cINIDLLFile = ""
	cODBCDLLFile = ""
	nCurrentOS = 0
	nCurrentKey = 0
	lLoadedDLLs = .F. 
	lLoadedINIs = .F.
	lLoadedODBCs = .F.
	cAppPathKey = ""
	lCreateKey = .F.
	lhaderror = .f.
	
	PROCEDURE Init
		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
			THIS.cRegDLLFile = DLL_ADVAPI_W32S
			THIS.cINIDLLFile = DLL_KERNEL_W32S
			THIS.cODBCDLLFile = DLL_ODBC_W32S
			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
>Driver={SQL Server Native Client 10.0};Server=SERVERNAME\SQLEXPRESS; Database=KernelData;Trusted_Connection=yes;
>Driver={SQL Server Native Client 10.0};Server=192.168.0.1\SQLEXPRESS; Database=KernelData;Uid=SQLUserName;Pwd=Password
>
>It seems you have checked all the server settings, but the problem could be on the client. You did not specify the Windows OS of the client in question, but if it is Win 7 or greater, you should be running version 11 of the driver not 10.
>
>However there are two different drivers. You are running the Native Client. I have found many machines will only run either the native client or the odbc client but not both. So we have two connection strings depending on the machine, like:
>
>connectstring = DRIVER=ODBC Driver 11 for SQL Server;SERVER=xxx.xxx.xxx.xxx;UID=XXX;PWD=XXX;APP=Microsoft Visual FoxPro;WSID=XXXX-PC;
>ConnectString = DRIVER=SQL Server Native Client 11.0;SERVER=xxx.xxx.xxx.xxx;UID=XXXX;PWD=XXXX
>
>
>
>>>>Hi all,
>>>>
>>>>I've cmoe across a weird situation that I can't get around. A customer has an SQL instance on a server and we want to start using it. Standard enough so far and I wrote a small prg that connect to the SQL server and inserts a row. On the Server it works no problem, with both windows authentication and SQL authentication in the connection string.
>>>>The problem is that on the network if I try to run this simple program it fails. The program does not make a connection to the server. I have tried opening ports on the server and the client pc but no difference. I have also tried turning off the AV but no difference. I've gotten it to the point where I can telnet to the server on port 1433 but still the connection fails. Initially the telnet was failing as well but I changed the dynamic port in the SQL configuration.
>>>>On a different client PC i installed sql server 2008 and then was able to use my program to insert into the SQL database on the server, but I can't go installing SQL on every client PC.
>>>>Server is Win server 2008R2 and SQL server 2008. There were 3 instances of SQL running, 2 have now been uninstalled as they are no longer used.
>>>>Any idea on what to try next or any tool to use? I've googled and confirmed all the regular settings are correct.
>>>>
>>>>~M
>>>
>>>What is the exact error you're getting?
>>This is the code that I run in my test program, the return value is -1. The connection strings I have tried are below. Both of these work on the server itself and also on the client machine that I installed sql server on. I have also tried a combination of both with ip addresses and they worked
>>Driver={SQL Server Native Client 10.0};Server=SERVERNAME\SQLEXPRESS; Database=KernelData;Trusted_Connection=yes;
>>Driver={SQL Server Native Client 10.0};Server=192.168.0.1\SQLEXPRESS; Database=KernelData;Uid=SQLUserName;Pwd=Password
>>
>>lnSqlHandler = SQLSTRINGCONNECT(constring)
>>
>>IF lnSqlHandler < 1
>>   MESSAGEBOX("Could not locate Sql Server Database ... Please contact Software Support_" + alltrim(str(lnSqlHandler)),48,'Kernel Software')
>>   close all
>>   RETURN
>>ELSE
>>	wait wind "SQL connection Success" time 0.2
>>ENDIF
>>~M
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform