Si hay pocas respuestas es porque alo mejor se usa poco, de cualquier modo en Eagle1 es muy fácil.
// PROPOSITO.: Ejemplo de mantenimiento simple de una tabla //
//----------------------------------------------------------------------------//
//-- Definiciones ------------------------------------------------------------//
#define B_BOX ( CHR( 218 ) + CHR( 196 ) + CHR( 191 ) + CHR( 179 ) + ;
CHR( 217 ) + CHR( 196 ) + CHR( 192 ) + CHR( 179 ) + " " )
#define ID_CONSUTA 0
#define ID_MODIFICA 1
#define ID_ALTA 2
#define ID_BORRA 3
//-- Includes ----------------------------------------------------------------//
#include "InKey.ch"
#include "Eagle1.ch"
//-- Fuerza el enlazado -----------------------------------------------------//
REQUEST HB_GT_WIN
//-- Modulo principal --------------------------------------------------------//
procedure main()
local cDb := "E1Prueba"
local cTable := "Test"
local oCon, oTb, n
//----------------------------------------------------------------------------
// Desde aquÝ se decide si el sistema usado es el C/S o el embebido
#ifdef E1_EMBEDDED
// Sistema embebido.
// El primer elemento del array de opciones deberÝa ser el nombre
// del programa, actualmente E1 hace lo mismo que MySQL y lo ignora.
// Ojo!!! s¾lo se procesa a partir del segundo.
local aOptions := { "PT05.PRG", "--defaults-file=./test.cnf" }
// El array de grupos contiene los nombres de los grupos que queramos
// procesar dentro del fichero ini declarado
local aGroup := { "op_servidor", "op_cliente" }
//-----------------------------------------------------
// Creamos el objeto Connect e intentamos la conexi¾n:
oCon := TMSEConnect():New( )
oCon:Connect( aOptions, aGroup, cDb )
#else
// Sistema Cliente/Servidor
local cHost := "127.0.0.1"
local cUser := "root"
local cPwd := "root"
//-----------------------------------------------------
// Creamos el objeto Connect e intentamos la conexi¾n:
oCon := TMSConnect():New()
oCon:Connect( cHost, cUser, cPwd, cDb,,, CLIENT_MULTI_STATEMENTS )
#endif
// Hasta aquÝ. A paritir de aquÝ no se cambia ni una lÝnea de c¾digo
//----------------------------------------------------------------------------
SET DATE FORMAT TO "DD/MM/YYYY"
cls
if oCon:lConnected
// Control de errores automßtico
oCon:SetAutoError( .t. )
// Creo el objeto Tabla con DataField
oTb := TMyTable( cTable ):New( oCon, cTable )
// Establezco el relleno de espacios (menos optimo)
oTb:SetReadPADAll( .t. )
// Prueba de tiny como logicos:
oTb:SetTinyAsLogical( .t. )
// Abro la tabla
if oTb:Open()
MyMsgInfo( oCon:oDataBase:ShowCreate(), "Creaci¾n de " + oCon:oDataBase:cName )
MyMsgInfo( oTb:ShowCreate(), "Estructura de " + oTb:cName )
// Si no hay registros insertamos uno para que funcione el Browse
Alert( "Estado actual de la conexion...;-------------------------------;;";
+ oCon:GetStat() )
// Abrimos el Browse
GestBrw( oTb )
else
// Esta es la manera de poner un mensaje de error propio y
// del generado por Eagle1 cuando ponemos SetAutoError( .f. )
Alert( ";Mi mensaje de error:;No se pudo abrir la tabla " + oTb:cName + ;
";;Y el devuelto por Eagle1:;" + oTb:oError:GetError() )
endif
// Prueba de FieldName y FieldPos
n := 6
Alert( "Nombre de la columna " + StrNum( n ) + ": " +;
oTb:FieldName( n ) + ;
";Orden de la columna ZIP: " + ;
StrNum( oTb:FieldPos( "zip" ) ) + " Valor " + ;
oTb:FieldGetByName( "zip" ) + " - " + ;
oTb:FieldGet( oTb:FieldPos( "zip" ) ) )
// Prueba de setWhere
oTb:SetWhere( "first = 'Homer'", .t. ) // Asigna la condici¾n y refresca el reultado
Alert( oTb:cStatement )
// Abrimos el Browse
GestBrw( oTb )
//------------------------------
// Ejemplo SELECT escalar o sea que retorna un valor unico que puede ser
// numerico o alfanumerico
cls
Alert( "Numero de registros hallados con la funcion COUNT( * ): " + ;
StrNum( oCon:GetScalarQuery( "SELECT count( * ) FROM test" ) ) )
Alert( "Ahora la columna NOTES de la primera fila : " + ;
oCon:GetScalarQuery( "SELECT notes FROM test" ) )
// Liberamos la memoria ocupada por el objeto tabla
oTb:Free()
//------------------------------
// METHOD Export( cBakFileName, lCreate, aTables, lDropTable )
// Prueba de backup:
n := Seconds()
oCon:oDataBase:Export() // "MiCopia.sql", .t. )
Alert( "La copia se ha realizado con el nombre: " + ;
oCon:oDataBase:cBakFileName + ";;en " + ;
StrNum( Seconds() - n ) + " segundos" )
//------------------------------
// Este es el restore
//
/*
if oCon:oDataBase:Import( oCon:oDataBase:cBakFileName )
Alert( "La restauracion de la copia se ejecuto ok" )
else
Alert( "Error en la restauracion de la copia..." )
endif
*/
//------------------------------
else
Alert( "No se pudo conectar..." )
endif
// Liberamos la memoria de la conexion
oCon:Free()
return
//-- Modulos auxiliares ------------------------------------------------------//
//----------------------------------------------------------------------------//
// Gestion completa de una tabla MySQL
static procedure GestBrw( oTb )
local oBrw, oCol
local lEnd := .f.
local nKey, n, nFld
oBrw := TBrowseNew( 1, 0, MaxRow() - 1, MaxCol() )
oBrw:colorSpec := "W+/B, N/BG"
oBrw:ColSep := " │ "
oBrw:HeadSep := "─┼─"
oBrw:FootSep := "─┴─"
// Asignamos los bloques de codigo de movimientos del cursor
// de datos
MySetBrowse( oBrw, oTb )
nFld := oTb:FieldCount()
FOR n := 1 TO nFld
oBrw:AddColumn( TBColumnNew( PADL( n, 2, "0" ) + "-" + ;
oTb:FieldType( n ) + "-" + oTb:FieldName( n ), ;
GenCB( oTb, n ) ) )
NEXT
cls
@ 0, 0 SAY PadC( "Ojeando la tabla: " + ;
upper( oTb:cName ), MaxCol() + 1, " " ) COLOR "W+/G+"
@ MaxRow(), 0 SAY "INS" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Altas" COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "ENTER" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Mod." COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "SUPR" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Bajas" COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "F1" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Ayuda" COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "F4" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Orden" COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "F5" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Busca" COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "F6" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Busca ->" COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "ESC" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Salir" COLOR "W+/R+"
while !lEnd
oBrw:ForceStable()
nKey = InKey( 0 )
do case
case nKey == K_ESC // Salir
SetPos( MaxRow(), 0 )
lEnd = .t.
case nKey == K_DOWN // Fila siguiente
oBrw:Down()
case nKey == K_F3
oTb:SetReadPADAll( !oTb:SetReadPADAll() )
oBrw:Configure()
case nKey == K_F4 // Establece el orden
if ElOrden( oTb )
oBrw:goTop()
endif
case nKey == K_F5 // Busca valor en columna
if !BuscaValor( oTb )
Alert( "Valor no encontrado..." )
endif
oBrw:RefreshAll()
case nKey == K_F6 // Busca siguiente columna
if !oTb:FindLikeNext()
Alert( "Valor no encontrado..." )
endif
oBrw:RefreshAll()
case nKey == K_UP // Fila anterior
oBrw:Up()
case nKey == K_LEFT // Va a la columna antrior
oBrw:Left()
case nKey == K_RIGHT // Va a la columna siguiente
oBrw:Right()
case nKey = K_PGDN // Va a la pagina siguiente
oBrw:pageDown()
case nKey = K_PGUP // Va a la pagina antrior
oBrw:pageUp()
case nKey = K_CTRL_PGUP // Va al principio
oBrw:goTop()
case nKey = K_CTRL_PGDN // Va al final
oBrw:goBottom()
case nKey = K_HOME // Va a la primera columna visible
oBrw:home()
case nKey = K_END // Va a la ultima columna visible
oBrw:end()
case nKey = K_CTRL_LEFT // Va a la primera columna
oBrw:panLeft()
case nKey = K_CTRL_RIGHT // Va a la ultima columna
oBrw:panRight()
case nKey = K_CTRL_HOME // Va a la primera pßgina
oBrw:panHome()
case nKey = K_CTRL_END // Va a la ·ltima pßgina
oBrw:panEnd()
case nKey = K_DEL // Borra fila
Borrar( oTb, oBrw )
case nKey = K_INS // Inserta columna
Insertar( oTb, oBrw )
case nKey = K_ENTER // Modifica columna
Modificar( oTb, oBrw )
case nKey == K_F1 // Algunos datos
Alert( "Datos de la tabla " + oTb:cName + ";" + ;
";Registro actual......: " + Str( oTb:RecNo() ) + ;
";Total de registros...: " + Str( oTb:RecCount() ) + ;
";Total de columnas....: " + Str( oTb:FieldCount() ) )
Muestra( oTb:GetRowAsString() )
endcase
end
return
//----------------------------------------------------------------------------//
// Crea los codeblock SETGET de las columnas del browse
static function GenCB( oTb, n )
return( { || oTb:FieldGet( n ) } )
//----------------------------------------------------------------------------//
// Pantalla de datos de la tabla
static function PantMuestra( oTb, nTipo )
local GetList := {}
local cTipo, cId
do case
case nTipo == ID_ALTA
cTipo := "Insertando"
cId := "nuevo"
case nTipo == ID_BORRA
case nTipo == ID_CONSUTA
case nTipo == ID_MODIFICA
cTipo := "Modificando"
cId := StrNum( oTb:Id )
end
SET CURSOR ON
DispBox( 3, 2, 18, 74, B_BOX )
@ 04, 03 SAY cTipo + " registro en tabla " + oTb:cName + " - Numero: " + cId
@ 06, 03 SAY "First....:" GET oTb:First PICTURE "@K"
@ 07, 03 SAY "Last.....:" GET oTb:Last PICTURE "@K"
@ 08, 03 SAY "Street...:" GET oTb:Street PICTURE "@K"
@ 09, 03 SAY "City.....:" GET oTb:City PICTURE "@K"
@ 10, 03 SAY "State....:" GET oTb:State PICTURE "@K"
@ 11, 03 SAY "Zip......:" GET oTb:Zip PICTURE "@K"
@ 12, 03 SAY "Hiredate.:" GET oTb:Hiredate PICTURE "@K"
@ 13, 03 SAY "Married..:" GET oTb:Married PICTURE "@K"
@ 14, 03 SAY "Age......:" GET oTb:Age PICTURE "@K"
@ 15, 03 SAY "Salary...:" GET oTb:Salary PICTURE "@K"
@ 16, 03 SAY "Notes:"
@ 17, 03 GET oTb:Notes PICTURE "@K"
return( GetList )
//----------------------------------------------------------------------------//
// Inserta una fila
static procedure Insertar( oTb, oBrw )
local GetList := {}
local cPant := SaveScreen( 3, 2, 18, 74 )
oTb:Blank()
GetList := PantMuestra( oTb, ID_ALTA )
READ
set cursor off
RestScreen( 3, 2, 18, 74, cPant )
if LastKey() != K_ESC .and. Updated()
if oTb:Insert()
Alert( "Tupla insertada" )
if Alert( "Refresca el Browse?", { "Si", "No" } ) == 1
oTb:Refresh()
oBrw:goBottom()
oBrw:RefreshAll()
endif
endif
endif
return
//----------------------------------------------------------------------------//
// Modifica la fila actual
static procedure Modificar(oTb,oBrw )
local GetList := {}
local nRecNo := oTb:RecNo()
local cPant := SaveScreen( 3, 2, 18, 74 )
oTb:Load()
GetList := PantMuestra( oTb, ID_MODIFICA )
READ
set cursor off
RestScreen( 3, 2, 18, 74, cPant )
if LastKey() != K_ESC .and. Updated()
if oTb:Update()
Alert( StrNum( oTb:AffectedRows() ) + " - tuplas modificadas" )
if Alert( "Refresca el Browse?", { "Si", "No" } ) == 1
oTb:Refresh()
oTb:GoTo( nRecNo )
oBrw:RefreshAll()
endif
endif
endif
return
//----------------------------------------------------------------------------//
// Borra la fila actual
static procedure Borrar( oTb, oBrw )
local nRecNo := oTb:RecNo()
if Alert( "Realmente quieres borrar el registro?", { "Si", "No" } ) == 1
if oTb:Delete( , 1 )
Alert( "Borrado en el servidor" )
if Alert( "Refresca el Browse?", { "Si", "No" } ) == 1
oTb:Refresh()
oTb:GoTo( nRecNo )
oBrw:RefreshAll()
endif
endif
else
Alert( "No se ha borrado..." )
endif
return
//----------------------------------------------------------------------------//
// Establece un nuevo orden de visualizacion
static function ElOrden( oTb )
local i := oTb:FieldCount()
local aFld := Array( i )
local n, lRet
FOR n := 1 TO i
aFld[ n ] := oTb:FieldName( n )
NEXT
DispBox( 5, 9, 10, 25, B_BOX )
i := 0
i := AChoice( 6, 10, 9, 24, aFld )
if lRet := ( i > 0 )
Alert( "Ordenado por la columna: " + StrNum( i ) + " " + oTb:FieldName( i ) )
oTb:SetOrderBy( i,, .t. )
endif
return( lRet )
//----------------------------------------------------------------------------//
// Busca un valor de una columna
static function BuscaValor( oTb )
local GetList := {}
local nCol := 0
local lRet, uVal
DispBox( 5, 5, 8, 75, B_BOX )
@ 6, 10 SAY "Entre numero de columna:" GET nCol PICTURE "@K"
READ
if nCol > 0 .and. nCol <= oTb:FieldCount()
uVal := oTb:FieldGet( nCol )
@ 7, 10 SAY "Entre valor buscado:" GET uVal PICTURE "@K"
READ
// Ojo cuando es tipo caracter (x)Harbour mete espacios hasta el final
// del ancho del campo
uVal := if( ValType( uVal ) == "C", AllTrim( uVal ), uVal )
lRet := oTb:FindLike( nCol, uVal, .t. )
else
lRet := .f.
Alert( "Emtre un n·mero de columna correcto" )
endif
return( lRet )
//----------------------------------------------------------------------------//
