Sorry, la clase TDNS es de Yamil Bracho. te la paso
Code: Select all
#include "FiveWin.ch"
#include "TDSN.CH"
#define HKEY_CURRENT_USER 2147483649 // 0x80000001
#define HKEY_LOCAL_MACHINE 2147483650 // 0x80000002
#define HKEY_USERS 2147483651 // 0x80000003
#define conODBC "SOFTWARE\ODBC\ODBC.INI"
#define conODBC_DSN "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources"
#define conODBC_DRIVER "SOFTWARE\ODBC\ODBCINST.INI"
#ifdef __XPP__
#define Super ::TControl
#define New _New
#endif
CLASS TDSN
DATA cDsn // Nombre del DSN
DATA cDescription // Descripcion del DSN
DATA cDataBase // Database. Puede ser :
// SQL Server
// Oracle73
// MySQL
// ....
DATA cServer // Servidor o Direccion IP
DATA cUser // UserId
DATA cPassword // Password
DATA nPort // Port
DATA cDriver // Driver ODBC
DATA nStatus // Codigo de Error
DATA nDsnType // Tipo de DSN a crear
// TDSN_SYSTEM_DSN = System DSN (Default ) 0
// TDSN_USER_DSN = User DSN 1
METHOD ClassName() INLINE "TDSN"
METHOD New( cDSN ) CONSTRUCTOR
METHOD Create( cDSN, cDescription, cDataBase, cServer ,;
cUser, nDsnType, cDriver, nPort, cPassword ) CONSTRUCTOR
METHOD Seek( cDSN )
METHOD Get( cDSN, nDsnType )
METHOD Del( cDSN )
METHOD Update( cDSN )
METHOD End( cDSN )
METHOD cGenPRG()
METHOD Close() INLINE Self:End()
ENDCLASS
//----------------------------------------------------------
// Apertura DSN
//----------------------------------------------------------
METHOD New( cDSN ) CLASS TDSN
RETURN Self:Get( cDSN )
//----------------------------------------------------------
// Crea DSN
//----------------------------------------------------------
// Create( <(cDSN)>, <(cDesc)>, <(cDb)>, <(cServer)>,
// <(cUser)> ,<(cDriver)>, <nPort>,<(cPassword)> )
METHOD Create( cDSN, cDescription, cDataBase, cServer ,;
cUser, nDsnType, cDriver, nPort, cPassword ) CLASS TDSN
LOCAL oReg
LOCAL cKey
LOCAL cSubKey
DEFAULT nDsnType := TDSN_SYSTEM_DSN
DEFAULT cDriver := ""
DEFAULT nPort := 0
DEFAULT cPassword:= ""
Self:cDSN := cDSN
Self:cDescription := cDescription
Self:cDataBase := cDataBase
Self:cServer := cServer
Self:cUser := cUser
Self:nPort := nPort
Self:nDsnType := nDsnType
Self:cDriver := cDriver
Self:cPassword := cPassword
Self:nStatus := TDSN_NO_ERROR
IF Self:Seek( cDSN, nDsnType ) == .F.
//------------------------------------------------------
// Busca Driver ODBC
//------------------------------------------------------
// cDriver := GetDriver( Self:cDataBase )
//-----------------------------------------------------
// No se consiguio el driver asociada a la base de
// datos. Se asume que el driver a utilizar debe estar
// instalado y no se le presta atencion al especificado
// con el constructor ( si se especifico )
//-----------------------------------------------------
IF cDriver == "?"
Self:cDriver := ""
Self:nStatus := TDSN_DRIVER_NOT_FOUND
ELSE
//---------------------------------------------------
// Chequeamos si el driver encontrado es el mismo que
// se paso al constructor. Si no lo es, se asume que
// el correcto fue el que se consiguio en el Registry
//---------------------------------------------------
//Self:cDriver := cDriver
//----------------------------------------------------
// Registras detalle del DSN
//----------------------------------------------------
cKey := conODBC + "\" + Self:cDSN
IF Self:nDsnType == TDSN_USER_DSN
oReg := TReg32():Create( HKEY_CURRENT_USER, cKey )
ELSE
oReg := TReg32():Create( HKEY_LOCAL_MACHINE, cKey )
ENDIF
oReg:Set( "Database", Self:cDataBase )
oReg:Set( "Description", Self:cDescription )
oReg:Set( "Driver", Self:cDriver )
//------------------------------------------------
// No hay un estandard en la clave de "User" asi
// que creamos dos claves para cubrir todas las
// posibilidades. Por ejemplo con SQL Server debe
// ser "LastUser", mientras que con Oracle y MySQL
// es "User"
//------------------------------------------------
oReg:Set( "LastUser", Self:cUser )
oReg:Set( "User", Self:cUser )
oReg:set( "Password", Self:cPassword)
oReg:Set( "Server", Self:cServer )
oReg:Set( "Option", alltrim(str(131073)))
oReg:Set( "Stmt","")
//----------------------------------------------------
// Igual que User, algunas base de datos usan este
// parametro
//----------------------------------------------------
oReg:Set( "Port", Ltrim( Str( Self:nPort )))
oReg:Close()
//----------------------------------------------------
// Registra DSN en ODBC Data Sources
//----------------------------------------------------
cKey := conODBC_DSN
IF Self:nDsnType == TDSN_USER_DSN
oReg := TReg32():Create( HKEY_CURRENT_USER, cKey )
ELSE
oReg := TReg32():Create( HKEY_LOCAL_MACHINE, cKey )
ENDIF
oReg:Set( Self:cDsn, "MySQL ODBC 3.51 Driver" )
oReg:Close()
Self:nStatus := TDSN_NO_ERROR
ENDIF
ELSE
Self:nStatus := TDSN_ALREADY_EXISTS
ENDIF
RETURN Self
//----------------------------------------------------------
// Chequea si el DSN dado existe
//----------------------------------------------------------
METHOD Seek( cDSN, nDsnType ) CLASS TDSN
LOCAL aDSN
LOCAL cTemp
LOCAL lExist
LOCAL nPos
DEFAULT cDSN := Self:cDSN
DEFAULT nDsnType := Self:nDsnType
aDSN := Odbc32DsnEntries( Self:nDsnType )
cTemp := Upper( cDSN )
lExist := .T.
Self:nStatus := TDSN_NO_ERROR
nPos := aScan( aDsn, { | x | Upper( x ) == cTemp })
IF nPos == 0
lExist := .F.
Self:nStatus := TDSN_NOT_FOUND
ENDIF
RETURN lExist
//----------------------------------------------------------
// Toma datos del DSN
//----------------------------------------------------------
METHOD Get( cDSN, nDsnType ) CLASS TDSN
LOCAL oReg
LOCAL oReg2
LOCAL cDriver
LOCAL cKey
DEFAULT cDSN := Self:cDSN
DEFAULT nDsnType :=0
Self:cDSn := cDSN
Self:nDsnType := nDsnType
Self:nStatus := TDSN_NOT_FOUND
//--------------------------------------------------------
// Busca si se ha creado el DSN
//--------------------------------------------------------
IF Self:Seek( cDSN, nDsnType ) == .T.
//------------------------------------------------------
// Busca informacion del DSN
//------------------------------------------------------
cKey := conODBC + "\" + Self:cDSN
IF Self:nDsnType == TDSN_USER_DSN
oReg := TReg32():New( HKEY_CURRENT_USER, cKey )
oReg2 := TReg32():New( HKEY_CURRENT_USER ,;
conODBC_DSN )
ELSE
oReg := TReg32():New( HKEY_LOCAL_MACHINE, cKey )
oReg2 := TReg32():New( HKEY_LOCAL_MACHINE ,;
conODBC_DSN )
ENDIF
Self:cDescription := oReg:Get( "Description", "" )
Self:cDataBase := oReg2:Get( Self:cDSN, "" )
Self:cServer := oReg:Get( "Server", "" )
Self:nPort := Val( oReg:Get( "Port","0" ))
Self:cDriver := oReg:Get( "Driver", "")
Self:cUser := oReg:Get( "LastUser", "" )
IF Len( Self:cUser ) == 0
Self:cUser := oReg:Get( "User", "" )
ENDIF
oReg:Close()
oReg2:Close()
Self:nStatus := TDSN_NO_ERROR
ENDIF
RETURN Self
//----------------------------------------------------------
// Elimina DSN
//----------------------------------------------------------
METHOD Del( cDSN ) CLASS TDSN
LOCAL nRet
LOCAL nHandle
DEFAULT cDSN := Self:cDSN
Self:nStatus := TDSN_NOT_FOUND
//--------------------------------------------------------
// Busca si se ha creado el DSN
//--------------------------------------------------------
IF Self:Seek( cDSN )
IF Self:nDsnType == TDSN_USER_DSN
//----------------------------------------------------
// Elimina todos los componentes del DSN
//----------------------------------------------------
nRet := RegDeleteKey( HKEY_CURRENT_USER ,;
conODBC + "\" + Self:cDSN )
//----------------------------------------------------
// Elimina de ODBC Data Sources
//----------------------------------------------------
nRet := RegOpenKey( HKEY_CURRENT_USER ,;
conODBC_DSN, @nHandle )
IF nRet == 0
nRet:= RegDeleteValueA( nHandle, Self:cDSN )
ENDIF
ELSE
//----------------------------------------------------
// Elimina todos los componentes del DSN
//----------------------------------------------------
nRet := RegDeleteKey( HKEY_LOCAL_MACHINE ,;
conODBC + "\" + Self:cDSN )
//----------------------------------------------------
// Elimina de ODBC Data Sources
//----------------------------------------------------
nRet := RegOpenKey( HKEY_LOCAL_MACHINE ,;
conODBC_DSN, @nHandle )
IF nRet == 0
nRet:= RegDeleteValueA( nHandle, Self:cDSN )
ENDIF
ENDIF
IF nRet != 0
Self:nStatus := TDSN_DELETE_ERROR
ELSE
Self:nStatus := TDSN_NO_ERROR
ENDIF
ENDIF
RETURN NIL
//----------------------------------------------------------
// Actualiza DSN
//----------------------------------------------------------
METHOD Update( cDSN ) CLASS TDSN
LOCAL oReg
LOCAL cDriver
LOCAL cKey
DEFAULT cDSN := Self:cDSN
Self:nStatus := TDSN_NOT_FOUND
//--------------------------------------------------------
// Busca si se ha creado el DSN
//--------------------------------------------------------
IF Self:Seek( cDSN )
//------------------------------------------------------
// Busca Driver ODBC
//------------------------------------------------------
cDriver := GetDriver( Self:cDataBase )
//-----------------------------------------------------
// No se consiguio el driver asociada a la base de
// datos. Se asume que el driver a utilizar debe estar
// instalado y no se le presta atencion al especificado
// con el constructor ( si se especifico )
//-----------------------------------------------------
IF cDriver == "?"
Self:cDriver:= ""
Self:nStatus := TDSN_DRIVER_NOT_FOUND
ELSE
//---------------------------------------------------
// Chequeamos si el driver encontrado es el mismo que
// se paso al constructor. Si no lo es, se asume que
// el correcto fue el que se consiguio en el Registry
//---------------------------------------------------
Self:cDriver := cDriver
//----------------------------------------------------
// Registras detalle del DSN
//----------------------------------------------------
cKey := conODBC + "\" + Self:cDSN
IF Self:nDsnType == TDSN_USER_DSN
oReg := TReg32():New( HKEY_CURRENT_USER, cKey )
ELSE
oReg := TReg32():New( HKEY_LOCAL_MACHINE, cKey )
ENDIF
oReg:Set( "Database", Self:cDataBase )
oReg:Set( "Description", Self:cDescription )
oReg:Set( "Driver", Self:cDriver )
//------------------------------------------------
// No hay un estandard en la clave de "User" asi
// que creamos dos claves para cubrir todas las
// posibilidades. Por ejemplo con SQL Server debe
// ser "LastUser", mientras que con Oracle y MySQL
// es "User"
//------------------------------------------------
oReg:Set( "LastUser", Self:cUser )
oReg:Set( "User", Self:cUser )
oReg:Set( "Server", Self:cServer )
//----------------------------------------------------
// Igual que User, algunas base de datos usan este
// parametro
//----------------------------------------------------
oReg:Set( "Port", Ltrim( Str( Self:nPort )))
oReg:Close()
//----------------------------------------------------
// Registra DSN en ODBC Data Sources
//----------------------------------------------------
cKey := conODBC_DSN
IF Self:nDsnType == TDSN_USER_DSN
oReg := TReg32():New( HKEY_CURRENT_USER, cKey )
ELSE
oReg := TReg32():New( HKEY_LOCAL_MACHINE, cKey )
ENDIF
oReg:Set( Self:cDsn, Self:cDataBase )
oReg:Close()
Self:nStatus := TDSN_NO_ERROR
ENDIF
ENDIF
RETURN NIL
//----------------------------------------------------------
// No se hace nada, simplemente se "limpia" el status de
// error.
//----------------------------------------------------------
METHOD End( cDSN ) CLASS TDSN
Self:nStatus := TDSN_NO_ERROR
RETURN NIL
//----------------------------------------------------------
// Genera codigo para crear el DSN. En este caso solo se
// implementa el metodo Create()
//----------------------------------------------------------
METHOD cGenPRG() CLASS TDSN
LOCAL cPrg := ""
cPrg := "oDSN := TDSN():Create(" + ;
Chr( 39 ) + Self:cDSN + Chr( 39 ) + "," + ;
Chr( 39 ) + Self:cDescription + Chr( 39 ) + "," + ;
Chr( 39 ) + Self:cDataBase + Chr( 39 ) + "," + ;
Chr( 39 ) + Self:cServer + Chr( 39 ) + "," + ;
Chr( 39 ) + Self:cUser + Chr( 39 ) + "," + ;
Ltrim( Str( Self:nDsnType )) + "," + ;
Chr( 39 ) + Self:cDriver + Chr( 39 ) + "," + ;
Ltrim( Str( Self:nPort )) + " )"
RETURN cPrg
//----------------------------------------------------------
// Busca Driver ODBC
//----------------------------------------------------------
STATIC FUNCTION GetDriver( cDataBase )
LOCAL oReg
LOCAL cDriver
oReg := TReg32():New( HKEY_LOCAL_MACHINE ,;
conODBC_DRIVER + "\" + cDataBase )
cDriver := oReg:Get( "Driver", "?" )
oReg:Close()
RETURN cDriver
//----------------------------------------------------------
// Esta funcion reemplaza la original de FiveWin
// OdbcDsnEntries() ya que esta solo busca en el INI y no
// en el registry.
//
// Se le envia el siguiente parametro:
//
// nDsnType - TDSN_SYSTEM_DSN System DSN (Default )
// TDSN_USER_DSN User DSN
//----------------------------------------------------------
FUNCTION Odbc32DsnEntries( nDsnType )
LOCAL acRetVal := {}
LOCAL cValue
LOCAL n
LOCAL nRet
LOCAL nHandle
DEFAULT nDsnType := TDSN_SYSTEM_DSN
IF nDsnType == TDSN_USER_DSN
nRet := RegOpenKey( HKEY_CURRENT_USER ,;
conODBC, @nHandle )
ELSE
nRet := RegOpenKey( HKEY_LOCAL_MACHINE ,;
conODBC, @nHandle )
ENDIF
IF nRet == 0
n := 0
DO WHILE RegEnumKey( nHandle, n++, @cValue ) == 0
IF Left( cValue, 5 ) <> "ODBC "
aAdd( acRetVal, cValue )
ENDIF
ENDDO
ENDIF
RETURN acRetVal
//----------------------------------------------------------
// Funcion del Win32API para eliminar un Item de una clave
//----------------------------------------------------------
DLL32 STATIC FUNCTION RegDeleteValueA( nhKey AS LONG ,;
cValueName AS LPSTR ) ;
AS LONG PASCAL LIB "ADVAPI32.DLL"