Francisco el problema es que MySQL no tiene la capacidad de tener mas de un SELECT vivo a la vez...
La solución es abrir dos conexiones, pero eso suele ser muy costoso en uso de recursos tanto en el lado del servidor como en el cliente, así que la otra opción es la que yo te recomiendo que es abrir la consulta como READ OMLY...
Por otro lado aprovecho para que te intereses por mi librería HDO (Harbour Data Object)
Hecha en C completamente.
Con sentencias preparadas en el lado del servidor. (Hasta ahora ninguna de las existentes lo tienen)
Crea el concepto de RDL (Replaceable Data Link) en la actualidad en producción está RDLMYSQL para MariaDB y MySQL y RDLSQLITE para SQLite y SQLSipher.
Con esto puedes tener un PRG y cambiando el RDL podrás trabajar con una base de datos o otra.
Y la más indicada para aplicaciones críticas en las que se necesite velocidad y robustez.
En mis pruebas es 16 veces más rápidas que otras.
Y también viene dos clases adicinales para tratar los arrays de memoria y los hashtables como RowSet.
Code: Select all | Expand
/*
* Proyecto: HDO_GENERAL
* Fichero: ej17.prg
* Descripcion:
* Autor: Manu Exposito 2014-18
* Fecha: 10/09/2018
*/
//------------------------------------------------------------------------------
#include "hdo.ch"
#include "inkey.ch"
//------------------------------------------------------------------------------
// Desmarcar el RDL con el que se desea trabajar
#define _RDLSQLITE
//#define _RDLMYSQL
//------------------------------------------------------------------------------
#ifdef _RDLSQLITE
REQUEST RDLSQLITE
#define _DBMS "sqlite"
#define _DB "hdodemo.db"
#define _CONN
#endif
#ifdef _RDLMYSQL
#include "hdomysql.ch"
REQUEST RDLMYSQL
#define _DBMS "mysql"
#define _DB "hdodemo"
#define _CONN "127.0.0.1", "root", "root"
#endif
//------------------------------------------------------------------------------
// Definiciones
#define B_BOX ( CHR( 218 ) + CHR( 196 ) + CHR( 191 ) + CHR( 179 ) + ;
CHR( 217 ) + CHR( 196 ) + CHR( 192 ) + CHR( 179 ) + " " )
// Sentencias precompiladas:
#define STMT_SEL "SELECT * FROM test WHERE idreg BETWEEN ? AND ?;"
#define STMT_INS "INSERT INTO test ( first, last, street, city, state, zip, hiredate, married, age, salary, notes ) VALUES ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? );"
#define STMT_UPD "UPDATE test SET first = ?, last = ?, street = ?, city = ?, state = ?, zip = ?, hiredate = ?, married = ?, age = ?, salary = ?, notes = ? WHERE idreg = ?;"
#define STMT_DEL "DELETE FROM test WHERE idreg = ?;"
//------------------------------------------------------------------------------
// Variables estaticas que se van a usar en varias funciones
static oDb, oRS // Objeto conexion y RowSet
static idreg, first, last, street, city, state, zip, hiredate, married, ;
age, salary, notes // Variables de campos
static nRecIni, nRecEnd // Valor inicial y final
//------------------------------------------------------------------------------
// Procedimiento principal
procedure main17
local e, i, getlist := {}
////////////////////////////////////////////////////////////////////////////////
// Esto no tiene efectos si no se usa el sistema embebido //
////////////////////////////////////////////////////////////////////////////////
#ifdef _RDLMYSQL //
local aOptions := { "HDO_DEMO", "--defaults-file=./my.cnf" } //
local aGroup := { "server", "client" } //
//----------------------------------------------------------------------------//
initMySQLEmdSys( aOptions, aGroup, "client" ) //
#endif //
////////////////////////////////////////////////////////////////////////////////
set date format to "dd-mm-yyyy"
oDb := THDO():new( _DBMS )
#ifdef _RDLMYSQL
// Necesario para que ping() funcione tradicionalmente (reconecte)
oDb:setAttribute( MYSQL_OPT_RECONNECT, .t. )
// MYSQL_INIT_COMMAND ejecuta un comando al establecer la conexion
//oDb:setAttribute( MYSQL_INIT_COMMAND, "CREATE TABLE lolo LIKE test;" )
#endif
if oDb:connect( _DB, _CONN )
//oDb:exec( "set session wait_timeout = 10" )
// Si se quieren establecer atributos por defecto a nivel de conexion o
// base de datos hay que hacerlo antes de abrir las consultas del tipo
// que sean:
oDb:setAttribute( HDO_ATTR_DEFAULT_STR_PAD, .t. )
oDb:setAttribute( HDO_ATTR_DEFAULT_TINY_AS_BOOL, .t. )
try
// oRS := oDb:rowSet( STMT_SEL )
oRS := TRowSet():new( oDb, STMT_SEL )
/*
// Prueba de setAttribute y getAttribute
msg( oRS:getAttribute( STMT_ATTR_STR_PAD ), "STMT_ATTR_STR_PAD" )
oRS:setAttribute( STMT_ATTR_STR_PAD, .f. )
msg( oRS:getAttribute( STMT_ATTR_STR_PAD ), "STMT_ATTR_STR_PAD" )
msg( oRS:getAttribute( STMT_ATTR_TINY_AS_BOOL ), "STMT_ATTR_TINY_AS_BOOL" )
oRS:setAttribute( STMT_ATTR_TINY_AS_BOOL, .t. )
msg( oRS:getAttribute( STMT_ATTR_TINY_AS_BOOL ), "STMT_ATTR_TINY_AS_BOOL" )
msg( oRS:getAttribute( STMT_ATTR_CURSOR_TYPE ), "STMT_ATTR_CURSOR_TYPE" )
oRS:setAttribute( STMT_ATTR_CURSOR_TYPE, CURSOR_TYPE_READ_ONLY )
msg( oRS:getAttribute( STMT_ATTR_CURSOR_TYPE ), "STMT_ATTR_CURSOR_TYPE" )
msg( oRS:getAttribute( STMT_ATTR_PREFETCH_ROWS ), "STMT_ATTR_PREFETCH_ROWS" )
oRS:setAttribute( STMT_ATTR_PREFETCH_ROWS, 100 )
msg( oRS:getAttribute( STMT_ATTR_PREFETCH_ROWS ), "STMT_ATTR_PREFETCH_ROWS" )
msg( oRS:getAttribute( STMT_ATTR_UPDATE_MAX_LENGTH ), "STMT_ATTR_UPDATE_MAX_LENGTH" )
oRS:setAttribute( STMT_ATTR_UPDATE_MAX_LENGTH, .f. )
msg( oRS:getAttribute( STMT_ATTR_UPDATE_MAX_LENGTH ), "STMT_ATTR_UPDATE_MAX_LENGTH" )
*/
oRS:bindParam( 1, @nRecIni )
oRS:bindParam( 2, @nRecEnd )
// Asignamos las sentencias del mantenimiento de tablas
oRS:setInsertStmt( STMT_INS )
oRS:setUpdateStmt( STMT_UPD )
oRS:setDeleteStmt( STMT_DEL )
nRecIni := 0
nRecEnd := 9999999
menu()
// Un filtro: todo los apellidos "Klein"
//oRS:setFilter( { || AllTrim( oRS:fieldGet( "last" ) ) == "Klein" } )
while inkey( 0 ) != 27
cls
@ 02, 02 SAY "Entrada de datos:"
@ 04, 02 SAY "Entre rango inicial..................:" GET nRecIni PICTURE "@K 99999999"
@ 05, 02 SAY "Entre rango final....................:" GET nRecEnd PICTURE "@K 99999999" VALID validaRango( nRecIni, nRecEnd )
READ
e := Seconds()
oRS:load()
msg( Seconds() - e )
oRS:goTop()
cabecera()
Pie()
miBrw()
menu()
// Otro filtro: todos los registros del año 1990
//oRS:setFilter( { || oRS:fieldGet( 8 ) > CToD( "31-12-1989" ) .and. oRS:fieldGet( 8 ) < CToD( "01-01-1991" ) } )
end
catch e
eval( errorBlock(), e )
finally
if ValType( oRS ) == 'O'
oRS:free()
end
end
endif
oDb:disconnect()
msg( "--- < FIN > ---" )
return
//------------------------------------------------------------------------------
// Browse para el objeto RowSet
static procedure miBrw()
local i, oBrw := tbrowsenew( 2, 1, maxrow() -1 , maxcol() - 1 )
hb_dispbox( 1, 0, maxrow() - 1, maxcol(), hb_utf8tostrbox( "┌─â”│┘─└│ " ), "W+/B, N/BG" )
oBrw:colorSpec := "W+/B, N/BG"
oBrw:ColSep := hb_utf8tostrbox( "│" )
oBrw:HeadSep := hb_utf8tostrbox( "┼─" )
oBrw:FootSep := hb_utf8tostrbox( "┴─" )
oBrw:GoTopBlock := {|| oRS:goTop() }
oBrw:GoBottomBlock := {|| oRS:goBottom() }
oBrw:SkipBlock := {| nSkip | oRS:skipper( nSkip ) }
genColumn( oBrw )
frontControl( oBrw )
return
//------------------------------------------------------------------------------
// Controlador de opciones
static procedure frontControl( oBrw )
while .t.
oBrw:forceStable()
switch inkey()
case K_ESC // Salir
setpos( maxrow(), 0 )
return
case K_DOWN // Fila siguiente
oBrw:Down()
exit
case K_UP // Fila anterior
oBrw:Up()
exit
case K_LEFT // Va a la columna antrior
oBrw:left()
exit
case K_RIGHT // Va a la columna siguiente
oBrw:right()
exit
case K_PGDN // Va a la pagina siguiente
oBrw:pageDown()
exit
case K_PGUP // Va a la pagina antrior
oBrw:pageUp()
exit
case K_CTRL_PGUP // Va al principio
oBrw:goTop()
exit
case K_CTRL_PGDN // Va al final
oBrw:goBottom()
exit
case K_HOME // Va a la primera columna visible
oBrw:home()
exit
case K_END // Va a la ultima columna visible
oBrw:end()
exit
case K_CTRL_LEFT // Va a la primera columna
oBrw:panLeft()
exit
case K_CTRL_RIGHT // Va a la ultima columna
oBrw:panRight()
exit
case K_CTRL_HOME // Va a la primera página
oBrw:panHome()
exit
case K_CTRL_END // Va a la última página
oBrw:panEnd()
exit
case K_DEL // Borra fila
Borrar()
cabecera()
oBrw:refreshAll()
exit
case K_INS // Inserta columna
if Insertar( oBrw )
oBrw:goBottom()
endif
cabecera()
exit
case K_ENTER // Modifica columna
Modificar()
cabecera()
oBrw:refreshAll()
exit
case K_F1
ayuda()
exit
case K_F2
consultar()
exit
case K_F6
Buscar()
exit
case K_F9
ListarRS()
exit
end switch
end
return
//==============================================================================
// Funciones del browse
//------------------------------------------------------------------------------
// Genera las columnad del browse
static procedure genColumn( oBrw )
oBrw:AddColumn( tbcolumnnew( "#Reg.", { || oRS:fieldget( 1 ) } ) )
oBrw:AddColumn( tbcolumnnew( "First", { || oRS:fieldget( 2 ) } ) )
oBrw:AddColumn( tbcolumnnew( "Last", { || oRS:fieldget( 3 ) } ) )
oBrw:AddColumn( tbcolumnnew( "Street", { || oRS:fieldget( 4 ) } ) )
oBrw:AddColumn( tbcolumnnew( "City", { || oRS:fieldget( 5 ) } ) )
oBrw:AddColumn( tbcolumnnew( "State", { || oRS:fieldget( 6 ) } ) )
oBrw:AddColumn( tbcolumnnew( "Zip", { || oRS:fieldget( 7 ) } ) )
#ifdef _RDLSQLITE
oBrw:AddColumn( tbcolumnnew( "Hiredate", { || HB_CToD( oRS:fieldget( 8 ), "yyyy-mm-dd" ) } ) )
oBrw:AddColumn( tbcolumnnew( "Married", { || if( oRS:fieldGet( 9 ) == 1, 'S', 'N' ) } ) )
#else
oBrw:AddColumn( tbcolumnnew( "Hiredate", { || oRS:fieldget( 8 ) } ) )
oBrw:AddColumn( tbcolumnnew( "Married", { || if( oRS:fieldGet( 9 ), 'S', 'N' ) } ) )
#endif
oBrw:AddColumn( tbcolumnnew( "Age", { || oRS:fieldget( 10 ) } ) )
oBrw:AddColumn( tbcolumnnew( "Salary", { || oRS:fieldget( 11 ) } ) )
oBrw:AddColumn( tbcolumnnew( "Notes", { || oRS:fieldget( 12 ) } ) )
return
//------------------------------------------------------------------------------
// Muestra una pequeñ¡ ¡yuda de uso de teclas por la la pantalla
static procedure ayuda()
#ifdef _RDLSQLITE
local cRDL := "RDL SQLITE;"
#else
local cRDL := "RDL MYSQL;"
#endif
msg( "---------------------;" + ;
cRDL + ;
"---------------------;;" + ;
"F1 ...... Ayuda ;" + ;
"F2 ...... Consultar ;" + ;
"F6 ...... Buscar ;" + ;
"F9 ...... Listar RS ;" + ;
"F10 ..... Listar Stmt;" + ;
"Intro ... Modificar ;" + ;
"Insert .. Insertar ;" + ;
"Supr .... Borrar " , "AYUDA" )
return
//------------------------------------------------------------------------------
// Opcion para modificar un registro
static procedure modificar()
local getList
local cSs := savescreen( 0, 0, maxrow(), maxcol() )
cls
DispBox( 3, 2, 18, 74, B_BOX )
cargaReg()
@ 04, 03 SAY "Modificacion del socio: " + hb_ntos( idreg )
getList := muestraGet()
read
if lastkey() != K_ESC .and. updated()
married := if( married $ 'Ss', .t., .f. )
msgEspera()
oRS:update( { first, last, street, city, state, zip, hiredate, married, age, salary, notes, idreg }, .t. )
endif
restscreen( 0, 0, maxrow(), maxcol(), cSs )
return
//------------------------------------------------------------------------------
// Inserta un nuevo registro
static function Insertar( oBrw )
local getlist := {}
local cSs := savescreen( 0, 0, maxrow(), maxcol() )
local lRet := .f.
oRS:goTo( 0 )
cargaReg()
cls
DispBox( 3, 2, 18, 74, B_BOX )
@ 04, 03 SAY "Alta de nuevo socio"
getlist := muestraGet()
read
if lastkey() != K_ESC .and. updated()
married := if( married $ 'Ss', .t., .f. )
msgEspera()
lRet := oRS:insert( { first, last, street, city, state, zip, hiredate, married, age, salary, notes }, .t. )
endif
restscreen( 0, 0, maxrow(), maxcol(), cSs )
return lRet
//------------------------------------------------------------------------------
// Opcion para consultar un registro
static procedure consultaInterna()
DispBox( 3, 2, 18, 74, B_BOX )
@ 04, 03 SAY "Consulta del socio [" + hb_ntos( oRS:fieldGet( 1 ) ) + "]"
@ 06, 03 SAY "First....: " + oRS:fieldGet( "First" ) //2 )
@ 07, 03 SAY "Last.....: " + oRS:fieldGet( "Last" ) //3 )
@ 08, 03 SAY "Street...: " + oRS:fieldGet( 4 )
@ 09, 03 SAY "City.....: " + oRS:fieldGet( 5 )
@ 10, 03 SAY "State....: " + oRS:fieldGet( 6 )
@ 11, 03 SAY "Zip......: " + oRS:fieldGet( 7 )
#ifdef _RDLSQLITE
@ 12, 03 SAY "Hiredate.: " + HB_DToC( HB_CToD( oRS:fieldGet( 8 ), "yyyy-mm-dd" ), "dd-mm-yyyy" )
@ 13, 03 SAY "Married..: " + if( oRS:fieldGet( 9 ) == 1, 'S', 'N' )
#else
@ 12, 03 SAY "Hiredate.: " + DToC( oRS:fieldGet( 8 ) )
@ 13, 03 SAY "Married..: " + if( oRS:fieldGet( 9 ), 'S', 'N' )
#endif
@ 14, 03 SAY "Age......: " + HB_NToS( oRS:fieldGet( 10 ) )
@ 15, 03 SAY "Salary...: " + HB_NToS( oRS:fieldGet( 11 ) )
@ 16, 03 SAY "Notes: "
@ 17, 03 SAY oRS:fieldGet( 12 )
return
//------------------------------------------------------------------------------
static procedure consultar()
local cSs := savescreen( 0, 0, maxrow(), maxcol() )
cls
consultaInterna()
espera()
restscreen( 0, 0, maxrow(), maxcol(), cSs )
return
//------------------------------------------------------------------------------
// Borra un registro
static procedure Borrar()
local getList := {}
local cSs := savescreen( 0, 0, maxrow(), maxcol() )
local cSN := "N"
cls
consultaInterna()
@ 20, 03 SAY "Realmente quieres borrar este registro?" GET cSN PICTURE "@K" VALID cSN $ "SsNn"
READ
restscreen( 0, 0, maxrow(), maxcol(), cSs )
if ( cSN $ "Ss" )
msgEspera()
oRS:delete( { oRS:fieldGet( 1 ) }, .t. )
endif
return
//------------------------------------------------------------------------------
// Busca un registro uso del metodo find y findNext
//
// oRS:find( valor, num_columna, desde_el_principio )
// Parametros:
// valor: parametro que contiene el valor que se quiera buscar, puede ser de
// cualquier tipo
// num_columna: numero de columna en la que se debe buscar el valor
// desde_el_principio: BOOL indica si empieza desde el principio
static procedure Buscar()
local s, n
local nCol := 1, xVal := Space( 30 )
local getList := {}
local nRec := oRS:recNo()
local cSs := savescreen( 0, 0, maxrow(), maxcol() )
cls
@ 02, 02 SAY "Introduce la columna por la que buscar...:" GET nCol PICTURE "@K 99"
READ
// xVal := oRS:fieldGet( nCol )
@ 03, 02 SAY "Valor de [" + oRS:fieldName( nCol ) + "] que quiere buscar...:" GET xVal PICTURE "@K"
READ
cls
n := 0 // Reutilizo variable
if ( s := oRS:findString( xVal, nCol, .t. ) ) > 0
? Replicate( "-", MaxCol() )
? "Hallado el valor [", oRS:fieldGet( nCol ), "] de la columna:", oRS:fieldName( nCol )
? Replicate( "-", MaxCol() )
while s > 0
n++
? "Registro numero:", oRS:recNo(), oRS:fieldGet( nCol )
s := oRS:findStringNext() // Busca siguiente
end
? Replicate( "-", MaxCol() )
? "Hay", AllTrim( Str( n ) ), "ocurrencias de", xVal, "en la columna", AllTrim( Str( nCol ) )
? Replicate( "-", MaxCol() )
else
? xVal, "no encontrado..."
endif
espera( 30 )
oRS:goTo( nRec )
restscreen( 0, 0, maxrow(), maxcol(), cSs )
return
//------------------------------------------------------------------------------
// Consulta directamente a la tabla con variables xbase vinculadas
static procedure ListarRS()
local i := 1
local cSs := savescreen( 0, 0, maxrow(), maxcol() )
local nRec := oRS:recNo()
oRS:goTop()
cls
? "Registros desde la tabla:"
while !oRS:eof()
? HB_NToS( oRS:fieldGet( 1 ) ), oRS:fieldGet( 2 ), oRS:fieldGet( 3 ), oRS:fieldGet( 4 )
oRS:next()
if( i > 20, ( espera(), Scroll(), SetPos( 0, 0 ), i := 1 ), i++ )
end while
oRS:goTo( nRec )
msg( "Se termino..." )
restscreen( 0, 0, maxrow(), maxcol(), cSs )
return
//------------------------------------------------------------------------------
static procedure menu()
cls
@ maxrow(), 00 SAY "Presiona <INTRO> para selecionar rangos o <ESC> para salir..."
return
//------------------------------------------------------------------------------
// Muestra cabecera
static procedure cabecera()
@ 00, 00 SAY "RDL: " + oDb:getAttribute( HDO_ATTR_RDL_NAME ) + PadR( " | Base de Datos: " + oDb:getDBName() + ;
" | La consulta tiene " + ;
hb_ntos( oRS:rowCount() ) + " registros", MaxCol() + 1, " " ) color "W+/R"
return
//------------------------------------------------------------------------------
// Muestra pie
static procedure pie()
@ maxrow(), 00 SAY PadR( "<F1> Ayuda - <ESC> para ir al menu inicial...", ;
MaxCol() + 1, " " ) color "W+/R"
return
//------------------------------------------------------------------------------
//
static procedure msgEspera()
@ MaxRow() - 1, 01 SAY "Actualizando la tabla con los cambios. Espere un momento..."
return
//==============================================================================
// Otras funciones
//------------------------------------------------------------------------------
// Muestra los GET por pantalla y devuelve el array getList
static function muestraGet()
local getList := {}
@ 06, 03 SAY "First....:" GET first PICTURE "@K"
@ 07, 03 SAY "Last.....:" GET last PICTURE "@K"
@ 08, 03 SAY "Street...:" GET street PICTURE "@K"
@ 09, 03 SAY "City.....:" GET city PICTURE "@K"
@ 10, 03 SAY "State....:" GET state PICTURE "@K"
@ 11, 03 SAY "Zip......:" GET zip PICTURE "@K 99999-9999"
@ 12, 03 SAY "Hiredate.:" GET hiredate PICTURE "@KD"
@ 13, 03 SAY "Married..:" GET married PICTURE "@K" VALID married $ "SsNn"
@ 14, 03 SAY "Age......:" GET age PICTURE "@K 999"
@ 15, 03 SAY "Salary...:" GET salary PICTURE "@K 999999.99"
@ 16, 03 SAY "Notes:"
@ 17, 03 GET notes PICTURE "@K"
return getList
//------------------------------------------------------------------------------
// Carga el actual registro del actual del cursor a las variables de campos
static procedure cargaReg()
// Se puede usar tambien con la posicion: idreg := oRS:fieldGet( 1 )
idreg := oRS:fieldGet( "idreg" )
first := oRS:fieldGet( "first" )
last := oRS:fieldGet( "last" )
street := oRS:fieldGet( "street" )
city := oRS:fieldGet( "city" )
state := oRS:fieldGet( "state" )
zip := oRS:fieldGet( "zip" )
#ifdef _RDLSQLITE
hiredate := HB_CToD( oRS:fieldGet( "hiredate" ), "yyyy-mm-dd" )
married := if( oRS:fieldGet( "married" ) == 1, 'S', 'N' )
#else
hiredate := oRS:fieldGet( "hiredate" )
married := if( oRS:fieldGet( "married" ), "S", "N" )
#endif
age := oRS:fieldGet( "age" )
salary := oRS:fieldGet( "salary" )
notes := oRS:fieldGet( "notes" )
//muestra( oRS:getValuesAsHash() )
return
//------------------------------------------------------------------------------
// Valida el rango entre dos valores
static function validaRango( r1, r2 )
local lRet := ( r2 >= r1 )
if !lRet
msg( "El riemer rango debe ser mayor que segundo:; " + ;
hb_ntos( r1 ) + " > " + ;
hb_ntos( r2 ), "Error en rangos" )
endif
return lRet
//------------------------------------------------------------------------------
