Tratamiento de Blob y memos con Eagle1

[xmanuel]

Aquí tenéis una manera fácil de usar imágenes en vuestras aplicaciones hechas con Eagle1:

Code: Select all  Expand view  RUN

//----------------------------------------------------------------------------//
// Soft4U Manu Exposito                                                       //
// Eagle1 Clases para manejo de MySQL desde xBase                             //
//                                                                            //
// Pt18 : Ejemplo de connexion a MySQL y uso de BLOBs y MEMOs                 //
//----------------------------------------------------------------------------//

#include "InKey.ch"
#include "Eagle1.ch"

//----------------------------------------------------------------------------//

procedure main()

    local oCon, oDataSet // Objetos
    local cHost := "127.0.0.1"
    local cUser := "root"
    local cPwd := "root"
    local cDb := "E1Prueba"

    // Datos de la tabla
    local cTable := "TestMemo"
    local aStruct := { { "cmMiTexto", "M", 10, 0 } } // Array como lo devuelve DbStruct()
    local cType := "BTREE"  // Tipo de tabla en el servidor
    local lTemporary := .f. // Indicador si es una tebla temporal
    local lNotExists := .t. // Indicador de que la cree sólo si no existe

    cls

    // Creamos objeto conexion
    oCon := TMSConnect():New()

    // Intentamos la conexion
    if oCon:Connect( cHost, cUser, cPwd, cDb )
/*
        // Desmarca esto para ficheros de hasta 16m o cambia según convenga:

        // Por defecto max_allowed_packet está a 1 Mb por lo que da el error
        // si el Blob es mayor de 1Mb lo aumentamos a 16 M para evitar el error:
        // "MySQL server has gone away"
        oCon:Execute( "set @@global.max_allowed_packet=16*1024*1024" )
        // Hacemos una reconexion para que asuma la variable cambiada:
        oCon:ReConnect()
        // Comprobamos las variables:
        oDataSet := TMSQuery():New( oCon, "SHOW VARIABLES" )
        oDataSet:Open()
        GestBrw( oDataSet )
        oDataSet:Free()
*/
        // Si existe la tabla la borramos, sólo en esta demo ;-)
        if oCon:oDataBase:DropTable( cTable )
            MyMsg( "La tabla " + cTable + " ha sido borrada..." )
        endif
        // Creamos el objeto Tabla
        oDataSet := TMSTable():New( oCon, cTable )
        // Creamos la Tabla si no existe
        if oDataSet:CreateTable( aStruct, cType, lTemporary, lNotExists )
            MyMsg( "Tabla lista..." )
        else
            MyMsg( "Error en CreateTable()" )
            oDataSet:Free() // Liberamos todo
            oCon:Free()
            Quit
        endif

        // Abrimos y nos traemos el resultado al cliente
        if oDataSet:Open()

            //--------------------------------------------------
            // CREAR UN REGISTRO A PARTIR DE UN FICHERO

            // Controlamos la existencia del fichero de entrada
            if File( "pt18.prg" )
                // Limpiamos el buffer estilo xBase
                oDataSet:Blank()
                // Cargamos el buffer interno con el contenido del fichero de cualquier tipo, en este caso
                // con lo que haya en TEST.IN, podria ser jpg, gif, texto, sonido o lo que sea...
                oDataSet:SetBuffer( 1, oDataSet:ReadFromFile( "pt18.prg" ) )

                // Lo insertamos en la tabla
                if !oDataSet:Insert( .t. )
                    MyMsg( "No se pudo insertar el registro..." )
                end
            else
                MyMsg( "No encuentro el fichero de entrada..." )
            endif

            //--------------------------------------------------
            // CREAR UN FICHERO A PARTIR DE UNA COLUMNA

            if oDataSet:RecCount() > 0
                // Nos vamos al primero
                oDataSet:GoTop()
                // Si existe el fichero de salida lo borramos
                if File( "Test.txt" )
                    FErase( "Test.txt" )
                endif
                // Creamos el fichero de salida Test.out a partir de la columna 1
                // que puede ser de cualquier tipo, especialmente BLOBs
                if oDataSet:WriteToFile( 1, "test.txt" )
                    MyMsg( "Vamos a ver el fichero de salida..." )
                    // Lo presentamos en pantalla:
                    DispBox( 00, 00, 24, 79 )
                    MemoEdit( MemoRead( "test.txt" ), 01, 01, 23, 78, .f. )
                else
                    MyMsg( "Error al crear el fichero de salida" )
                endif
            else
                MyMsg( "No hay registros en la tabla..." )
            endif
        else
            MyMsg( "Error al abrir la tabla: " + oDataSet:cName )
        endif

        oDataSet:Free() // Liberamos todo
        oCon:Free()
    else
        MyMsgInfo( "No hay conexion", "Ojo" )
    endif

return

//----------------------------------------------------------------------------//

#include "SimpleBrw.prg"

//----------------------------------------------------------------------------//


[xmanuel]

Code: Select all  Expand view  RUN

//----------------------------------------------------------------------------//
// Soft4U 2008 Manu Exposito                                                  //
//                                                                            //
// Eagle1 Clases para manejo de MySQL desde xBase                             //
// SimpleBrw: Ejemplo de Browse para Eagle1                                   //
//----------------------------------------------------------------------------//

//----------------------------------------------------------------------------//
// Gestion del Browse

#include "InKey.ch"

#define B_BOX ( CHR( 218 ) + CHR( 196 ) + CHR( 191 ) + CHR( 179 ) + ;
                CHR( 217 ) + CHR( 196 ) + CHR( 192 ) + CHR( 179 ) + " " )

//----------------------------------------------------------------------------//

static procedure GestBrw( oDS, cName )

    local oBrw, oCol
    local lEnd := .f.
    local nKey, n, nFld
    local cFlechas := chr( 27 ) + chr( 24 ) + chr( 25 ) + chr( 26 )
    static lPad := .f.

    if oDS:RecCount() < 1 // Comprobamos que hay registros
        Alert( "No hay registros" )
        return
    endif

    if ValType( cName ) != "C"
        cName := " la consulta"
    else
        cName := " la tabla " + upper( cName )
    endif

    oBrw := TBrowseNew( 1, 0, MaxRow() - 1, MaxCol() )

    oBrw:colorSpec := "W+/B, N/BG"
    oBrw:ColSep    := " ³ "
    oBrw:HeadSep   := "ÄÅÄ"
    oBrw:FootSep   := "ÄÁÄ"

    MySetBrowse( oBrw, oDS )

    nFld := oDS:FieldCount()

    FOR n := 1 TO nFld
        oBrw:AddColumn( TBColumnNew( oDS:FieldName( n ), GenCB( oDS, n ) ) )
    NEXT


    cls

    @ 0, 0 SAY PadC( "Ojeando" + cName, MaxCol() + 1, " " ) COLOR "W+/G+"

    @ MaxRow(),         0 SAY space( 100 )  COLOR "W+/G+"
    @ MaxRow(),         0 SAY cFlechas      COLOR "GR+/R+"
    @ MaxRow(), Col() + 1 SAY "Moverse"     COLOR "W+/R+"
    @ MaxRow(), Col() + 1 SAY "F3"          COLOR "GR+/R+"
    @ MaxRow(), Col() + 1 SAY "PAD Todo"    COLOR "W+/R+"
    @ MaxRow(), Col() + 1 SAY "F5"          COLOR "GR+/R+"
    @ MaxRow(), Col() + 1 SAY "Buscar"      COLOR "W+/R+"
    @ MaxRow(), Col() + 1 SAY "F6"          COLOR "GR+/R+"
    @ MaxRow(), Col() + 1 SAY "Siguiente"   COLOR "W+/R+"
    @ MaxRow(), Col() + 1 SAY "F8"          COLOR "GR+/R+"
    @ MaxRow(), Col() + 1 SAY "INTRO"       COLOR "GR+/R+"
    @ MaxRow(), Col() + 1 SAY "Ver"         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_F3
              oDS:SetReadPADAll( lPad := !lPad )
              oBrw:Configure()

         case nKey == K_F5
            if BuscaValor( oDS )
                Alert( "Encontrado..." )
            else
                Alert( "Valor no encontrado..." )
                oDS:GoTop()
            endif
            oBrw:RefreshAll()

         case nKey == K_F6
            if !oDS:FindNext()
                Alert( "Ya no hay más registros con ese valor..." )
            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_INTRO
            Muestra( oDS:GetRow(), "Contenido del registro " + StrNum( oDS:RecNo() ) )

         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()

      endcase

   end

return

//----------------------------------------------------------------------------//
// Creacion del CodeBlock de lectura de columnas

static function GenCB( oDS, n )
return( { || oDS:FieldGet( n ) } )

//----------------------------------------------------------------------------//
// Busca un valor secuencialmente

static function BuscaValor( oDS )

    local GetList := {}
    local nCol := 1
    local lRet, uVal

    DispBox( 5, 5, 8, 75, B_BOX )

    @ 6, 10 SAY "Entre numero de columna:" GET nCol PICTURE "@K"
    READ

    uVal := oDS:FieldGet( nCol )

    @ 7, 10 SAY "Entre valor buscado:" GET uVal PICTURE "@K"
    READ

    lRet := oDS:Find( nCol, uVal, .t. )

return( lRet )

//----------------------------------------------------------------------------//