HDO (Harbour Data Objects) entra en escena.
Posted: Tue Aug 18, 2015 5:07 pm
Hola a todos...
Bueno ya hace un tiempo comenté que quería hacer una libreria para acceder a bases de datos de cualquier tipo sin tener que cambiar el código...
Pues ya tengo un boceto...
De monento esta en un 75% el RDL para SQLite.
Este es el código de un ejemplo:
Pronto crearé un grupo en yahoo donde os podreis bajar la LIB y los ejemplos.
Recordad que una de la novedad es que la LIB y los RDL (como los RDD pero para bases de datos como SQLite o MySQL) estan 100% en lenguaje C (Clases hechas en C saltandose así la maquina virtual necesaria cuando se hacen en PRG).
Si alguien está interesado en ser betatester que me lo diga.
Salu2
Bueno ya hace un tiempo comenté que quería hacer una libreria para acceder a bases de datos de cualquier tipo sin tener que cambiar el código...
Pues ya tengo un boceto...
De monento esta en un 75% el RDL para SQLite.
Este es el código de un ejemplo:
- Code: Select all Expand view
//------------------------------------------------------------------------------
// Proyecto: Harbour Data Objects hdo
// Fichero: demo01.prg
// Descripcion: Demo con el RDL SQLite
// Autor: Manu Exposito
// Fecha: 04/05/2015
//------------------------------------------------------------------------------
#include "hdo.ch"
//------------------------------------------------------------------------------
// Funcion principal
procedure main()
local i, oDrv, oCur, a, e, oHdo, oStmt
local cCrea := ;
"CREATE TABLE socios " + ;
"( clavesocio INTEGER PRIMARY KEY," + ;
"socio TEXT," + ;
"direccion TEXT," + ;
"telefono FLOAT," + ;
"miblob BLOB," + ;
"categoria TEXT );"
local cIns := ;
"INSERT INTO socios ( socio, direccion, telefono, miblob, categoria )" + ;
"VALUES ( 'Paula Maria', 'California Baja, 34', 955667788.01, 'campo tipo blob', 'de primera es esta' );" + ;
"INSERT INTO socios ( socio, direccion, telefono, miblob, categoria )" + ;
"VALUES ( 'Manuel', 'Formentera, 44', 955127756.02, 'blob', 'de segunda' );" + ;
"INSERT INTO socios ( socio, direccion, telefono, miblob, categoria )" + ;
"VALUES ( 'Carmen', 'Tinto, 33', 932667778.03, 'blob', 'de tercera' );" + ;
"INSERT INTO socios ( socio, direccion, telefono, miblob, categoria )" + ;
"VALUES ( 'Isabel', 'El Cano, 4', 923667745.04, 'blob', 'de cuarta' );" + ;
"INSERT INTO socios ( socio, direccion, telefono, miblob, categoria )" + ;
"VALUES ( 'Adrian', 'Octavio Paz, 2', 955333788.05, 'blob', 'de quinta' );" + ;
"INSERT INTO socios ( socio, direccion, telefono, miblob, categoria )" + ;
"VALUES ( 'Lorenzo', 'Alvareda, 9', 953245281.06, 'blob?', 'de _' );" + ;
"INSERT INTO socios ( socio, direccion, telefono, miblob, categoria )" + ;
"VALUES ( 'Sebastian', 'Formentera, 4', 935332255.07, 'EN blob?', 'de octaba' );" + ;
"INSERT INTO socios ( socio, direccion, telefono, miblob, categoria )" + ;
"VALUES ( 'Francisco', 'Chinchilla, 19', 915212218.08, 'EL blob?', 'de novena' );" + ;
"INSERT INTO socios ( socio, direccion, telefono, miblob, categoria )" + ;
"VALUES ( 'Miguel', 'San Rafael, 12', 954258218.09, 'ENEL blob?', 'de decima' );" + ;
"INSERT INTO socios ( socio, direccion, telefono, miblob, categoria )" + ;
"VALUES ( 'Antonio', 'Argentina, 2', 955222288.10, '', 'de decimoprimera' );"
cls
// Todas las sentencias que se envian al servidor deberian ir envueltas
// en un TRY - CATCH
TRY
oDrv := THDORDL():new()
muestra( oDrv:listRDLs(), "RDLs" )
oHdo := THDO():new( "sqlite" )
oHdo:connect( ":memory:" ) // Una de las dos "agenda.db" ":memory:"
msg( oHdo:getHost() + ";" + oHdo:getDbName() + ";" + ;
oHdo:getUser() + ";" + oHdo:getPasswd() + ";" + ;
oHdo:getDrvName(), "Datos conexion" )
muestra( oHdo:rdlInfo(), "Datos del RDL" )
TRY
oHdo:exec( cCrea )
CATCH e
muestra( e:SubSystem + ";" + padl( e:SubCode, 4 ) + ";" + ;
e:Operation + ";" + e:Description, "CATCH 2 - Error desde Harbour" )
muestra( oHdo:errorInfo(), "CATCH 2 - Error desde rdl:errorInfo()" )
END
TRY
msg( if( oHdo:inTransaction(), "1 Esta ", "1 No esta " ) + "en una trasaccion" )
oHdo:beginTransaction()
msg( if( oHdo:inTransaction(), "2 Esta ", "2 No esta " ) + "en una trasaccion" )
i := oHdo:exec( cIns )
msg( AllTrim( Str( i ) ) + " - " + AllTrim( Str( oHdo:lastInsertId() ) ), "Columnas afectadas y lastInsertId" )
oHdo:commit()
CATCH e
muestra( e:SubSystem + ";" + padl( e:SubCode, 4 ) + ";" + ;
e:Operation + ";" + e:Description, "CATCH 2 - Error desde Harbour" )
muestra( oHdo:errorInfo(), "CATCH 3 - Datos del error" )
oHdo:rollBack()
END
TRY
oHdo:exec( "SELECT * FROM socios WHERE clavesocio = 1" )
muestra( oHdo:errorInfo(), "Datos del error" ) // Ejemplo de errorInfo sin errores
CATCH
muestra( oHdo:errorInfo(), "CATCH 4 - Datos del error" )
END
msg( oHdo:escapeStr( "Manuel's kely \todo mi\o" ) )
CATCH e
muestra( e:SubSystem + ";" + padl( e:SubCode, 4 ) + ";" + ;
e:Operation + ";" + e:Description, "CATCH 1 - Error desde Harbour" )
muestra( oHdo:errorInfo(), "CATCH 1 - Error desde rdl:errorInfo()" )
FINALLY
//--- Pruebas con prepare ------------------------------------------
msg( "Pruebas con prepare" )
// Con comandos
oStmt := oHdo:prepare( "INSERT INTO socios ( socio, direccion, telefono, miblob, categoria ) " + ;
"VALUES ( ?, ?, ?, :miblob, ? );" )
oStmt:bindValue( 1, 'Maria' )
oStmt:bindValue( 2, 'Sevilla, 76' )
oStmt:bindValue( 3, 999777666.11 )
oStmt:bindValue( ':miblob', 'Este es el blob' ) // Se puede hacer asi tambien
oStmt:bindValue( 5, 'de primerisima' )
oStmt:execute()
oStmt:close()
// Con el metodo query (hace un prepare y execute a la vez)
oStmt := oHdo:query( "SELECT * FROM socios" )
msg( oStmt:getQueryStr() + ";;Tiene " + AllTrim( str( oStmt:columnCount() ) ) + ;
" colunas;;" + "oStmt es de tipo: " + ;
oStmt:className(), "Prueba de PREPARE" )
// Mientras fetch devuelva un array muestra el registro
while !empty( a := oStmt:fetch() )
muestra( a )
? oStmt:fetchColumn( 1 ), oStmt:fetchColumn( 2 ), oStmt:fetchColumn( 3 ), oStmt:fetchColumn( 4 ), oStmt:fetchColumn( 5 ), oStmt:fetchColumn( 6 )
end while
oStmt:close()
// Egemplo de fetchAll por defecto devuelve el resultado en un array de arrays
oStmt := oHdo:query( "SELECT socio, direccion, telefono FROM socios" )
a := oStmt:fetchAll() // o oStmt:fetchAll( FETCH_ARRAY )
for i := 1 to Len( a )
AEval( a[ i ], { | x | QOut( x ) } )
? "----------------------------------------------"
next
oStmt:close()
oStmt := oHdo:prepare( "SELECT * FROM socios" )
oStmt:execute()
a := oStmt:fetchAll( FETCH_HASH )
oStmt:close()
//------------------------------------------------------------------
oHdo:disconnect()
END
if msgSN( "Pruebas con el cursor" )
oCur := THashCursor():new()
oCur:setCursor( a )
msg( oCur:fieldCount(), "fieldCount" )
msg( oCur:fieldGet( 1 ), "fieldGet" )
oCur:goTo( 2 )
msg( oCur:recNo(), "recNo" )
muestra( oCur:asArray(), "asArray" )
msg( oCur:fieldName( 2 ) + ": " + ;
oCur:getByName( "socio" ) + " - " + ;
oCur:fieldName( 3 ) + ": " + oCur:fieldGet( 3 ) )
msg( oCur:recCount(), "recCount" )
msg( oCur:skipper( 100 ), "skipper 100" )
miBrw( oCur )
oCur:close()
endif
msg( ";;;;ESTO ES TODO!!!;;;;;" )
return
//------------------------------------------------------------------------------
// Browse para el objeto HbHashCursor
procedure miBrw( o )
local i, oBrowse := TBrowseNew( 5, 5, 16, 74 )
o:GoTop()
oBrowse:colorSpec := "W+/B, N/BG"
oBrowse:ColSep := hb_UTF8ToStrBox( "│" )
oBrowse:HeadSep := hb_UTF8ToStrBox( "┼─" )
oBrowse:FootSep := hb_UTF8ToStrBox( "┴─" )
oBrowse:GoTopBlock := { || o:goTop() }
oBrowse:GoBottomBlock := { || o:goBottom() }
oBrowse:SkipBlock := { | nSkip | o:skipper( nSkip ) }
for i := 1 to o:fieldCount()
oBrowse:AddColumn( TBColumnNew( o:FieldName( i ), genCB( o, i ) ) )
next
hb_DispBox( 4, 4, 17, 75, hb_UTF8ToStrBox( "┌─┐│┘─└│ " ) )
oBrowse:forceStable()
while oBrowse:applyKey( inkey( 0 ) ) != -1
oBrowse:forceStable()
enddo
return
//------------------------------------------------------------------------------
// Genera el codeblock para las columnas del Browuse
function genCB( o, i ) ; return( { || o:fieldget( i ) } )
//------------------------------------------------------------------------------
Pronto crearé un grupo en yahoo donde os podreis bajar la LIB y los ejemplos.
Recordad que una de la novedad es que la LIB y los RDL (como los RDD pero para bases de datos como SQLite o MySQL) estan 100% en lenguaje C (Clases hechas en C saltandose así la maquina virtual necesaria cuando se hacen en PRG).
Si alguien está interesado en ser betatester que me lo diga.
Salu2