TMySQL - MySQL and MariaDB connection
-
- Site Admin
- Mensajes: 315
- Registered for: 3 years 6 months
Charly muy interesante. Hay que echarle un vistazo detenidamente al tema
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
-
- Mensajes: 127
- Registered for: 3 years 6 months
This is the current WDO code, That I used, included the code from Ricardo
Best Regards
Best Regards
Código: Seleccionar todo
/* ---------------------------------------------------------
File.......: rdbms_mysql.prg
Description: Conexión a Bases de Datos MySql
Author.....: Carles Aubia Floresvi
Date:......: 26/07/2019
Update.....: 16/02/2021
Modificaciones de Osvaldo basado en codigo de ricardo
Practicamente la moficiacion fue para query2
--------------------------------------------------------- */
#include "hbdyn.ch"
#define VERSION_RDBMS_MYSQL '0.1d'
#define HB_VERSION_BITWIDTH 17
#define NULL 0
CLASS RDBMS_MySql FROM RDBMS
DATA pLib
DATA hMySql
DATA hConnection
DATA lConnect INIT .F.
DATA cError INIT ''
DATA aFields INIT {}
DATA aLog INIT {}
DATA bError INIT {|cError| AP_RPuts( '<br>' + cError ) }
METHOD New() CONSTRUCTOR
METHOD Query( cSql )
METHOD Count( hRes ) INLINE ::mysql_num_rows( hRes )
METHOD FCount( hRes ) INLINE ::mysql_num_fields( hRes )
METHOD LoadStruct()
METHOD DbStruct() INLINE ::aFields
METHOD Fetch( hRes )
METHOD Fetch_Assoc( hRes )
METHOD FetchAll( hRes, lAssociative )
METHOD Free_Result( hRes ) INLINE ::mysql_free_result( hRes )
// Wrapper ( Ricardo)
METHOD Query2( cSql , aParam )
// Wrappers (Antonio Linares)
METHOD mysql_init()
METHOD mysql_get_server_info()
METHOD mysql_real_connect( cServer, cUserName, cPassword, cDataBaseName, nPort )
METHOD mysql_error()
METHOD mysql_query( cQuery )
METHOD mysql_real_query( cQuery ) // agradado
METHOD mysql_store_result()
METHOD mysql_num_rows( hRes )
METHOD mysql_num_fields( hRes )
METHOD mysql_fetch_field( hRes )
METHOD mysql_fetch_row( hRes )
METHOD mysql_free_result( hRes )
METHOD mysql_real_escape_string_quote( cQuery) // agregado
METHOD Version() INLINE VERSION_RDBMS_MYSQL
DESTRUCTOR Exit()
ENDCLASS
METHOD New( cServer, cUsername, cPassword, cDatabase, nPort, cType ) CLASS RDBMS_MySql
hb_default( @cServer, '' )
hb_default( @cUserName, '' )
hb_default( @cPassword, '' )
hb_default( @cDatabase, '' )
hb_default( @nPort, 3306 )
hb_default( @cType, 'MYSQL' )
::cServer := cServer
::cUserName := cUserName
::cPassword := cPassword
::cDatabase := cDatabase
::nPort := nPort
// Cargamos lib mysql
IF cType == 'MYSQL'
::pLib := hb_LibLoad( hb_SysMySQL() )
ELSE
::pLib := hb_LibLoad( hb_SysMariaDb() )
ENDIF
If ValType( ::pLib ) <> "P"
::cError := "Error (MySQL library not found)"
IF Valtype( ::bError ) == 'B'
Eval( ::bError, ::cError )
ENDIF
RETU Self
ENDIF
// Inicializamos mysql
::hMySQL = ::mysql_init()
IF ::hMySQL = 0
::cError := "hMySQL = " + Str( ::hMySQL ) + " (MySQL library failed to initialize)"
IF Valtype( ::bError ) == 'B'
Eval( ::bError, ::cError )
ENDIF
RETU Self
ENDIF
// Server Info
// "MySQL version: " + ::mysql_get_server_info()
// Conexion a Base de datos
::hConnection := ::mysql_real_connect( ::cServer, ::cUserName, ::cPassword, ::cDatabase, ::nPort )
IF ::hConnection != ::hMySQL
::cError := "Connection = (Failed connection) " + ::mysql_error()
IF Valtype( ::bError ) == 'B'
Eval( ::bError, ::cError )
ENDIF
RETU Self
ENDIF
::lConnect := .T.
RETU SELF
METHOD Query( cQuery ) CLASS RDBMS_MySql
LOCAL nRetVal
LOCAL hRes := 0
IF ::hConnection == 0
RETU NIL
ENDIF
nRetVal := ::mysql_query( cQuery )
IF nRetVal == 0
hRes = ::mysql_store_result()
IF hRes != 0 // Si Update/Delete hRes == 0
::LoadStruct( hRes )
ENDIF
ELSE
::cError := 'Error: ' + ::mysql_error()
IF Valtype( ::bError ) == 'B'
Eval( ::bError, ::cError )
ENDIF
ENDIF
RETU hRes
METHOD Query2(cSQL, aParam) CLASS RDBMS_MySql
LOCAL nRetVal
LOCAL hRes := 0
local nCount
hb_default( @aParam, {} )
IF ::hConnection == 0
RETU NIL
ENDIF
IF .NOT. Empty(aParam)
FOR nCount:=1 TO Len(aParam)
::mysql_real_escape_string_quote(@aParam[nCount])
cSQL:=StrTran(cSQL,"PARAM"+StrZero(nCount,2),IF(Type(aParam[nCount]) # "C",IF(Type(aParam[nCount]) = "D", ;
Dtoc(aParam[nCount]),hb_ValToStr(aParam[nCount])),aParam[nCount]))
NEXT nCount
ENDIF
nRetVal := ::mysql_real_query( cSQL )
IF nRetVal == 0
hRes = ::mysql_store_result()
IF hRes != 0 // Si Update/Delete hRes == 0
::LoadStruct( hRes )
ENDIF
ELSE
::cError := 'Error: ' + ::mysql_error()
IF Valtype( ::bError ) == 'B'
Eval( ::bError, ::cError )
ENDIF
ENDIF
RETU hRes
METHOD LoadStruct( hRes ) CLASS RDBMS_MySql
LOCAL n, hField
::aFields = Array( ::FCount( hRes ) )
FOR n = 1 to Len( ::aFields )
hField := ::mysql_fetch_field( hRes )
if hField != 0
::aFields[ n ] = Array( 4 )
::aFields[ n ][ 1 ] = PtrToStr( hField, 0 )
do case
case AScan( { 253, 254, 12 }, PtrToUI( hField, hb_SysMyTypePos() ) ) != 0
::aFields[ n ][ 2 ] = "C"
case AScan( { 1, 3, 4, 5, 8, 9, 246 }, PtrToUI( hField, hb_SysMyTypePos() ) ) != 0
::aFields[ n ][ 2 ] = "N"
case AScan( { 10 }, PtrToUI( hField, hb_SysMyTypePos() ) ) != 0
::aFields[ n ][ 2 ] = "D"
case AScan( { 250, 252 }, PtrToUI( hField, hb_SysMyTypePos() ) ) != 0
::aFields[ n ][ 2 ] = "M"
endcase
endif
NEXT
RETU NIL
METHOD Fetch( hRes ) CLASS RDBMS_MySql
LOCAL hRow
LOCAL aReg
LOCAL m
if ( hRow := ::mysql_fetch_row( hRes ) ) != 0
aReg := array( ::FCount( hRes ) )
for m = 1 to ::FCount( hRes )
aReg[ m ] := PtrToStr( hRow, m - 1 )
next
endif
//::mysql_free_result( hRes )
RETU aReg
METHOD Fetch_Assoc( hRes ) CLASS RDBMS_MySql
LOCAL hRow
LOCAL hReg := {=>}
LOCAL m
if ( hRow := ::mysql_fetch_row( hRes ) ) != 0
for m = 1 to ::FCount( hRes )
hReg[ ::aFields[m][1] ] := PtrToStr( hRow, m - 1 )
next
endif
//::mysql_free_result( hRes )
RETU hReg
METHOD FetchAll( hRes, lAssociative ) CLASS RDBMS_MySql
LOCAL oRs
LOCAL aData := {}
__defaultNIL( @lAssociative, .f. )
IF lAssociative
WHILE ( !empty( oRs := ::Fetch_Assoc( hRes ) ) )
Aadd( aData, oRs )
END
ELSE
WHILE ( !empty( oRs := ::Fetch( hRes ) ) )
Aadd( aData, oRs )
END
ENDIF
RETU aData
// Wrappers...
METHOD mysql_num_rows( hRes ) CLASS RDBMS_MySql
return hb_DynCall( { "mysql_num_rows", ::pLib, hb_bitOr( hb_SysLong(),;
hb_SysCallConv() ), hb_SysLong() }, hRes )
METHOD mysql_Init() CLASS RDBMS_MySql
RETU hb_DynCall( { "mysql_init", ::pLib, hb_bitOr( hb_SysLong(),;
hb_SysCallConv() ) }, NULL )
METHOD mysql_get_server_info() CLASS RDBMS_MySql
RETU hb_DynCall( { "mysql_get_server_info", ::pLib, hb_bitOr( HB_DYN_CTYPE_CHAR_PTR,;
hb_SysCallConv() ), hb_SysLong() }, ::hMySql )
METHOD mysql_real_connect( cServer, cUserName, cPassword, cDataBaseName, nPort ) CLASS RDBMS_MySql
if nPort == nil
nPort = 3306
endif
RETU hb_DynCall( { "mysql_real_connect", ::pLib, hb_bitOr( hb_SysLong(),;
hb_SysCallConv() ), hb_SysLong(),;
HB_DYN_CTYPE_CHAR_PTR, HB_DYN_CTYPE_CHAR_PTR, HB_DYN_CTYPE_CHAR_PTR, HB_DYN_CTYPE_CHAR_PTR,;
HB_DYN_CTYPE_LONG, HB_DYN_CTYPE_LONG, HB_DYN_CTYPE_LONG },;
::hMySQL, cServer, cUserName, cPassword, cDataBaseName, nPort, 0, 0 )
METHOD mysql_error() CLASS RDBMS_MySql
RETU hb_DynCall( { "mysql_error", ::pLib, hb_bitOr( HB_DYN_CTYPE_CHAR_PTR,;
hb_SysCallConv() ), hb_SysLong() }, ::hMySql )
METHOD mysql_query( cQuery ) CLASS RDBMS_MySql
RETU hb_DynCall( { "mysql_query", ::pLib, hb_bitOr( HB_DYN_CTYPE_INT,;
hb_SysCallConv() ), hb_SysLong(), HB_DYN_CTYPE_CHAR_PTR },;
::hConnection, cQuery )
METHOD mysql_store_result() CLASS RDBMS_MySql
RETU hb_DynCall( { "mysql_store_result", ::pLib, hb_bitOr( hb_SysLong(),;
hb_SysCallConv() ), hb_SysLong() }, ::hMySQL )
METHOD mysql_num_fields( hRes ) CLASS RDBMS_MySql
RETU hb_DynCall( { "mysql_num_fields", ::pLib, hb_bitOr( HB_DYN_CTYPE_LONG_UNSIGNED,;
hb_SysCallConv() ), hb_SysLong() }, hRes )
METHOD mysql_fetch_field( hRes ) CLASS RDBMS_MySql
RETU hb_DynCall( { "mysql_fetch_field", ::pLib, hb_bitOr( hb_SysLong(),;
hb_SysCallConv() ), hb_SysLong() }, hRes )
METHOD mysql_fetch_row( hRes ) CLASS RDBMS_MySql
RETU hb_DynCall( { "mysql_fetch_row", ::pLib, hb_bitOr( hb_SysLong(),;
hb_SysCallConv() ), hb_SysLong() }, hRes )
METHOD mysql_free_result( hRes ) CLASS RDBMS_MySql
RETU hb_DynCall( { "mysql_free_result", ::pLib,;
hb_SysCallConv(), hb_SysLong() }, hRes )
METHOD mysql_real_query( cQuery ) CLASS RDBMS_MySql
RETU hb_DynCall( { "mysql_real_query", ::pLib, ;
hb_bitOr( HB_DYN_CTYPE_INT, hb_SysCallConv() ), ;
hb_SysLong(), HB_DYN_CTYPE_CHAR_PTR , HB_DYN_CTYPE_LONG},;
::hConnection, cQuery ,len(cQuery))
//-----------------------------------------------------------------//
METHOD mysql_real_escape_string_quote( cQuery) CLASS RDBMS_MySql
return hb_DynCall( { "mysql_real_escape_string", ::pLib, hb_bitOr( hb_SysLong(),;
hb_SysCallConv() ), hb_SysLong(), HB_DYN_CTYPE_CHAR_PTR, HB_DYN_CTYPE_CHAR_PTR, HB_DYN_CTYPE_LONG, HB_DYN_CTYPE_CHAR_PTR },;
::hConnection, @cQuery, cQuery, Len(cQuery), "\'")
METHOD Exit() CLASS RDBMS_MySql
IF ValType( ::pLib ) == "P"
//? "MySQL library properly freed: ", HB_LibFree( ::pLib )
ENDIF
RETU NIL
// ------------------------------------------------------------
function hb_SysLong()
return If( hb_OSIS64BIT(), HB_DYN_CTYPE_LLONG_UNSIGNED, HB_DYN_CTYPE_LONG_UNSIGNED )
//----------------------------------------------------------------//
function hb_SysCallConv()
return If( ! "Windows" $ OS(), HB_DYN_CALLCONV_CDECL, HB_DYN_CALLCONV_STDCALL )
//----------------------------------------------------------------//
function hb_SysMyTypePos()
return If( hb_version( HB_VERSION_BITWIDTH ) == 64,;
If( "Windows" $ OS(), 26, 28 ), 19 )
//----------------------------------------------------------------//
function hb_SysMySQL()
local cLibName
if ! "Windows" $ OS()
if "Darwin" $ OS()
cLibName = "/usr/local/Cellar/mysql/8.0.16/lib/libmysqlclient.dylib"
else
cLibName = If( hb_version( HB_VERSION_BITWIDTH ) == 64,;
"/usr/lib/x86_64-linux-gnu/libmysqlclient.so",; // libmysqlclient.so.20 for mariaDB
"/usr/lib/x86-linux-gnu/libmysqlclient.so" )
endif
else
IF hb_version( HB_VERSION_BITWIDTH ) == 64
IF !Empty( HB_GetEnv( 'WDO_PATH_MYSQL' ) )
cLibName = HB_GetEnv( 'WDO_PATH_MYSQL' ) + 'libmysql64.dll'
ELSE
cLibName = "c:/Apache24/htdocs/libmysql64.dll"
ENDIF
ELSE
IF !Empty( HB_GetEnv( 'WDO_PATH_MYSQL' ) )
cLibName = HB_GetEnv( 'WDO_PATH_MYSQL' ) + 'libmysql.dll'
ELSE
cLibName = "c:/Apache24/htdocs/libmysql.dll"
ENDIF
ENDIF
endif
return cLibName
//----------------------------------------------------------------//
function hb_SysMariaDb()
local cLibName
if ! "Windows" $ OS()
if "Darwin" $ OS()
cLibName = "/usr/local/Cellar/mysql/8.0.16/lib/libmysqlclient.dylib"
else
cLibName = If( hb_version( HB_VERSION_BITWIDTH ) == 64,;
"/usr/lib/x86_64-linux-gnu/libmariadbclient.so",; // libmysqlclient.so.20 for mariaDB
"/usr/lib/x86-linux-gnu/libmariadbclient.so" )
endif
else
IF hb_version( HB_VERSION_BITWIDTH ) == 64
IF !Empty( HB_GetEnv( 'WDO_PATH_MYSQL' ) )
cLibName = HB_GetEnv( 'WDO_PATH_MYSQL' ) + 'libmysql64.dll'
ELSE
cLibName = "c:/Apache24/htdocs/libmysql64.dll"
ENDIF
ELSE
IF !Empty( HB_GetEnv( 'WDO_PATH_MYSQL' ) )
cLibName = HB_GetEnv( 'WDO_PATH_MYSQL' ) + 'libmysql.dll'
ELSE
cLibName = "c:/Apache24/htdocs/libmysql.dll"
ENDIF
ENDIF
endif
return cLibName
- charly
- Mensajes: 145
- Registered for: 3 years 6 months
Osvaldo,
Muy bien, gracias. Podrias crear un ejemplo como los de la libreria wdo ( un sqlxx.prg ) mostrando el uso de la novedad ?
Lo testeamos y lo subimos![Very Happy :D](./images/smilies/icon_e_biggrin.gif)
Muy bien, gracias. Podrias crear un ejemplo como los de la libreria wdo ( un sqlxx.prg ) mostrando el uso de la novedad ?
Lo testeamos y lo subimos
![Very Happy :D](./images/smilies/icon_e_biggrin.gif)
Salutacions, saludos, regards.
Charly
"...programar es fácil, hacer programas es difícil..."
https://httpd2.blogspot.com/
https://forum.modharbour.app
Charly
"...programar es fácil, hacer programas es difícil..."
https://httpd2.blogspot.com/
https://forum.modharbour.app
- ricardo arraes
- Mensajes: 87
- Registered for: 3 years 6 months
UPDATE:
New method QueryJson()
Instead of retrieving an MySQLTable object, now TMySQL can retrieve a JSON object with the results of a query.
HOW TO USE IT:
MYSQL
MariaDB
New method QueryJson()
Instead of retrieving an MySQLTable object, now TMySQL can retrieve a JSON object with the results of a query.
Código: Seleccionar todo
METHOD QueryJson(cSQL, aParam)
LOCAL oTable,nCount
if ! Empty( ::pLib )
::hMySQL = mysql_init(::pLib)
if ::hMySQL != 0
::hConnection = mysql_real_connect( ::pLib,::cHost, ::cUser,IF(::cPsw # NIL,::cPsw, AP_GETENV( 'PASSWORD' )), ::cSchema, ::nPort, ::hMySQL )
if ::hConnection != ::hMySQL
nArq := FCreate("c:\xampp\htdocs\MySql.log")
FWrite( nArq, "Q01-Error on connection to server " + ::cHost )
FClose( nArq )
//? "Error on connection to server " + ::cHost,::cSchema,::cUser,::hConnection , ::hMySQL, ::cLibName, mysql_error(::pLib,::hMySQL)
RETURN NIL
endif
endif
IF .NOT. Empty(aParam)
FOR nCount:=1 TO Len(aParam)
wparam:=NIL
wparam:=IF(ValType(aParam[nCount]) # "C",IF(ValType(aParam[nCount]) = "D", Dtoc(aParam[nCount]),hb_ValToStr(aParam[nCount])),aParam[nCount])
mysql_real_escape_string_quote(::pLib,::hConnection,@aParam[nCount])
cSQL:=StrTran(cSQL,"PARAM"+StrZero(nCount,2),wparam)
NEXT nCount
ENDIF
::nRetVal := mysql_real_query( ::pLib, ::hConnection, cSQL )
if ::nRetVal != 0
oTable:=NIL
else
oTable = MySqlTable():New(Self,,.T.)
endif
if mysql_error( ::hMySQL ) # NIL
nArq := FCreate("c:\xampp\htdocs\MySql.log")
FWrite( nArq, mysql_error( ::hMySQL )+"///"+cSQL )
FClose( nArq )
endif
mysql_close(::pLib,::hConnection)
else
nArq := FCreate("c:\xampp\htdocs\MySql.log")
FWrite( nArq, "Q02-"+::cLibName + " not available" )
FClose( nArq )
RETURN NIL
endif
RETURN oTable
METHOD New( oOrm, hJson, lJson ) CLASS MySQLTable
local n, m, hField, hRow, aFldCnv, aRowCnv, hRetJson:={=>}, aJson:={}
::Super:New( oOrm)
IF hJson = NIL
::hMyRes = mysql_store_result( oOrm:pLib, oOrm:hConnection )
if ::hMyRes == 0
? "mysql_store_results() failed"
else
IF lJson # NIL .AND. lJson
aFldCnv := Array( mysql_num_fields( oOrm:pLib, ::hMyRes ) )
aRowCnv := Array( mysql_num_rows( oOrm:pLib, ::hMyRes ), Len( aFldCnv ) )
for n = 1 to Len( aRowCnv )
if ( hRow := mysql_fetch_row( oOrm:pLib, ::hMyRes ) ) != 0
hRetJson:={=>}
for m = 1 to Len( aFldCnv )
hField = mysql_fetch_field( oOrm:pLib, ::hMyRes )
IF hField != 0
aFldCnv[ m ] = Array( 4 )
aFldCnv[ m ][ 1 ] := PtrToStr( hField, 0 )
hRetJson[PtrToStr( hField, 0 )]:=PtrToStr( hRow, m - 1 )
ELSE
hRetJson[aFldCnv[m,1]]:=PtrToStr( hRow, m - 1 )
ENDIF
next m
AAdd(aJson,hRetJson)
endif
next n
return aJson
ELSE
::aFields = Array( mysql_num_fields( oOrm:pLib, ::hMyRes ) )
for n = 1 to Len( ::aFields )
hField = mysql_fetch_field( oOrm:pLib, ::hMyRes )
if hField != 0
::aFields[ n ] = Array( 4 )
::aFields[ n ][ 1 ] = PtrToStr( hField, 0 )
do case
case AScan( { 253, 254, 12 }, PtrToUI( hField, hb_SysMyTypePos() ) ) != 0
::aFields[ n ][ 2 ] = "C"
case AScan( { 1, 3, 4, 5, 8, 9, 246 }, PtrToUI( hField, hb_SysMyTypePos() ) ) != 0
::aFields[ n ][ 2 ] = "N"
case AScan( { 10 }, PtrToUI( hField, hb_SysMyTypePos() ) ) != 0
::aFields[ n ][ 2 ] = "D"
case AScan( { 250, 252 }, PtrToUI( hField, hb_SysMyTypePos() ) ) != 0
::aFields[ n ][ 2 ] = "M"
endcase
endif
next
::aRows = Array( mysql_num_rows( oOrm:pLib, ::hMyRes ), ::FCount() )
for n = 1 to Len( ::aRows )
if ( hRow := mysql_fetch_row( oOrm:pLib, ::hMyRes ) ) != 0
for m = 1 to ::FCount()
::aRows[ n, m ] = PtrToStr( hRow, m - 1 )
next
endif
next
ENDIF
endif
ELSE
::aFields:= hJson['header']
::aRows := hJson['body']
ENDIF
return Self
HOW TO USE IT:
MYSQL
Código: Seleccionar todo
LOCAL oBD
oBD:=TMySql():New("MYSQL", "localhost", "user", "password", "schema", 3306)
oJson := oBD:QueryJson("SELECT * FROM table WHERE field1='PARAM01' AND field2=PARAM02",{"param",2})
Código: Seleccionar todo
LOCAL oBD
oBD:=TMySql():New("MARIA", "localhost", "user", "password", "schema", 3306)
oJson := oBD:QueryJson("SELECT * FROM table WHERE field1='PARAM01' AND field2=PARAM02",{"param",2})
The work always comes before the belief
-
- Site Admin
- Mensajes: 315
- Registered for: 3 years 6 months
Very good Ricardo
Hay dos tipos de personas: las que te hacen perder el tiempo y las que te hacen perder la noción del tiempo
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces
El secreto de la felicidad no está en hacer lo que te gusta, sino en que te guste lo que haces