Saludos foro
Alguien que utilice / haya usado esta clase tendra un ejemplo que como hacer un ABM con MySql?
De antemano gracias a los que sugieran hacerlo con Dolphin o FWMQL pero mi interes es con Eagle 1
//----------------------------------------------------------------------------//
// Soft4U Manu Exposito //
// Eagle1 Clases para manejo de MySQL desde xBase //
// //
// Tutor15 : Ejemplo de mantenimiento simple de una tabla //
//----------------------------------------------------------------------------//
#define CRLF Chr( 13 ) + Chr( 10 )
#define B_BOX ( CHR( 218 ) + CHR( 196 ) + CHR( 191 ) + CHR( 179 ) + ;
CHR( 217 ) + CHR( 196 ) + CHR( 192 ) + CHR( 179 ) + " " )
//----------------------------------------------------------------------------//
#include "util.ch"
#include "inKey.ch"
#include "Eagle1.ch"
//----------------------------------------------------------------------------//
function main()
local GetList := {}
local cServer := "127.0.0.1"
local cUser := "root"
local cPasswd := "root"
local cDb := "prueba"
local cTable := "test"
local oCon
local oDb, oTb
local a := {}
cls
INIT CONNECT oCon ;
HOST cServer;
USER cUser ;
PASSWORD cPasswd
if oCon:lConnected
USE DATABASE oDb NAME cDb OF oCon
if oDb:Used()
DEFINE TABLE oTb NAME cTable DATAFIELD ;
ORDER BY 1 ;
OF oDb
OPEN TABLE oTb
if oTb:lOpened
if oTb:RecCount() == 0
oTb:aBuffer := { "Manu", "Exposito", "Principe" , "Sevilla", ;
"SP", "41100", "1990-10-10", 1, 53, 2000, ;
"ningun" }
INSERT INTO oTb REFRESH
endif
GestBrw( oTb )
endif
endif
FREE TABLE oTb
endif
FREE CONNECT oCon
return( nil )
//----------------------------------------------------------------------------//
static function GestBrw( oTb )
local oBrw, oCol
local lEnd := .f.
local nKey := 0
local n := 0
if oTb:RecCount() < 1 // Comprobamos que hay registros
Alert( "No hay registros" )
return( nil )
endif
oBrw := TBrowseNew( 1, 0, MaxRow() - 1, MaxCol() )
oBrw:colorSpec := "W+/B, N/BG"
oBrw:ColSep := " ³ "
oBrw:HeadSep := "ÄÅÄ"
oBrw:FootSep := "ÄÁÄ"
oTb:GoTop():Read() // Hacer siempre un Read() para cargar el buffer interno
MySetBrowse( oBrw, oTb )
oBrw:AddColumn( TBColumnNew( "Reg.", { || oTb:RecNo() } ) )
FOR n := 1 TO oTb:FCount()
oBrw:AddColumn( TBColumnNew( 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 "INSERT" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Altas" COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "ENTER" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Modifica" COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "SUPR" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Bajas" COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "F4" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Ordenacion" COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "Flechas" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Moverse" 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
SetPos( MaxRow(), 0 )
lEnd = .t.
case nKey == K_DOWN
oBrw:Down()
case nKey == K_F4
if ElOrden( oTb )
oTb:GoTop():Read()
oBrw:goTop()
endif
case nKey == K_F5
if BuscaValor( oTb )
MyMsgInfo( "Encontrado..." )
else
MyMsgInfo( "Valor no encontrado..." )
oTb:GoTop():Read()
endif
oBrw:RefreshAll()
case nKey == K_F6
if oTb:FindNext()
MyMsgInfo( "Encontrado..." )
else
MyMsgInfo( "Valor no encontrado..." )
oTb:GoTop():Read()
endif
oBrw:RefreshAll()
case nKey == K_UP
oBrw:Up()
case nKey == K_LEFT
oBrw:Left()
case nKey == K_RIGHT
oBrw:Right()
case nKey = K_PGDN
oBrw:pageDown()
case nKey = K_PGUP
oBrw:pageUp()
case nKey = K_CTRL_PGUP
oBrw:goTop()
case nKey = K_CTRL_PGDN
oBrw:goBottom()
case nKey = K_HOME
oBrw:home()
case nKey = K_END
oBrw:end()
case nKey = K_CTRL_LEFT
oBrw:panLeft()
case nKey = K_CTRL_RIGHT
oBrw:panRight()
case nKey = K_CTRL_HOME
oBrw:panHome()
case nKey = K_CTRL_END
oBrw:panEnd()
case nKey = K_DEL
Borrar( oTb, oBrw )
case nKey = K_INS
Insertar( oTb, oBrw )
case nKey = K_ENTER
Modificar( oTb, oBrw )
endcase
end
return( nil )
//----------------------------------------------------------------------------//
static function GenCB( oTb, n )
return( { || oTb:xFieldGet( n ) } )
//----------------------------------------------------------------------------//
static function PantMuestra( oTb, cTipo )
local GetList := {}
set cursor on
DispBox( 3, 2, 16, 74, B_BOX )
@ 04, 03 SAY cTipo + " de Usuarios de Eagle1 Número: " + ;
AllTrim( str( oTb:Id ) )
@ 06, 03 SAY "Nombre..:" GET oTb:Nombre PICTURE "@K!"
@ 07, 03 SAY "eMail...:" GET oTb:eMail PICTURE "@K"
@ 08, 03 SAY "MSN.....:" GET oTb:MSN PICTURE "@K"
@ 09, 03 SAY "Pais....:" GET oTb:Pais PICTURE "@K"
@ 10, 03 SAY "Pago....:" GET oTb:Pago PICTURE "@K"
@ 11, 03 SAY "Pagado..:" GET oTb:Pagado PICTURE "@K"
@ 12, 03 SAY "Banco...:" GET oTb:Banco PICTURE "@K"
@ 13, 03 SAY "Fecha...:" GET oTb:Fecha PICTURE "@K"
@ 14, 03 SAY "Importe.:" GET oTb:Importe PICTURE "@K"
@ 15, 03 SAY "Password:" GET oTb:Password PICTURE "@K"
return( GetList )
//----------------------------------------------------------------------------//
static function Insertar( oTb, oBrw )
local GetList := {}
local lOk := .f.
local cPant := SaveScreen( 3, 2, 16, 74 )
oTb:xBlank()
GetList := PantMuestra( oTb, "Altas" )
READ
set cursor off
RestScreen( 3, 2, 16, 74, cPant )
INSERT INTO oTb TO lOk
if lOk
MyMsgInfo( "Tupla insertada" )
if MyMsgYesNo( "Refresca el Browse?" )
oTb:Refresh()
oBrw:goBottom()
oBrw:RefreshAll()
endif
endif
return( nil )
//----------------------------------------------------------------------------//
static function Modificar( oTb, oBrw )
local lOk := .f.
local GetList := {}
local nRecNo := oTb:RecNo()
local cPant := SaveScreen( 3, 2, 16, 74 )
oTb:xLoad()
GetList := PantMuestra( oTb, "Actualizacion" )
READ
set cursor off
RestScreen( 3, 2, 16, 74, cPant )
UPDATE oTb TO lOk
if lOk
MyMsgInfo( "Tupla modificada" )
if MyMsgYesNo( "Refresca el Browse?" )
oTb:Refresh()
oTb:GoTo( nRecNo )
oBrw:RefreshAll()
endif
endif
return( nil )
//----------------------------------------------------------------------------//
static function Borrar( oTb, oBrw )
local lOk := .f.
local nRecNo := oTb:RecNo()
if MyMsgYesNo( "Realmente quieres borrar el registro?" )
DELETE FROM oTb LIMIT 1 TO lOk
if lOk
MyMsgInfo( "Borrado en el servidor" )
if MyMsgYesNo( "Refresca el Browse?" )
oTb:Refresh()
oTb:GoTo( nRecNo - 1 )
oBrw:RefreshAll()
endif
endif
else
MyMsg( "Mo se ha borrado..." )
endif
return( nil )
//----------------------------------------------------------------------------//
static function ElOrden( oTb )
local i := oTb:FCount()
local aFld := Array( i )
local n := 0
local lRet := .f.
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 )
oTb:SetOrder( i )
endif
return( lRet )
//----------------------------------------------------------------------------//
static function BuscaValor( oTb )
local GetList := {}
local nCol := 0
local lRet := .f.
local uVal
DispBox( 5, 5, 8, 75, B_BOX )
@ 6, 10 SAY "Entre numero de columna:" GET nCol PICTURE "@K"
READ
uVal := oTb:xFieldGet( nCol )
@ 7, 10 SAY "Entre valor buscado:" GET uVal PICTURE "@K"
READ
lRet := oTb:Find( nCol, uVal, .t. )
return( lRet )
//----------------------------------------------------------------------------//
//---------------------------------------------------------------------------//
#include "Eagle1.ch"
#include "FiveWin.ch"
#include "dtpicker.ch"
#include "calendar.ch"
//---------------------------------------------------------------------------//
// Son estaticas para que sean visibles desde todo el PRG un poco por
// comodidad
static oConnect // Objeto conexion
static oDS // Objeto DataSet
static oWnd // Objetos de FWH
//---------------------------------------------------------------------------//
function main()
SET DATE FORMAT TO "DD/MM/YYYY"
if AbrirTodo()
DEFINE WINDOW oWnd FROM 4, 4 TO 40, 120 ;
TITLE "Ejemplo de manteniento de una tabla con Eagle1 y FWH" ;
MENU BuildMenu()
SET MESSAGE OF oWnd NOINSET;
TO oDS:cVersion + " por " + oDS:cAuthor CLOCK DATE
ACTIVATE WINDOW oWnd
else
Salir()
endif
return( nil )
//----------------------------------------------------------------------------//
function BuildMenu()
local oMenu
MENU oMenu
MENUITEM "&Mantenimiento" ACTION Mantenimiento()
MENUITEM "&Utilities"
MENU
MENUITEM "&Calculadora" ACTION WinExec( "Calc" ) ;
MESSAGE "Lamando a la calculadora de Windows"
SEPARATOR
MENUITEM "&Escribir" ACTION WinExec( "Write" ) ;
MESSAGE "Llamando a Write de Windows"
ENDMENU
MENUITEM "&Salir"
MENU
MENUITEM "&Acerca de..." ;
ACTION MsgAbout( oDS:cAuthor, oDS:cVersion ) ;
MESSAGE "Informa sobre la versión de Eagle1"
SEPARATOR
MENUITEM "&Salir";
ACTION Salir();
MESSAGE "Salir del ejemplo de Eagle1 y FWH"
ENDMENU
ENDMENU
return oMenu
//----------------------------------------------------------------------------//
//
static function AbrirTodo()
local cHost := "127.0.0.1 "
local cUser := "root "
local cPassword := "root "
local cDbName := "E1Prueba "
local cTabla := "Test"
local lRet
local oDlg
DEFINE DIALOG oDlg FROM 2, 2 TO 14, 35;
TITLE "Datos de conexión" ;
STYLE nOr( DS_MODALFRAME, WS_POPUP, WS_CAPTION, WS_SYSMENU, 4 )
@ 01, 01 SAY "Host:" OF oDlg
@ 01, 05 GET cHost PICTURE "@K" UPDATE OF oDlg
@ 1.8, 01 SAY "Usuario:" OF oDlg
@ 02, 05 GET cUser PICTURE "@K" UPDATE OF oDlg
@ 2.6, 01 SAY "Password:" OF oDlg
@ 03, 05 GET cPassword PICTURE "@K" UPDATE OF oDlg
@ 3.4, 01 SAY "Base datos:" OF oDlg
@ 04, 05 GET cDbName PICTURE "@K" UPDATE OF oDlg
@ 4, 7 BUTTON "&Acptar" ACTION oDlg:End() OF oDlg
ACTIVATE DIALOG oDlg CENTERED
cHost := trim( cHost )
cUser := trim( cUser )
cPassword := trim( cPassword )
cDbName := trim( cDbName )
// Creamos el objeto "connexion"
oConnect := TMSConnect():New()
// Nos conectamos al servidor
lRet := oConnect:Connect( cHost, cUser, cPassword, cDbName )
if !lRet
MsgInfo( "No hay conexión con el servidor", "Operación Cancelada" )
else
oDS := TMyTable():New( oConnect, cTabla )
oDS:SetReadPADAll( .t. )
oDS:SetTinyAsLogical( .t. )
// Abrimos la tabla, traemos el resultado a nuestro cliente
lRet := oDS:Open()
if !lRet
MsgInfo( "No se puede abrir la tabla: " + cTabla, "Operación Cancelada" )
endif
endif
return( lRet )
//----------------------------------------------------------------------------//
//
static procedure Salir()
if ValType( oDS ) == "O"
oDS:Free()
endif
if ValType( oConnect ) == "O"
oConnect:Free()
endif
if ValType( oWnd ) == "O"
oWnd:End()
endif
return
//----------------------------------------------------------------------------//
static procedure Mantenimiento()
local oDlg, oLbx
DEFINE DIALOG oDlg FROM 3, 3 TO 40, 100 TITLE "Mantenimiento tabla TEST"
@ 00, 01 SAY " &Datos tabla..." OF oDlg
@ 01,01 LISTBOX oLbx ;
FIELDS ;
PadL( oDS:FieldGet( 1 ), 6, " " ),;
oDS:FieldGet( 2 ), ;
oDS:FieldGet( 3 ), ;
oDS:FieldGet( 4 ), ;
oDS:FieldGet( 5 ), ;
oDS:FieldGet( 6 ), ;
oDS:FieldGet( 7 ), ;
oDS:FieldGet( 9 ), ;
oDS:FieldGet( 8 ) ;
HEADERS ;
oDS:FieldName( 1 ), ;
oDS:FieldName( 2 ), ;
oDS:FieldName( 3 ), ;
oDS:FieldName( 4 ), ;
oDS:FieldName( 5 ), ;
oDS:FieldName( 6 ), ;
oDS:FieldName( 7 ), ;
oDS:FieldName( 9 ), ;
oDS:FieldName( 8 ) ;
SIZE 365, 220 OF oDlg
MySetBrowse( oLbx, oDS ) // Asigna los codeBlock de movimiento
oLbx:cAlias := "ARRAY" // Para que el gestor de listados no de error
oLbx:lCellStyle := .t.
@ 14, 01 BUTTON "&Añadir" OF oDlg SIZE 35, 12;
ACTION CtrDatos( oLbx, .t. )
@ 14, 08 BUTTON "&Modificar" OF oDlg SIZE 35, 12;
ACTION CtrDatos( oLbx, .f. )
@ 14, 15 BUTTON "&Borrar" OF oDlg SIZE 35, 12;
ACTION Borrar( oLbx )
@ 14, 22 BUTTON "&Ordenar" OF oDlg SIZE 35, 12;
ACTION Ordernar( oLbx )
@ 14, 29 BUTTON "B&uscar" OF oDlg SIZE 35, 12;
ACTION Buscar( oLbx )
@ 14, 36 BUTTON "Listar" OF oDlg SIZE 35, 12;
ACTION ( oLbx:Report( "Listado de la tabla", .t. ), oDS:GoTop() )
@ 14, 57 BUTTON "&Salir" OF oDlg ;
ACTION oDlg:End() SIZE 35, 12
ACTIVATE DIALOG oDlg CENTERED
return
//----------------------------------------------------------------------------//
// Borra la fila actual
static procedure Borrar( oBrw )
local nRecNo := oDS:RecNo()
if MsgYesNo( "Realmente quiere borrar el registro " + StrNum( oDS:RecNo() ) + "?" )
if oDS:Delete( , 1 )
MyMsgInfo( "Borrado en el servidor" )
if MsgYesNo( "Refresca la lista?" )
oDS:Refresh()
oDS:GoTo( nRecNo )
oBrw:Refresh()
endif
endif
else
MyMsgInfo( "No se ha borrado..." )
endif
return
//----------------------------------------------------------------------------//
// Establece un nuevo orden de visualizacion
static procedure Ordernar( oLbxPrincipal )
local oDlg, oLbx
local i := oDS:FieldCount()
local aFld := Array( i )
local n, cValue
FOR n := 1 TO i
aFld[ n ] := oDS:FieldName( n )
NEXT
n := 0
DEFINE DIALOG oDlg FROM 2, 2 TO 18, 30;
TITLE "Eagle1, FW y ListBox" ;
STYLE nOr( DS_MODALFRAME, WS_POPUP, WS_CAPTION, WS_SYSMENU, 4 )
@ 1, 02 LISTBOX oLbx;
VAR cValue;
ITEMS aFld;
SIZE 80, 70;
OF oDlg
@ 5, 02 BUTTON "&Seleccionar";
OF oDlg;
SIZE 40, 12;
DEFAULT;
ACTION ( MyMsgInfo( "Orden: " + Str( n := oLbx:GetPos() ) + ;
+ CRLF + "Nombre del campo: " + cValue, "Has elegido" ), ;
oDlg:End() )
@ 5, 10 BUTTON "&Salir";
OF oDlg;
SIZE 40, 12;
ACTION oDlg:End()
ACTIVATE DIALOG oDlg CENTERED
if n != 0 .and. oDS:SetOrderBy( n,, .t. )
oLbxPrincipal:GoTop()
oLbxPrincipal:Refresh()
else
MyMsgInfo( "No se ha establacido otro orden..." )
endif
return
//----------------------------------------------------------------------------//
static procedure Buscar( oLb )
local oDlg
local i := oDS:FieldCount()
local n := 1
local oSay, cSay := "&Valor campo "
local oGet, uVal
DEFINE DIALOG oDlg FROM 2, 2 TO 12, 70;
TITLE "Búsqueda de valores en el DataSet" ;
STYLE nOr( DS_MODALFRAME, WS_POPUP, WS_CAPTION, WS_SYSMENU, 4 )
@ 01, 01 SAY "&Numero de columna ( 1 - " + StrNum( i ) + " ):" OF oDlg
@ 01, 10 GET n PICTURE "999" ;
VALID ( uVal := oDS:FieldGet( n ), oGet:Refresh(), ;
oSay:SetText( cSay + oDS:FieldName( n ) ), n > 0 .and. n <= i ) ;
OF oDlg
@ 02, 01 SAY oSay VAR cSay OF oDlg
@ 02, 10 GET oGet VAR uVal SIZE 160, 13 OF oDlg
@ 3, 02 BUTTON "&Buscar";
OF oDlg;
SIZE 40, 12;
ACTION ( if( oDS:Find( n, uVal, .t. ), ;
MyMsgInfo( "Valor encontrado" ), ;
MyMsgInfo( "Valor no encontrado" ) ), oLb:Refresh() )
@ 3, 10 BUTTON "S&iguiente";
OF oDlg;
SIZE 40, 12;
ACTION ( if( !oDS:FindNext(), MyMsgInfo( "No hay más. Se llegó al final" ), ), ;
oLb:Refresh() )
@ 3, 18 BUTTON "&Salir";
OF oDlg;
SIZE 40, 12;
ACTION oDlg:End()
ACTIVATE DIALOG oDlg
return
//----------------------------------------------------------------------------//
static procedure CtrDatos( oLb, lNuevo )
local oDlg
local cQueHago
local nRec := oDS:RecNo()
if lNuevo
cQueHago := "Altas"
oDS:Blank()
else
cQueHago := "Modificación"
oDS:Load()
endif
DEFINE DIALOG oDlg FROM 2, 2 TO 30, 77;
TITLE "Mantenimiento de la tabla Test - " + cQueHago;
STYLE nOr( DS_MODALFRAME, WS_POPUP, WS_CAPTION, WS_SYSMENU, 4 )
@ 01, 02 SAY "First" OF oDlg
@ 02, 1.5 GET oDS:First PICTURE "@K" UPDATE OF oDlg
@ 01, 26.6 SAY "Last" OF oDlg
@ 02, 20 GET oDS:Last PICTURE "@K" UPDATE OF oDlg
@ 2.8, 02 SAY "Street" OF oDlg
@ 4, 1.5 GET oDS:Street PICTURE "@K" UPDATE OF oDlg
@ 2.8, 26.6 SAY "City" OF oDlg
@ 4, 20 GET oDS:City PICTURE "@K" UPDATE OF oDlg
@ 4.6, 02 SAY "State" OF oDlg
@ 6, 1.5 GET oDS:State PICTURE "@K XX" UPDATE OF oDlg
@ 4.6, 5.5 SAY "Zip" OF oDlg
@ 6, 4 GET oDS:Zip PICTURE "@K 99999-9999" UPDATE OF oDlg
@ 4.6, 13.9 SAY "Hiredate" OF oDlg
@ 78, 83 DTPICKER oDS:Hiredate UPDATE PIXEL SIZE 50, 11 OF oDlg
// @ 6, 10 GET oDS:Hiredate PICTURE "@K" UPDATE OF oDlg
@ 5.7, 22 CHECKBOX oDS:Married PROMPT "Married" UPDATE OF oDlg
@ 4.6, 33 SAY "Age" OF oDlg
@ 6, 24.5 GET oDS:Age PICTURE "@K 999" UPDATE OF oDlg
@ 4.6, 37.5 SAY "Salary" OF oDlg
@ 6, 28 GET oDS:Salary PICTURE "@KE 9,999,999.999" UPDATE OF oDlg
//..................... El campo MEMO...............................................
@ 6.4, 02 SAY "Notes" OF oDlg
@ 8.1, 1.5 GET oDS:Notes MEMO UPDATE OF oDlg SIZE 270, 65
//..................................................................................
@ 10.5, 02 BUTTON "&Guardar";
OF oDlg;
SIZE 40, 12;
ACTION ( FuncVale( lNuevo ), oLb:Refresh(), oDlg:End() )
@ 10.5, 10 BUTTON "&Cancelar";
OF oDlg;
SIZE 40, 12;
ACTION ( if( lNuevo, oDS:Blank(), oDS:Load() ), oDlg:Update() )
@ 10.5, 18 BUTTON "&Salir";
OF oDlg;
SIZE 40, 12;
ACTION oDlg:End()
ACTIVATE DIALOG oDlg
return
//----------------------------------------------------------------------------//
static procedure FuncVale( lNuevo )
local nRec
if lNuevo
oDS:insert( .t. )
oDS:GoBottom()
else
nRec := oDS:RecNo()
oDS:Update( .t. )
oDS:GoTo( nRec )
endif
return
//----------------------------------------------------------------------------//
Return to FiveWin para Harbour/xHarbour
Users browsing this forum: Google [Bot] and 14 guests