Herramienta para MySQL – Código Liberado IV

MySQLInfo.prg – Parte IV

*------------------------------------------------------------*
PROCEDURE setMessage( cMessage, nItem )
*------------------------------------------------------------*
    // Establece el mensaje en la barra de estado.-------------------------
    if cMessage==Nil
        setProperty( "wndPrincipal", "StatusBar", "Item", 1, " " )
        setProperty( "wndPrincipal", "StatusBar", "Item", 2, " " )
    else
        setProperty( "wndPrincipal", "StatusBar", "Item", nItem, " "+cMessage )
    endif
RETURN

*------------------------------------------------------------*
Function EncDec( cClave, nOp )       // 1=Encripta 2=Decripta
*------------------------------------------------------------*
    local cCad := '', let, a, conv
    local nEnc := Len( cClave )
    For a = 1 to nEnc
        let  := SubStr( cClave, a, 1 )
        conv := Iif( nOp==1, Asc( let ) + 100 + a, Asc( let ) - 100 - a )
        cCad += Chr( conv )
    Next
return( cCad )

*------------------------------------------------------------*
Procedure ExportaTabla( nOpc )
*------------------------------------------------------------*
    LOCAL oExp, cTime, cExpFile, aExt := {".txt",".xlsx",".dbf",".html",".docx",".sql"}

    nOpc := Iif( Empty(nOpc), 2, nOpc )

    IF MsgYesNo( "¿Desea Exportar Tabla a Formato "+aExt[nOpc]+"?", _GEN_PROGRAMA )

        If IsControlDefined("treArbol","wndPrincipal")
            nItem := getProperty( "wndPrincipal", "treArbol", "Value" )
            If !Empty(nItem)
                If nItem >= 10000 .AND. nItem <= 99999
                    cBase := getProperty( "wndPrincipal", "treArbol", "Item", nItem )
                    oQry  := oServidor:Query( "SELECT * FROM "+cBase )
                    oQry:GoTop()
                    If     nOpc == EXP_DBF
                        oExp = oQry:Export( EXP_DBF, cBase+".dbf" )
                        cExpFile := cBase+".dbf"
                    ElseIf nOpc == EXP_HTML
                        oExp = oQry:Export( EXP_HTML, cBase+".html" )
                        cExpFile := cBase+".html"
                    ElseIf nOpc == EXP_SQL
                        oExp = oQry:Export( EXP_SQL, cBase+".sql" )
                        cExpFile := cBase+".sql"
                    ElseIf nOpc == EXP_TEXT
                        oExp = oQry:Export( EXP_TEXT, cBase+".txt" )
                        cExpFile := cBase+".txt"
                    ElseIF nOpc == EXP_EXCEL
                        SaveToXls( CurDrive() + ":\" + CurDir() +"\"+cBase+".xlsx", oQry )
                        cExpFile := cBase+".xlsx"
                    ElseIF nOpc == EXP_WORD
                        oExp = oQry:Export( EXP_WORD, hb_CurDrive()+":\" + CurDir() +"\"+cBase, , )
                        cExpFile := cBase+".docx"
                    Else
                        nOpc := EXP_EXCEL
                        SaveToXls( CurDrive() + ":\" + CurDir() +"\"+cBase+".xlsx", oQry )
                        cExpFile := cBase+".xlsx"
                    Endif
                    if !nOpc == EXP_EXCEL
                        oExp:bOnStart := { || setmessage( "Started    : "+ Time(), 1 ), cTime := Time() }
                        iif( nOpc==EXP_SQL, oExp:bOnRow   := { | n | ShowLine( n, oQry:LastRec() ) }, ;
                            oExp:bOnRow   := { | o, n | ShowLine( n, oQry:LastRec() ) } )
                        oExp:bOnEnd := { || setmessage( " Elapse time: " + ElapTime( cTime, Time() )+ " Archivo Creado: "+cExpFile ,1) }
                        oExp:Start()
                    Endif
                Endif
            Endif
        Endif

    Endif
Return

*------------------------------------------------------------*
PROCEDURE ShowLine( n, nTotal )
*------------------------------------------------------------*
    if !Empty(n)
        setmessage( Str( n / nTotal * 100 ) + "%", 2 )
    Endif
RETURN

*------------------------------------------------------------*
Procedure SaveToXls( cFile, oQuery )
*------------------------------------------------------------*
    Local oExcel,  oSheet, oBook, aColumns

    IF ( oExcel := win_oleCreateObject("Excel.Application" ) ) == NIL
        MsgStop( "ERROR! Excel is not available. ["+ Ole2TxtError()+ "]" )
        Return
    ENDIF

    setmessage( "Started    : "+ Time(), 1 ) ; cTime := Time()

    oExcel:Visible := .F.
    oExcel:WorkBooks:Add()
    oSheet := oExcel:ActiveSheet()

    For i := 1 to oQuery:FCount()
        oSheet:Cells( 1, i ):Value := oQuery:FieldName(i)
    Next

    For nCell := 1 to oQuery:LastRec()
        oQuery:GoTo( nCell )
        aColumns :=  Scatter( oQuery )
        aEval( aColumns, { |e,i| oSheet:Cells( nCell+1, i ):Value := e } )
        ShowLine( nCell, oQry:LastRec() )
        Do Events
    Next

    oBook := oExcel:ActiveWorkBook
    oBook:Title   := GetName( cFile )
    oBook:Subject := GetName( cFile )
    oBook:SaveAs( cFile )
    setmessage( " Elapse time: " + ElapTime( cTime, Time() )+ " Archivo Creado: "+GetName(cFile) ,1)
    oExcel:Quit()

Return

*------------------------------------------------------------*
FUNCTION GetName(cFileName)
*------------------------------------------------------------*
    LOCAL cTrim  := ALLTRIM(cFileName)
    LOCAL nSlash := MAX(RAT('\', cTrim), AT(':', cTrim))
    LOCAL cName  := IF(EMPTY(nSlash), cTrim, SUBSTR(cTrim, nSlash + 1))
RETURN( cName )

*------------------------------------------------------------*
FUNCTION DelExt(cFileName)
*------------------------------------------------------------*
    LOCAL cTrim  := ALLTRIM(cFileName)
    LOCAL nDot   := RAT('.', cTrim)
    LOCAL nSlash := MAX(RAT('\', cTrim), AT(':', cTrim))
    LOCAL cNamew := IF(nDot <= nSlash .OR. nDot == nSlash + 1, ;
        cTrim, LEFT(cTrim, nDot - 1))
RETURN( cNamew )

*------------------------------------------------------------*
Function Scatter( oQry )
*------------------------------------------------------------*
    Local aRecord[oQry:FCount()]
Return aEval( aRecord, {|x,n| aRecord[n] := oQry:FieldGet( n,x ) } )

*------------------------------------------------------------*
Function Gather( oQry )
*------------------------------------------------------------*
    Local aRecord := Scatter( oQry )
Return aEval( aRecord, {|x,n| oQry:FieldPut( n, x ) } )

*------------------------------------------------------------*
Procedure ImportaTabla()
*------------------------------------------------------------*
    LOCAL cTable  := "", aNew := {}
    LOCAL cAlias  := ""
    LOCAL aTypes  := { {'Database files (*.dbf)', '*.dbf'} }

    If !Empty( aNewFile := GetFile( aTypes, 'Selecciona Base de Datos DBF', CurDir(), .T. ) )
        cAlias   := DelExt( GetName( aNewFile[1] ) )
        cTable   := AllTrim( InputBox( 'Ingresa Nombre de Tabla a Crear:' , _GEN_PROGRAMA ) )
    Endif

    If !Empty(cAlias) .and. !Empty(cTable)

        If IsControlDefined("treArbol","wndPrincipal")
            nItem := getProperty( "wndPrincipal", "treArbol", "Value" )
            If !Empty(nItem)
                If nItem >= 100 .AND. nItem <= 999
                    cBase := getProperty( "wndPrincipal", "treArbol", "Item", nItem )
                    oServidor:SelectDB( cBase )

                    setmessage( "Inicio de Importación: "+ Time(), 1 ) ; cTime := Time()

                    USE ( cAlias ) ALIAS ( cAlias )

                    aStru := ( cAlias )->( DbStruct() )

                    aNew := AClone( aStru )
                    For i := 1 to Len( aNew )
                        Aadd( aNew[i], .F. )
                        Aadd( aNew[i], NIL )
                    Next

                    oServidor:Execute( "DROP TABLE IF EXISTS "+cTable )
                    oServidor:CreateTable( cTable, aNew )

                    If !( oServidor:lError )

                        oServidor:InsertFromDbf( cTable, cAlias , , ,{ || ShowLine( (cAlias)->(RecNo() ), (cAlias)->(LastRec() ) ) } )
                        setmessage( "Lapso Transcurrido: " + ElapTime( cTime, Time() )+ "  Nueva Tabla Creada: "+cTable ,1)

                        UpdateTree()

                    Endif

                Endif
            Endif
        Endif

    Endif
Return

*------------------------------------------------------------*
Procedure EliminaTabla()
*------------------------------------------------------------*

    IF MsgYesNo( "¿Desea Eliminar Tabla?", _GEN_PROGRAMA )

        If IsControlDefined("treArbol","wndPrincipal")
            nItem := getProperty( "wndPrincipal", "treArbol", "Value" )
            If !Empty(nItem)
                If nItem >= 10000 .AND. nItem <= 99999
                    cTabla := getProperty( "wndPrincipal", "treArbol", "Item", nItem )
                    oServidor:Execute( "DROP TABLE IF EXISTS "+cTabla )
                    If !( oServidor:lError )
                        UpdateTree()
                    Endif
                Endif
            Endif
        Endif
    Endif

Return

*------------------------------------------------------------*
Procedure CtrlConecta()
*------------------------------------------------------------*
  IF !_lConectado

    DEFINE WINDOW CtrlVentana OBJ oWnd AT 182 , 607 WIDTH 700 HEIGHT 420 MODAL ON INIT AbrirIni() ON RELEASE GuardaIni() ;
           ICON "A_ICO_32_MAIN" TITLE "Administrador de sesiones" NOSIZE NOMINIMIZE NOMAXIMIZE

        @ 10, 10 LISTBOX Grid_1 OBJ oGrid                     ;
          WIDTH  220                                          ;
          HEIGHT 330                                          ;
          ITEMS  Nil                                          ;
          FONT   'Arial'                                      ;
          ON CHANGE CambiaDatos( CtrlVentana.Grid_1.Value )   ;
          IMAGE  {"Delfin"}

/*
        DEFINE LISTBOX Grid_1
        ROW    10
        COL    10
        WIDTH  220
        HEIGHT 330
        ITEMS  Nil
        HEADERS {'Nombre Conexión'}
        FONTNAME 'Arial'
        ON CHANGE CambiaDatos( CtrlVentana.Grid_1.Value )
        MULTISELECT .T.
        IMAGE {"Delfin"}
        END LISTBOX
*/
        DEFINE BUTTON Button_1
        ROW    350
        COL    10
        WIDTH  70
        HEIGHT 26
        CAPTION "Nueva"
        FONTNAME 'Arial'
        TOOLTIP ''
        ACTION NuevaSesion()
        END BUTTON

        DEFINE BUTTON Button_2
        ROW    350
        COL    85
        WIDTH  70
        HEIGHT 26
        CAPTION "Guardar"
        FONTNAME 'Arial'
        TOOLTIP ''
        ACTION GuardaIni()
        END BUTTON

        DEFINE BUTTON Button_3
        ROW    350
        COL    160
        WIDTH  70
        HEIGHT 26
        CAPTION "Borrar"
        FONTNAME 'Arial'
        TOOLTIP ''
        ACTION BorrarSesion()
        END BUTTON

        DEFINE FRAME Frame_1
        ROW    10
        COL    240
        WIDTH  430
        HEIGHT 330
        FONTNAME 'Arial'
        CAPTION "Ajustes"
        OPAQUE .T.
        END FRAME

        DEFINE LABEL Label_1
        ROW    50
        COL    260
        WIDTH  120
        HEIGHT 24
        VALUE "Servidor / IP:"
        END LABEL

        DEFINE LABEL Label_2
        ROW    90
        COL    260
        WIDTH  120
        HEIGHT 24
        VALUE "Usuario:"
        END LABEL

        DEFINE LABEL Label_3
        ROW    130
        COL    260
        WIDTH  120
        HEIGHT 24
        VALUE "Contraseña:"
        END LABEL

        DEFINE LABEL Label_4
        ROW    170
        COL    260
        WIDTH  120
        HEIGHT 24
        VALUE "Puerto:"
        END LABEL

        DEFINE LABEL Label_5
        ROW    210
        COL    260
        WIDTH  120
        HEIGHT 24
        VALUE "Base de datos:"
        END LABEL

        DEFINE LABEL Label_6
        ROW    290
        COL    260
        WIDTH  120
        HEIGHT 24
        VALUE "Flags:"
        END LABEL

        DEFINE TEXTBOX Text_1
        ROW    50
        COL    390
        WIDTH  260
        HEIGHT 24
        FONTNAME 'Arial'
        ON LOSTFOCUS CambiaText( 1 )
        END TEXTBOX

        DEFINE TEXTBOX Text_2
        ROW    90
        COL    390
        WIDTH  260
        HEIGHT 24
        FONTNAME 'Arial'
        ON LOSTFOCUS CambiaText( 2 )
        END TEXTBOX

        DEFINE TEXTBOX Text_3
        ROW    130
        COL    390
        WIDTH  260
        HEIGHT 24
        FONTNAME 'Arial'
        ON LOSTFOCUS CambiaText( 3 )
        PASSWORD .T.
        END TEXTBOX

        DEFINE TEXTBOX Text_4
        ROW    210
        COL    390
        WIDTH  260
        HEIGHT 24
        FONTNAME 'Arial'
        ON LOSTFOCUS CambiaText( 4 )
        END TEXTBOX

        DEFINE SPINNER Spinner_1
        ROW    170
        COL    390
        WIDTH  100
        HEIGHT 24
        RANGEMIN 1
        RANGEMAX 9999
        VALUE 3306
        FONTNAME 'Arial'
        ON LOSTFOCUS CambiaText( 5 )
        TOOLTIP ''
        END SPINNER

        DEFINE TEXTBOX Text_5
        ROW    290
        COL    390
        WIDTH  260
        HEIGHT 24
        FONTNAME 'Arial'
        NUMERIC .T.
        ON LOSTFOCUS CambiaText( 6 )
        END TEXTBOX


        DEFINE BUTTON Button_4
        ROW    350
        COL    525
        WIDTH  70
        HEIGHT 26
        CAPTION "Conectar"
        FONTNAME 'Arial'
        TOOLTIP ''
        ACTION MakeObjCon( CtrlVentana.text_1.value,    ;
                           CtrlVentana.text_2.value,    ;
                           CtrlVentana.text_3.value,    ;
                           CtrlVentana.text_4.value,    ;
                           CtrlVentana.Spinner_1.Value, ;
                           CtrlVentana.text_5.value       )
        END BUTTON

        DEFINE BUTTON Button_5
        ROW    350
        COL    600
        WIDTH  70
        HEIGHT 26
        CAPTION "Cancelar"
        FONTNAME 'Arial'
        TOOLTIP ''
        ACTION SalirConecta()
        END BUTTON

    END WINDOW

    ON KEY F6 OF CtrlVentana ACTION VerArrays()

    center   window CtrlVentana
    activate window CtrlVentana


  Endif

Return

*------------------------------------------------------------*
Procedure SalirConecta()
*------------------------------------------------------------*
   _cServidor := CtrlVentana.text_1.value
   _cUsuario  := CtrlVentana.text_2.value
   _cClave    := CtrlVentana.text_3.value
   _cBase     := CtrlVentana.text_4.value
   _cFlags    := CtrlVentana.text_5.value
   _cPuerto   := CtrlVentana.Spinner_1.Value
   CtrlVentana.Release
Return

*------------------------------------------------------------*
Procedure NuevaSesion()
*------------------------------------------------------------*
    Local cNewCon := ''
    cNewCon := AllTrim( InputBox( 'Ingresa Nombre de Conexion:' , _GEN_PROGRAMA ) )
    If !Empty( cNewCon )
        CtrlVentana.Grid_1.AddItem( AllTrim( cNewCon ) )
        lNueva := .T.
    Endif
    LimpiarTextos()
    CtrlVentana.Grid_1.Value   := CtrlVentana.Grid_1.ItemCount
    CtrlVentana.Grid_1.Enabled := .F.
Return

*------------------------------------------------------------*
Procedure LimpiarTextos()
*------------------------------------------------------------*
    CtrlVentana.text_1.value    := ""
    CtrlVentana.text_2.value    := ""
    CtrlVentana.text_3.value    := ""
    CtrlVentana.text_4.value    := ""
    CtrlVentana.text_5.value    :=  0
    CtrlVentana.Spinner_1.Value := 3306
    CtrlVentana.text_1.setfocus

Return