DBF Viewer 2020 – Código Fuente III

*------------------------------------------------------------------------------*
Procedure DeleteRecall()
*------------------------------------------------------------------------------*
   If !Empty( Alias() )

      aRec := oWndBase.&(Browse_n()).Value
      ( Alias() )->( DbGoto( aRec[1] ) )

      if ( Alias() )->( Rlock() )
         iif( ( Alias() )->( Deleted() ), ( Alias() )->( DbRecall() ), ( Alias() )->( DbDelete() ) )
         siguiente()
      endif
      ( Alias() )->( dbUnlock() )
      Actualizar()

   Endif
Return

*------------------------------------------------------------------------------*
Procedure MuestraRec()
*------------------------------------------------------------------------------*
   If !Empty( Alias() )
      nPos      := ( Alias() )->( Select( oWndBase.Tab_1.caption( oWndBase.Tab_1.value ) ) )

      If !Empty(nRecCopy)
         nRecSel := Iif(nPos==nRecCopy[1,1],RecToMost(),0)
      Endif

      Titulo()

      aRec := oWndBase.&( Browse_n() ).Value

      oWndBase.StatusBar.Item(1) := ' Record: '      ;
      +padl(Alltrim(Str(aRec[1])),7) ;
      +'/'+padl(Alltrim(Str(( Alias() )->(LastRec()))),7)+'         Row: '+padl(Alltrim(Str(aRec[1])),7)+'   Col:'+padl(Alltrim(Str(aRec[2])),7)
      oWndBase.StatusBar.Item(2) := 'Selected Record: '+ Alltrim(Str( nRecSel ,7))
      oWndBase.StatusBar.Item(3) := 'Index Tag: ' + ( Alias() )->( OrdName() )
      oWndBase.StatusBar.Item(4) := 'Order Key: ' + ( Alias() )->( OrdKey() )
   Else
      oWndBase.StatusBar.Item(1) := ''
   Endif
Return

*------------------------------------------------------------------------------*
Procedure Titulo()
*------------------------------------------------------------------------------*
   Local nPos := ( Alias() )->( Select( oWndBase.Tab_1.caption( oWndBase.Tab_1.value ) ) )
   TRY
        oWndBase.Title := PROGRAM+VERSION+COPYRIGHT+iif(Empty(aFiles[nPos]),"",aFiles[nPos])
   CATCH loError
        oWndBase.Title := PROGRAM+VERSION+COPYRIGHT
   END
Return

*------------------------------------------------------------------------------*
Procedure primero()
*------------------------------------------------------------------------------*
   If !Empty( Alias() )
      //( Alias() )->( DbGotop() )
      //keybd_event(VK_HOME)
      oBrowse := GetControlObject(Browse_n(),"oWndBase")
      oBrowse:value := { 1, 1 }
      oBrowse:setfocus()
      oBrowse:GoTop()

   Endif
return

*------------------------------------------------------------------------------*
Procedure anterior()
*------------------------------------------------------------------------------*
   If !Empty( Alias() )
      //( Alias() )->( dBSkip ( -1 ) )
      //keybd_event(VK_UP)
      oBrowse := GetControlObject(Browse_n(),"oWndBase")
      oBrowse:setfocus()
      oBrowse:Up()

   Endif
return

*------------------------------------------------------------------------------*
Procedure siguiente()
*------------------------------------------------------------------------------*
   If !Empty( Alias() )
      //( Alias() )->( dBSkip (1) )
      //if  ( Alias() )->( recno() ) = ( Alias() )->( LastRec()+1 )
      //    ( Alias() )->( DbGoBottom() )
      //    keybd_event(VK_END)
      //endif
      //keybd_event(VK_DOWN)

      oBrowse := GetControlObject(Browse_n(),"oWndBase")
      oBrowse:setfocus()
      oBrowse:Down()

   Endif
return

*------------------------------------------------------------------------------*
Procedure ultimo()
*------------------------------------------------------------------------------*
   If !Empty( Alias() )
      ( Alias() )->( DbGoBottom() )
      oBrowse := GetControlObject( Browse_n(), "oWndBase" )
      oBrowse:value := { ( Alias() )->( LastRec() ) , 1 }
   Endif
return

*------------------------------------------------------------------------------*
Function Browse_n()
*------------------------------------------------------------------------------*
Local cAreaPos, cBrowse_n
   cAreaPos  := AllTrim( Str( ( Alias() )->( Select( oWndBase.Tab_1.caption( oWndBase.Tab_1.value ) ) ) ) )
   cBrowse_n := "Browse_"+cAreaPos
Return( cBrowse_n )

*------------------------------------------------------------------------------*
Procedure primeraC()
*------------------------------------------------------------------------------*
   If !Empty( Alias() )
      oBrowse := GetControlObject(Browse_n(),"oWndBase")
      ( Alias() )->( DbGoto( oBrowse:value[1] ) )
      oBrowse:value := { ( Alias() )->( recno() ), 1 }
      oBrowse:setfocus()
   Endif
return

*------------------------------------------------------------------------------*
Procedure IzquierdaC()
*------------------------------------------------------------------------------*
   If !Empty( Alias() )
      // keybd_event(VK_LEFT)
      oBrowse := GetControlObject(Browse_n(),"oWndBase")
      ( Alias() )->( DbGoto( oBrowse:value[1] ) )
      oBrowse:setfocus()
      oBrowse:Left()
   Endif
return

*------------------------------------------------------------------------------*
Procedure DerechaC()
*------------------------------------------------------------------------------*
   If !Empty( Alias() )
      //keybd_event(VK_RIGHT)
      oBrowse := GetControlObject(Browse_n(),"oWndBase")
      ( Alias() )->( DbGoto( oBrowse:value[1] ) )
      oBrowse:setfocus()
      oBrowse:Right()
   Endif
return

*------------------------------------------------------------------------------*
Procedure ultimaC()
*------------------------------------------------------------------------------*
   If !Empty( Alias() )
      oBrowse := GetControlObject( Browse_n(),"oWndBase" )
      ( Alias() )->( DbGoto( oBrowse:value[1] ) )
      oBrowse:value := { ( Alias() )->( recno() ), ( Alias() )->( Fcount() )+1 }
      oBrowse:setfocus()
   Endif
return

*------------------------------------------------------------------------------*
Procedure Append()
*------------------------------------------------------------------------------*
   If !Empty( Alias() )
      If IsControlDefine(&(Browse_n()),oWndBase)
         Nuevo := .T.
         Administradbf( oWndBase.&(Browse_n()).Value[1] )
         Siguiente()
      Endif
   Endif
return
*------------------------------------------------------------------------------*
Procedure Edit()
*------------------------------------------------------------------------------*
   If !Empty( Alias() )
      aRec := oWndBase.&(Browse_n()).Value
      ( Alias() )->( DbGoto( aRec[1] ) )
      oWndBase.&(Browse_n()).Value := ( Alias() )->( RecNo() )
      oWndBase.&(Browse_n()).SetFocus
   Endif
Return
*------------------------------------------------------------------------------*
Procedure JumpEdit(nOpt)
*------------------------------------------------------------------------------*
   If !Empty( Alias() )
      If nOpt == 1
         if Fcount() < 16
            EDIT WORKAREA ( oWndBase.Tab_1.caption( oWndBase.Tab_1.value ) )
         Else
            MsgInfo("EDIT does not display workarea with more than 16 Fields",PROGRAM)
         Endif
      Else
         EDIT EXTENDED WORKAREA ( oWndBase.Tab_1.caption( oWndBase.Tab_1.value ) )
      Endif
      Actualizar()
   Endif
Return

*------------------------------------------------------------------------------*
Procedure Actualizar()
*------------------------------------------------------------------------------*
   If !Empty( Alias() )
      oWndBase.&(Browse_n()).SetFocus
      oWndBase.&(Browse_n()).Refresh
   Endif
Return
*------------------------------------------------------------------------------*
Procedure MueveRec()
*------------------------------------------------------------------------------*
   If !Empty( Alias() )
      oBrowse := GetControlObject( Browse_n(),"oWndBase" )
      oBrowse:value := { ( Alias() )->( Recno() ) , 1 }
   Endif
Return

*------------------------------------------------------------------------------*
Procedure PackBase()
*------------------------------------------------------------------------------*
   If !Empty( Alias() )
      if MsgYesNo("Are you sure Pack Database?",PROGRAM)
         Pack
         Primero()
      Endif
   Endif
Return
*------------------------------------------------------------------------------*
Procedure ZapBase()
*------------------------------------------------------------------------------*
   If !Empty( Alias() )
      if MsgYesNo("DANGER!! - Are you sure Zap Database?",PROGRAM)
         Zap
         Actualizar()
      Endif
   Endif
Return
*------------------------------------------------------------------------------*
Procedure GoToRecord()
*------------------------------------------------------------------------------*
    Local VamosA
    If !Empty( Alias() )
       nUltimo := ( Alias() )->( LastRec() )
       VamosA := val(InputBox( 'Goto Record:' , PROGRAM ))
       VamosA := iif(VamosA>nUltimo,nUltimo,VamosA)
       If .Not. Empty(VamosA)
          ( Alias() )->( dbgoto(VamosA) )
          If VamosA == nUltimo
             Ultimo()
          Else
             MueveRec()
          Endif
       EndIf
    Endif
Return

*--------------------------------------------------------*
Procedure InsertRecord()
*--------------------------------------------------------*
   If !Empty( Alias() )
      If MsgYesNo( "A blank record will be inserted before the current record!!!" + Hb_OSNewLine() + "Are You sure ?", "Insert Record")
         aRec := oWndBase.&(Browse_n()).Value
         ( Alias() )->( DbGoTo( aRec[1] ) )
         DbInsert(.T.)
         Actualizar()
      Endif
   Endif
Return

*--------------------------------------------------------*
Procedure BackColorBrowse()
*--------------------------------------------------------*
   Local nc
   If !Empty( Alias() )
   If IsControlDefine(&(Browse_n()),oWndBase)
      aBackClr := GetColor()
      For nc := 1 to oWndBase.Tab_1.ItemCount
          cAreaPos  := AllTrim( Str( ( Alias() )->( Select( oWndBase.Tab_1.caption( nc ) ) ) ) )
          cBrowse_n := "Browse_"+cAreaPos
          oWndBase.&(cBrowse_n).Backcolor := aBackClr
      Next
      SaveArchIni(cBaseFolder+'')
      Actualizar()
   Endif
   Endif
Return
*--------------------------------------------------------*
Procedure FontColorBrowse()
*--------------------------------------------------------*
   Local nc
   If !Empty( Alias() )
   If IsControlDefine(&(Browse_n()),oWndBase)
      aBackClr := GetColor()
      For nc := 1 to oWndBase.Tab_1.ItemCount
          cAreaPos  := AllTrim( Str( ( Alias() )->( Select( oWndBase.Tab_1.caption( nc ) ) ) ) )
          cBrowse_n := "Browse_"+cAreaPos
          oWndBase.&(cbrowse_n).Fontcolor := aBackClr
      Next
      SaveArchIni(cBaseFolder+'')
      Actualizar()
   Endif
   Endif
Return

 

DBF Viewer 2020 – Código Fuente II

*------------------------------------------------------*
Procedure SeleArea()
*------------------------------------------------------*
   If !Empty( Alias() )

      DBSelectArea( ( Alias() )->( Select( oWndBase.Tab_1.caption( oWndBase.Tab_1.value ) ) ) )
      cBase := Alias()

      If IsControlDefine(&(Browse_n()),oWndBase)
         oWndBase.&(Browse_n()).SetFocus
      Endif

   Endif

Return

*------------------------------------------------------------------------------*
Procedure CierraBase()
*------------------------------------------------------------------------------*
   If !Empty( Alias() )

      oTab      := GetControlObject("Tab_1","oWndBase")
      nPos      := ( ( Alias() )->( Select( oWndBase.Tab_1.caption( oWndBase.Tab_1.value ) ) ) )

      Set Index To

      If IsControlDefine( &(Browse_n()), oWndBase )
         oWndBase.&(Browse_n()).release
         Close ( oWndBase.Tab_1.caption( oWndBase.Tab_1.value ) )
         oTab:DeletePage ( oTab:value, oTab:caption( oTab:value ) )
         If oWndBase.Tab_1.ItemCount > 0
            DBSelectArea( ( Alias() )->( Select( oWndBase.Tab_1.caption( oWndBase.Tab_1.value ) ) ))
            Titulo()
         Else
            Close data
            oWndBase.Tab_1.release
            aFiles   := {}
            aNewFile := {}
            nRecCopy := {}
            OpenBase("")
         Endif
      Else
         Close data
      Endif

   Endif

return

*------------------------------------------------------------------------------*
Procedure CierraAll()
*------------------------------------------------------------------------------*
   Local nc
   If !Empty( Alias() )
       For nc := 1 to oWndBase.Tab_1.ItemCount
           Close ( oWndBase.Tab_1.caption( nc ) )
       Next
       oWndBase.Tab_1.release
       aFiles   := {}
       aNewFile := {}
       nRecCopy := {}
       OpenBase("")
   Endif

Return

*------------------------------------------------------*
Function Iniciando()     // Cortesía: Fernando Yurisich
*------------------------------------------------------*
   ooWndBase:AcceptFiles := .T.
   ooWndBase:OnDropFiles := { |f| AEval( f, { |c| OpenBase( c ) } ) }
Return Nil

*------------------------------------------------------*
Function AssiCtrlBrw( cTypeField, nlongTot, nLongDec, cFieldName )
*------------------------------------------------------*

   cCtrlBrw := ""
   cComa    := iif( (FieldNum(cFieldName)<=FCount()-1),',','')

   If cTypeField=='L'
      //cCtrlBrw := "{'CHECKBOX','Yes','No'}"+cComa
      cCtrlBrw := "TGridControlLComboBox():New( 'Yes', 'No' )"+cComa
   Elseif cTypeField=='D'
      //cCtrlBrw := "{'DATEPICKER','UPDOWN'}"+cComa
      cCtrlBrw := "TGridControlDatePicker():New( .t., .t. )"+cComa
   Elseif cTypeField=='@' .OR. cTypeField=='T'
      cCtrlBrw := "{'TEXTBOX','DATE',''}"+cComa
      //cCtrlBrw := "{'TIMEPICKER','UPDOWN'}"+cComa
   Elseif cTypeField=='N' .OR. cTypeField=='I' .OR. cTypeField=='W' .OR. cTypeField=='Y' .OR. cTypeField=='B'
      cInpMsk  := iif( nLongDec > 0, REPLICATE( '9', nLongTot - nLongDec -1 ) + '.' + REPLICATE( '9', nLongDec ), REPLICATE( '9', nLongTot - nLongDec ) )
      cCtrlBrw := "{'TEXTBOX','NUMERIC','"+cInpMsk+"'}"+cComa
   Elseif cTypeField=='C'
//      cCtrlBrw := "{'TEXTBOX','CHARACTER','@A'}"+cComa
      cCtrlBrw := "{'TEXTBOX','CHARACTER',}"+cComa
   Elseif cTypeField=='M' .OR. cTypeField=='G' .OR. cTypeField=='P'
      cCtrlBrw := "{}"+cComa
      //cCtrlBrw := "TGridControlMemo():New('Edit Memo Field')"+cComa
   Else
      cCtrlBrw := "{}"+cComa
   Endif

Return( cCtrlBrw )

*------------------------------------------------------------------------------*
Function VerHeadIcon( aTip )
*------------------------------------------------------------------------------*
   Local nv
   aFtype    := aClone( aTip )
   aHeadIcon := {"hdel"}

   For nv := 1 to FCount()
       Do Case
          Case aFType[nv]=='L'
               aadd(aHeadIcon,"hlogic")
          Case aFType[nv]=='D'
               aadd(aHeadIcon,"hfech")
          Case aFType[nv]=='@'
               aadd(aHeadIcon,"hfech")
          Case aFType[nv]=='N'
               aadd(aHeadIcon,"hnum")
          Case aFType[nv]=='B'
               aadd(aHeadIcon,"hnum")
          Case aFType[nv]=='I'
               aadd(aHeadIcon,"hnum")
          Case aFType[nv]=='C'
               aadd(aHeadIcon,"hchar")
          Case aFType[nv]=='M'
               aadd(aHeadIcon,"hmemo")
          Case aFType[nv]=='G'
               aadd(aHeadIcon,"hmemo")
          Case aFType[nv]=='T'
               aadd(aHeadIcon,"hfech")
          Case aFType[nv]=='P'
               aadd(aHeadIcon,"hmemo")
          Case aFType[nv]=='W'
               aadd(aHeadIcon,"hnum")
          Case aFType[nv]=='Y'
               aadd(aHeadIcon,"hnum")
          Otherwise
               aadd(aHeadIcon,"hchar")
       Endcase
   Next

Return( aHeadIcon )

*------------------------------------------------------------------------------*
Function SetHeaderImages()
*------------------------------------------------------------------------------*
   Local nc

   If !Empty( Alias() )

      For nc := 1 to oWndBase.Tab_1.ItemCount
          cAreaPos  := AllTrim( Str(nc) )
          cBrowse_n := "Browse_"+cAreaPos

          If IsControlDefined(&cBrowse_n,oWndBase)
             oWndBase.&(cBrowse_n).Fontname  := cFont
             oWndBase.&(cBrowse_n).Fontsize  := nSize
             oWndBase.&(cBrowse_n).fontcolor := aFntClr
             oWndBase.&(cBrowse_n).Backcolor := aBackClr
          Endif
      Next
   Endif

Return Nil

*------------------------------------------------------------------------------*
Function GetIndexInfo()
*------------------------------------------------------------------------------*
   LOCAL aInd:= {}, ig, cKey

   If !Empty( Alias() )
      FOR ig := 1 to 50
         IF ( cKey := ( Alias() )->( IndexKey( ig ) ) ) == ''
            EXIT
         ENDIF
         Aadd( aInd, "TAG "+( Alias() )->( OrdName( ig ) ) + ' : ' + "KEY " + cKey )
      NEXT
   Endif

RETURN aInd

*------------------------------------------------------------------------------*
Procedure SeleOrder()
*------------------------------------------------------------------------------*
   If !Empty( Alias() )
      ( Alias() )->(OrdSetFocus(0))
   Endif
Return

*------------------------------------------------------------------------------*
Procedure IndexItems()
*------------------------------------------------------------------------------*
   Local ni
   If !Empty( Alias() )
      nTags := ( Alias() )->( OrdCount() )
      for ni = 1 to nTags
         if ! Empty( OrdName( ni ) )
            if ! Empty( OrdName( 1 ) )
               DbSetOrder( OrdName( 1 ) )
               DbGoTop()
            endif
            ITEM OrdName( ni ) ACTION  ( Alias() )->( DbSetOrder( OrdName(ni) ) )
         endif
      next
   Endif
Return

*------------------------------------------------------------------------------*
Procedure CopyRec(nOp)  // Copiar
*------------------------------------------------------------------------------*
   If !Empty( Alias() )

       If nOp = 1   // Selecciona registro
          RecReply()
          MuestraRec()
       Else         // Limpia Selección de registro
          nRecCopy := {}
          nRecSel := 0
          oWndBase.StatusBar.Item(2) := 'Selected Record: '
          Actualizar()
       Endif
   Endif
return

*------------------------------------------------------------------------------*
Function RecToMost()
*------------------------------------------------------------------------------*
   Local nr
   If Empty(nRecCopy)
      nRet := 0
   Else
      For nr := 1 to Len(nRecCopy)
          nRet := nRecCopy[ iif(AScan( nRecCopy[nr], nArea )>0, AScan( nRecCopy[nr], nArea ),1), 2 ]
      Next
   Endif
Return(nRet)

*------------------------------------------------------------------------------*
Function RecReply()
*------------------------------------------------------------------------------*

   aRec := oWndBase.&( Browse_n() ).Value

   If Empty(nRecCopy)
      Aadd( nRecCopy, { ( Alias() )->( Select( oWndBase.Tab_1.caption( oWndBase.Tab_1.value ) ) ), aRec[1] } )
   Endif

Return Nil

*------------------------------------------------------------------------------*
procedure PasteRec() // Pegar
*------------------------------------------------------------------------------*
   local nPos   := 0, i := 1
   local aDatos := {}

   If !Empty( Alias() )
      If Empty(nRecCopy)
         Msginfo('No Selected Record',PROGRAM)
      Else
        If ( Alias() )->( Select() ) = nRecCopy[ 1, 1 ]
           If MsgYesNo("This action will replace the current record"+Hb_OsNewLine()+"with the data of the selected record"+Hb_OsNewLine()+"Are you sure?",PROGRAM)
              nPos := oWndBase.&( Browse_n() ).Value
              ( Alias() )->( DBGoTo( nRecCopy[ 1, 2 ] ) )
              For i = 1 to ( Alias() )->( FCount() )
                  Aadd( aDatos, ( Alias() )->( Fieldget(i) ) )
              Next
              ( Alias() )->( DbGoTo( nPos[1]) )
              ( Alias() )->( flock() )
              For i = 1 to ( Alias() )->( Fcount() )
                  ( Alias() )->( Fieldput( i, adatos[i] ) )
              Next
              ( Alias() )->( DbUnLock() )
              nRecSel  := 0
              nRecCopy := {}
              oWndBase.StatusBar.Item(2) := 'Selected Record: '
           Endif
        Endif
      EndIf
      Actualizar()
   Endif

Return

*------------------------------------------------------------------------------*
Function DBF_Idx()   // Indices de la base de datos
*------------------------------------------------------------------------------*
   Local ix
   lSalida := .t. ; k := 1 ; nVeces := 1
   aIndice       := {}
   aIndiceCampo  := {}

   Do while lSalida
      If ( (Alias() )->( OrdName( k ) ) == "" )
         lSalida := .f.
      Else
         cIndice := ( Alias() )->( OrdName( k ) )
         aAdd( aIndice, cIndice )
         cClave := Upper( (Alias() )->( OrdKey( k ) ) )
         For ix := 1 to FCount()
             If nVeces <= 1
                nInicio := At( FieldName(ix), cClave )
                If  nInicio != 0
                    aAdd( aIndiceCampo, ix )
                    nVeces++
                Endif
             Endif
         Next
      Endif
      k++
      nVeces := 1
   Enddo

   // Numero de indice
   If ( (Alias())->( ordSetFocus() ) == "" )
      nIndiceActivo := 1
   Else
      nIndiceActivo := AScan( aIndice, (Alias())->( OrdSetFocus() ) )
   Endif

   AutoMsgInfo( aIndice, "aIndice" )

Return(aIndiceCampo)

 

DBF Viewer 2020 – Código Fuente I

2015-03-25_160535

/*
 *
 * Program to view DBF files using standard Browse control
 * Miguel Angel Juárez A. - 2009-2015 MigSoft <mig2soft/at/yahoo.com>
 * Includes the code of Grigory Filatov <gfilatov@freemail.ru>
 * and Rathinagiri <srathinagiri@gmail.com>
 *
 */

#include "oohg.ch"
#include "dbstruct.ch"
#include "fileio.ch"
#include "dbuvar.ch"

*------------------------------------------------------------------------------*
Function Main( cDBF )
*------------------------------------------------------------------------------*

   REQUEST DBFNTX
   REQUEST DBFCDX, DBFFPT
   RDDSETDEFAULT( "DBFCDX" )
   SET AUTOPEN OFF

   Publicar()

   Load window oWndBase

   ON KEY F3 OF oWndBase ACTION AutoMsgInfo( aFiles, "aFiles" )
   ON KEY F4 OF oWndBase ACTION AutoMsgInfo( nRecCopy, "nRecCopy" )
   ON KEY F5 OF oWndBase ACTION AutoMsgInfo( ( Alias() )->( Select() ), "Select()" )
   ON KEY F6 OF oWndBase ACTION AutoMsgInfo( ( Alias() )->( Dbf() ), "Dbf()" )
   ON KEY F7 OF oWndBase ACTION AutoMsgInfo( ( Alias() )->( Used() ), "Used()" )

   If PCOUNT() > 0
      OpenBase( cDBF )
   Else
      OpenBase( "" )
   Endif

   oWndBase.Center
   oWndBase.Activate

Return Nil

*------------------------------------------------------------------------------*
Procedure Publicar()
*------------------------------------------------------------------------------*

    Public nAltoPantalla  := GetDesktopHeight() + GetTitleHeight() + GetBorderHeight()
    Public nAnchoPantalla := GetDesktopWidth()
    Public nRow           := nAltoPantalla  * 0.10
    Public nCol           := nAnchoPantalla * 0.10
    Public nWidth         := nAnchoPantalla * 0.95
    Public nHeight        := nAltoPantalla  * 0.85
    Public _OOHG_PRINTLIBRARY
    Public cBaseFolder, aTypes, aNewFile := {}, aFtype := {}, aCtrl := {}
    Public nCamp, aEst    := {}, aNomb := {}, aJust := {}, aLong := {}, i, cBase
    Public cFont          := 'MS Sans Serif'
    Public nSize          := 8 , Nuevo := .F.
    Public nRecCopy       := {}
    Public aArea          := {}
    Public aFiles         := {}
    Public nArea          := 0
    Public nBrow          := 0
    Public nBase          := 0
    Public nRecSel        := 0
    Public nPage          := 1
    Public aFntClr        := {0,0,0}
    Public aBackClr       := {255,255,255}
    Public aSearch        := {}, aReplace := {}
    Public nSearch        := 1, nReplace := 1, nColumns := 1
    Public lMatchCase     := .F., lMatchWhole := .F.
    Public nDirect        := 3, cDateFormat := "DD.MM.YYYY"
    Public _DBULastPath   := ''
    Public VERSION        := "v."+substr(__DATE__,3,2)+"."+right(__DATE__,4)
    HB_LANGSELECT( "EN" )
    DECLARE WINDOW Form_Query
    DECLARE WINDOW Form_Find
    DECLARE WINDOW _DBUcreadbf
    DECLARE WINDOW Form_Prop
    DECLARE WINDOW oWndBase

Return

*------------------------------------------------------------------------------*
Procedure OpenBase( cDBF )
*------------------------------------------------------------------------------*
   local nn, aTemp := {}

   cBaseFolder := GetStartupFolder()
   LoadArchIni(cBaseFolder+'')

   If Empty(cDBF) .OR. ValType ( cDBF ) == 'U'
      If !IsControlDefined(Tab_1,oWndBase)
         oWndBase.Image_1.Show
      Endif
      aTypes   := { {'Database files (*.dbf)', '*.dbf'} }
      aTemp    := iif( !Empty(aNewFile),aNewFile[1],"")
      aNewFile := GetFile( aTypes, 'Select database files', CurDir(), .T. )
      If Empty(aNewFile)
         Aadd( aNewFile, aTemp )
      Endif
   Else
      AAdd( aNewFile, cDBF )
   Endif

   IF !Empty(aNewFile)
       For nn := 1 to Len(aNewFile)
           If !Empty(aNewFile[nn]) .AND. Upper(Right(aNewFile[nn],3))="DBF"
                  If DB_Open( aNewFile[nn] )
                     _DBULastPath := hb_Curdrive()+':'+CurDir()+''

                     If Used(aNewFile[nn])

                        Aadd( aFiles, aNewFile[nn] )
                        oWndBase.Title := PROGRAM+VERSION+COPYRIGHT+aNewfile[nn]

                        ArmMatrix()

                        cAreaPos  := AllTrim( Str( ( Alias() )->( Select( oWndBase.Tab_1.caption( oWndBase.Tab_1.value ) ) ) ) )
                        cBrowse_n := "Browse_"+cAreaPos

                        oWndBase.&(cBrowse_n).ColumnsAutoFitH
                        oWndBase.&(cBrowse_n).SetFocus             // Ilumina barra en primer registro
                        oWndBase.&(cBrowse_n).GoTop
                     Endif

                  Endif

           Endif
       Next nn

   Else
      cBase := ''
      MuestraRec()
      oWndBase.Title := PROGRAM+VERSION+COPYRIGHT
      If !IsControlDefined(Tab_1,oWndBase)
         oWndBase.Image_1.Show
      Endif
   Endif

Return

*------------------------------------------------------------------------------*
Procedure ArmMatrix()
*------------------------------------------------------------------------------*
   Local i
   cBase := Alias() ; nCamp := Fcount() ; aEst  := DBstruct() ; aCtrl := {}
   aNomb := {'iif(deleted(),0,1)'} ; aJust := {0} ; aLong := {0} ; aFtype:={}
   cCtrl := "{},"

   For i := 1 to nCamp
       Aadd(aNomb,aEst[i,1])                             // Carga el nombre de campo
       Aadd(aJust,iif(aEst[i,2]=='N',1,0))               // Justifica a la izquierda o derecha de acuerdo al tipo de dato
       cCtrl += AssiCtrlBrw( aEst[i,2], aEst[i,3],aEst[i,4],FieldName(i) )   // control por tipo de campo
       Aadd(aLong,Max(100,Min(160,aEst[i,3]*14)))        // Asigna la longitud del dato en el browse
       If     aEst[i,2]=="I" .OR. aEst[i,2]=="W" .OR. aEst[i,2]=="Y" .OR. aEst[i,2]=="B"
              aEst[i,2]:= 'N'
       ElseIf aEst[i,2]=="G" .OR. aEst[i,2]=="P"
              aEst[i,2]:= 'M'
       ElseIf aEst[i,2]=="@" .OR. aEst[i,2]=="T"
              aEst[i,2]:= 'D'
       Endif
       Aadd(aFtype, aEst[i,2])                           // Carga el tipo de campo
   Next

   aCtrl :=  &("{"+cCtrl+"}")                            // Asigna controles por tipo de campo
   CreaBrowse( cBase, aNomb, aLong, aJust, aFtype, aCtrl )

Return

*------------------------------------------------------------------------------*
Function DB_Open( cFileDBF )
*------------------------------------------------------------------------------*
   lSuc := .F.
      TRY
          If ! ( DelExt(GetName(cFileDBF)) )->( Used() )
             Use ( cFileDBF ) New
             lSuc := .T.
             Aadd( aArea, ( Alias() )->( Select() ) )
             nArea++
             nBase++
          Endif
      CATCH loError
          MsgInfo("Unable open file: "+cFileDBF, PROGRAM+" TRY")
      END
Return (lSuc)

*---------------------------------------------------------------------*
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 CreaBrowse( cBase, aNomb, aLong, aJust, aFtype, aCtrl )
*------------------------------------------------------------------------------*
    aHdr       := aClone(aNomb)
    aJst       := aClone(aJust)
    aHdr[1]    := ""
    aLong[1]   := 20
    aCabImg    := aClone(VerHeadIcon(aFtype))

    oWndBase.Image_1.Hide

    If IsControlDefined(Tab_1,oWndBase)
       NuevoTab()
    Else
       DEFINE TAB Tab_1 OF oWndBase AT 40,15 WIDTH ooWndBase:Clientwidth  - 30 HEIGHT ooWndBase:Clientheight - 70 ;
       VALUE 1 FONT "Arial" SIZE 9 FLAT ON CHANGE SeleArea()
           PAGE cBase IMAGE "Main1"
                MakeBrowse()
           END PAGE
       END TAB

       oTab := GetControlObject("Tab_1","oWndBase")
       oTab:Anchor := "TOPLEFTBOTTOMRIGHT"

    Endif

    SetHeaderImages()

Return Nil

*------------------------------------------------------*
Procedure MakeBrowse()
*------------------------------------------------------*
   cAreaPos  := AllTrim( Str( ( Alias() )->( Select() ) ) )
   cBrowse_n := "Browse_"+cAreaPos

           If !IsControlDefined(&cBrowse_n,oWndBase)

                  @ 26,0 BROWSE &cBrowse_n              ;
                     OF oWndBase                        ;
                     WIDTH  ooWndBase:Clientwidth  - 32  ;
                     HEIGHT ooWndBase:Clientheight - 100 ;
                     HEADERS aHdr                       ;
                     WIDTHS aLong                       ;
                     WORKAREA &( Alias() )              ;
                     FIELDS aNomb                       ;
                     VALUE 0                            ;
                     FONT "MS Sans Serif" SIZE 8        ;
                     TOOLTIP ""                         ;
                     ON CHANGE { || MuestraRec() }      ;
                     IMAGE { "br_no", "br_ok" }         ;
                     JUSTIFY aJst                       ;
                     COLUMNCONTROLS aCtrl               ;
                     LOCK                               ;
                     EDIT                               ;
                     INPLACE                            ;
                     DELETE                             ;
                     ON HEADCLICK Nil                   ;
                     HEADERIMAGES aCabImg               ;
                     DOUBLEBUFFER                       ;
                     NAVIGATEBYCELL                     ;
                     SELECTEDCOLORS { WHITE, {65,105,225},           ;           // Cursor Fuente/Fondo
                                      WHITE, {128,128,128},          ;           // Cursor ventana sin foco Fuente/Fondo
                                      {106,90,205}, {135,206,250},   ;           // Fila resaltada  Fuente/Fondo
                                      {105,105,105},{220,220,220} }              // Fila resaltada click en columna  Fuente/Fondo

           Endif

   oBrowse := GetControlObject(cBrowse_n,"oWndBase")
   oBrowse:Anchor := "TOPLEFTBOTTOMRIGHT"

   nBrow++

Return


*------------------------------------------------------*
Procedure NuevoTab() // Cortesía: Ciro Vargas Clemow
*------------------------------------------------------*
   cAreaPos  := AllTrim( Str( aArea[nBase] ) )
   cBrowse_n := "Browse_"+cAreaPos

   oTab := GetControlObject("Tab_1","oWndBase")

      oTab:AddPage ( ( Alias() )->( Select() ), Alias() )
      nPage++
      oTab:Value := ( Alias() )->( Select() )

      MakeBrowse()

      oTab:AddControl( cBrowse_n, ( Alias() )->( Select() ), 26, 0 )

Return

 

Certificados SSL Gratuitos Let’s Encrypt

Certificador
La finalidad de la iniciativa Let’s Encrypt es facilitar la migración de sitios web a HTTPS.

Let’s Encrypt, un servicio que facilita la transmisión de contenidos web en conexiones cifradas, ha superado el hito de los 100.000 certificados gratuitos, desde su lanzamiento a comienzos de diciembre.

Estos certificados se suman a los aproximadamente 26.000 emitidos durante el período beta, que estuvo únicamente disponible por invitación.

Aparte de ser gratuito, Let’s Encrypt tiene como finalidad facilitar a los operadores de sitios web comenzar a utilizar certificados de seguridad, procedimiento necesario para acceder al protocolo cifrado HTTPS.

Para obtener un certificado es necesario utilizar software específico, disponible únicamente para sistemas tipo Unix. En esta página se describen los procedimientos para instalar el software y los certificados.

El servicio es ofrecido por Security Research Group, con el apoyo de grandes organizaciones tecnológicas que incluyen a Mozilla, Akamai, Cisco, EFF y Facebook.

Fuente: DiarioTI

MySQL ABM – Código Liberado VI

2015-05-10_183529
AbmMig.prg

/*
 *
 * MINIGUI - Harbour Win32 GUI library
 * Copyright 2002-2009 Roberto Lopez <harbourminigui@gmail.com>
 * http://harbourminigui.googlepages.com/
 *
 * MySQL ABM v15.0518
 * Miguel Angel Juárez A. - 2009-2015 MigSoft <migsoft/at/oohg.org>
 *
 */

#include 'oohg.ch'
#include "tdolphin.ch"
#include "miniprint.ch"

PROCEDURE MigABM( oSrv_Mig, cTabla )

    Public Nuevo := .F., aName := {}, aCtrol := {}, nOpt := 1 , nReg1, aTxtBx := {}
    Public oQry_Mig := Nil, cTable := cTabla

    If !Empty( oSrv_Mig ) .AND. !Empty(cTabla)

        oQry_Mig := oSrv_Mig:Query( "select * from " + cTabla )

        nAlto := CalcHeight(oQry_Mig) ; nReg1 := oQry_Mig:RecNo()

        DEFINE WINDOW Win_2                                ;
            AT 0,0                                         ;
            WIDTH 685                                      ;
            HEIGHT 575                                     ;
            TITLE 'MySQL Table: '+cTable+' - Record View #'+Alltrim(Str(oQry_Mig:RecNo())) ;
            ICON "MAIN1"                                   ;
            MODAL                                          ;
            FONT 'ARIAL' SIZE 9                            ;
            ON INIT ( DesactivarEdicion(oQry_Mig), Actualizar2(oQry_Mig) )  ;
            ON RELEASE CerrarTablas()

            AbrirTablas()

            Define Splitbox

                MyToolBar( oSrv_Mig, oQry_Mig )

            End Splitbox

               @ 32,8 FRAME FRAME_51 OBJ oFrame WIDTH 657 HEIGHT 460
                      oFrame:Anchor := "TOPLEFTBOTTOMRIGHT"

                Define Window Win_1 OBJ oWin1                ;
                    at 40,10                                 ;
                    width 650                                ;
                    height 450                               ;
                    virtual height MAX(nAlto-70,451)         ;
                    Internal                                 ;
                    nocaption                                ;
                    font "ms sans serif" size 9              ;
                    focused

                    oWin1:Anchor := "TOPLEFTBOTTOMRIGHT"

                    CreaControles( oSrv_Mig, oQry_Mig )

                End Window


            @ 500,450 BUTTON ACEPTAR  OBJ oButt1 CAPTION 'O&K' ACTION AceptarEdicion(oQry_Mig)
                      oButt1:Anchor := "BOTTOMRIGHT"
            @ 500,550 BUTTON CANCELAR OBJ oButt2 CAPTION 'Ca&ncel' ACTION CancelarEdicion(oQry_Mig)
                      oButt2:Anchor := "BOTTOMRIGHT"

        END WINDOW

        CENTER WINDOW Win_2
        ACTIVATE WINDOW Win_2

    Endif

RETURN

*------------------------------------------------------------*
Function CalcHeight(oQry_Mig)
*------------------------------------------------------------*
    nAlto1 := 140

    For n := 1 to oQry_Mig:Fcount()
        If oQry_Mig:FieldType(n)=='M'
            nAlto1 := nAlto1 + 58
        Endif
    Next

    nAlto1 := nAlto1 + ( oQry_Mig:FCount() * 30 )

Return(nAlto1)

*------------------------------------------------------------*
PROCEDURE CreaControles( oSrv_Mig, oQry_Mig )
*------------------------------------------------------------*
    nFil := 10 ; nCol :=180 ; nMin := 80

    @ nFil,10 FRAME FRAME_1 OBJ oFrame1 WIDTH 620 HEIGHT MAX(nAlto - 90, 138)
      oFrame1:Anchor := "TOPLEFTBOTTOMRIGHT"

    aLabel := {}  ; aCtrol := {} ; aName := {} ; aTxtBx := {}

    For n := 1 to oQry_Mig:FCount()

        aadd( aLabel , "label_" + alltrim( str(n) ) )
        aadd( aCtrol , "Control_" + alltrim( str(n) ) )
        aadd( aName  , oQry_Mig:FieldName(n) )

        nLongTot := oQry_Mig:FieldLen(n)
        nLongDec := oQry_Mig:FieldDec(n)

        // AutoMsgInfo( oQry_Mig:FieldGet(n), oQry_Mig:FieldType(n) )

        @ nFil+(n*30),20 LABEL &(aLabel[n]) OBJ &(aLabel[n]) VALUE TokenUpper( Lower(aName[n]) )+" ("+alltrim(str(nLongTot,6,0))+")" WIDTH 120 //80
          &(aLabel[n]):Anchor := "TOPLEFT"

        If oQry_Mig:FieldType(n)=='L'
            @ nFil+(n*30) ,nCol CHECKBOX   &(aCtrol[n]) caption "Yes" value oQry_Mig:FieldGet(n)
          Aadd( aTxtBx, .F. )
        Elseif oQry_Mig:FieldType(n)=='D'
            @ nFil+(n*30) ,nCol DATEPICKER &(aCtrol[n]) value oQry_Mig:FieldGet(n) UpDown SHOWNONE
          Aadd( aTxtBx, .F. )
        Elseif oQry_Mig:FieldType(n)=='N'
            cInpMsk  := iif( nLongDec > 0, REPLICATE( "9", nLongTot - nLongDec -1 ) + "." + REPLICATE( "9", nLongDec ), REPLICATE( "9", nLongTot - nLongDec ) )
            nWidthF  := Min( iif(len(hb_Cstr(oQry_Mig:FieldGet(n)))*10<nMin,nMin,len(hb_Cstr(oQry_Mig:FieldGet(n)))*10),400 )
            @ nFil+(n*30) ,nCol TEXTBOX &(aCtrol[n]) WIDTH nWidthF VALUE oQry_Mig:FieldGet(n) NUMERIC INPUTMASK cInpMsk RIGHTALIGN
          Aadd( aTxtBx, .T. )
        Elseif oQry_Mig:FieldType(n)=='C'
            If oQry_Mig:FieldGet(n) == NIL
               @ nFil+(n*30) ,nCol TEXTBOX    &(aCtrol[n]) value "" width nMin
            Else
               @ nFil+(n*30) ,nCol TEXTBOX    &(aCtrol[n]) value oQry_Mig:FieldGet(n) width Min( iif(len(oQry_Mig:FieldGet(n))*10<nMin,nMin,len(oQry_Mig:FieldGet(n))*10),300 )
            Endif
          Aadd( aTxtBx, .T. )
        Elseif oQry_Mig:FieldType(n)=='M'
            @ nFil+(n*30) ,nCol EDITBOX    &(aCtrol[n]) value oQry_Mig:FieldGet(n) width 300 height 81
            nFil := nFil + 58
          Aadd( aTxtBx, .F. )
        Elseif oQry_Mig:FieldType(n)=='U'
            @ nFil+(n*30) ,nCol TEXTBOX    &(aCtrol[n]) value oQry_Mig:FieldGet(n) width Min( iif(len(oQry_Mig:FieldGet(n))*10<nMin,nMin,len(oQry_Mig:FieldGet(n))*10),300 )
          Aadd( aTxtBx, .T. )
        Else
            @ nFil+(n*30) ,nCol TEXTBOX    &(aCtrol[n]) value oQry_Mig:FieldGet(n) width Min( iif(len(oQry_Mig:FieldGet(n))*10<nMin,nMin,len(oQry_Mig:FieldGet(n))*10),300 )
          Aadd( aTxtBx, .T. )
        Endif

    Next

Return

*------------------------------------------------------------*
PROCEDURE MyToolbar( oSrv_Mig, oQry_Mig )
*------------------------------------------------------------*

    DEFINE TOOLBAR ToolBar_1 BUTTONSIZE 16,16 FONT "Arial" SIZE 9 FLAT

    BUTTON PRIMERO TOOLTIP '&First' PICTURE 'first1'	;
        ACTION ( oQry_Mig:GoTop() ,Actualizar2(oQry_Mig) )

    BUTTON ANTERIOR TOOLTIP '&Previous' PICTURE 'previous1'	;
        ACTION ( oQry_Mig:Skip( -1 ), Actualizar2(oQry_Mig) )

    BUTTON SIGUIENTE TOOLTIP '&Next' PICTURE 'next1'	;
        ACTION ( oQry_Mig:Skip( 1 ) , if ( oQry_Mig:Eof() , oQry_Mig:GoBottom() , Nil ) , Actualizar2(oQry_Mig) )

    BUTTON ULTIMO TOOLTIP '&Last' PICTURE 'last1'	;
        ACTION ( oQry_Mig:GoBottom(),Actualizar2(oQry_Mig)  )  SEPARATOR

    BUTTON BUSCAR TOOLTIP '&Find' PICTURE 'find1'	;
        ACTION Buscando( oSrv_Mig, oQry_Mig )

    BUTTON Nuevo TOOLTIP '&New' PICTURE 'new1'	;
        ACTION ( Nuevo := .T. , Nuevo(oQry_Mig) )

    BUTTON EDITAR TOOLTIP '&Edit' PICTURE 'format1'	;
        ACTION If ( BloquearRegistro(oQry_Mig) , ActivarEdicion(oQry_Mig) , Nil )

    BUTTON ELIMINAR TOOLTIP 'E&rase' PICTURE 'erase1'	;
        ACTION Eliminar(oQry_Mig)

    BUTTON IMPRIMIR TOOLTIP '&Print'PICTURE 'print1' ;
        ACTION Imprimir(oQry_Mig, .F.)

    BUTTON CERRAR TOOLTIP '&Close' PICTURE 'record1' ;
        ACTION Win_2.release

    END TOOLBAR

RETURN

*------------------------------------------------------------*
PROCEDURE Buscando( oSrv_Mig, oQry_Mig )
*------------------------------------------------------------*
    If ! oSrv_Mig:lError

        nAlto := CalcHeight(oQry_Mig)

        DEFINE WINDOW Win_Busca2                           ;
            AT 0,0                                         ;
            WIDTH 685                                      ;
            HEIGHT 550                                     ;
            TITLE 'MySQL - Record Find'                    ;
            ICON "MAIN1"                                   ;
            MODAL                                          ;
            FONT 'ARIAL' SIZE 9

                Define Window Win_Busca1                    ;
                    width 650                                ;
                    height 450                               ;
                    virtual height MAX(nAlto-70,451)         ;
                    INTERNAL                               ;
                    nocaption                                ;
                    font "ms sans serif" size 9              ;
                    focused

                    CreaControles( oSrv_Mig, oQry_Mig )
                    Nuevo2(oQry_Mig)

                End Window

            @ 470,420 BUTTON ACEPTAR  CAPTION 'O&K' ACTION AceptaBuscar(oQry_Mig)
            @ 470,530 BUTTON CANCELAR CAPTION 'Ca&ncel' ACTION CancelaBuscar(oQry_Mig)

        END WINDOW

        CENTER WINDOW Win_Busca2
        ACTIVATE WINDOW Win_Busca2

    Endif

Return
*------------------------------------------------------------*
PROCEDURE AbrirTablas
*------------------------------------------------------------*

RETURN
*------------------------------------------------------------*
PROCEDURE CerrarTablas
*------------------------------------------------------------*

    win_1.release

RETURN
*------------------------------------------------------------*
PROCEDURE DesactivarEdicion(oQry_Mig)
*------------------------------------------------------------*

    For n := 1 to oQry_Mig:FCount()
       If aTxtBx[n] == .T.
          Win_1.&(aCtrol[n]).ReadOnly := .T.
       Else
          Win_1.&(aCtrol[n]).Enabled := .F.
       Endif
    Next

    Win_2.Aceptar.Enabled		:= .F.
    Win_2.Cancelar.Enabled		:= .F.
    Win_2.ToolBar_1.Enabled		:= .T.

RETURN
*------------------------------------------------------------*
PROCEDURE ActivarEdicion(oQry_Mig)
*------------------------------------------------------------*

    For n := 1 to oQry_Mig:FCount()
       If aTxtBx[n] == .T.
          Win_1.&(aCtrol[n]).ReadOnly := .F.
       Else
          Win_1.&(aCtrol[n]).Enabled := .T.
       Endif
    Next

    Win_2.Aceptar.Enabled		:= .T.
    Win_2.Cancelar.Enabled		:= .T.
    Win_2.ToolBar_1.Enabled		:= .F.

    Win_1.&(aCtrol[1]).SetFocus

RETURN
*------------------------------------------------------------*
PROCEDURE CancelarEdicion(oQry_Mig)
*------------------------------------------------------------*

    DesactivarEdicion(oQry_Mig)
    Actualizar2(oQry_Mig)
    Nuevo := .F.

RETURN
*------------------------------------------------------------*
PROCEDURE AceptarEdicion( oQry_Mig )
*------------------------------------------------------------*

    DesactivarEdicion(oQry_Mig)

    If Nuevo == .T.
        oQry_Mig:GetBlankRow(.F.)
        Nuevo := .F.
    EndIf

    For n := 1 to oQry_Mig:FCount()
        oQry_Mig:FieldPut( n , Win_1.&(aCtrol[n]).Value )
    Next

    oQry_Mig:Save()
    oQry_Mig:Refresh()
    Actualizar2( oQry_Mig )

RETURN

*------------------------------------------------------------*
PROCEDURE CancelaBuscar()
*------------------------------------------------------------*

    Win_Busca2.Release

RETURN

*------------------------------------------------------------*
PROCEDURE AceptaBuscar(oQry_Mig)
*------------------------------------------------------------*

    Local aBusca := {} , aNomb := {}

    For n := 1 to oQry_Mig:FCount()
        If !Empty(Win_Busca1.&(aCtrol[n]).Value )
           Aadd( aBusca, AllTrim(Win_Busca1.&(aCtrol[n]).Value) )
           Aadd( aNomb, oQry_Mig:FieldName(n) )
        Endif
    Next

    nRec := oQry_Mig:Find( aBusca, aNomb, , , .T. )

    IF nRec > 0
       oQry_Mig:GoTo( nRec )
       Actualizar2(oQry_Mig)
    Else
       MsgExclamation( 'No records for your query!', "MySQL Table: "+cTable+"- Viewer" )
    EndIf

    Win_Busca2.Release

Return
*------------------------------------------------------------*
PROCEDURE Nuevo(oQry_Mig)
*------------------------------------------------------------*

    For n := 1 to oQry_Mig:FCount()
        aadd( aCtrol , "Control_" + alltrim( str(n) ) )
        aadd( aName  , oQry_Mig:FieldName(n) )

        If oQry_Mig:FieldType(n)=='L'
            Win_1.&(aCtrol[n]).value := .F.
        Elseif oQry_Mig:FieldType(n)=='D'
            Win_1.&(aCtrol[n]).value := ctod("  /  /  ")
        Elseif oQry_Mig:FieldType(n)=='N'
            Win_1.&(aCtrol[n]).value := 0
        Elseif oQry_Mig:FieldType(n)=='C'
            Win_1.&(aCtrol[n]).value := ''
        Elseif oQry_Mig:FieldType(n)=='M'
            Win_1.&(aCtrol[n]).value := ''
        Endif
    Next

    ActivarEdicion(oQry_Mig)

RETURN

*------------------------------------------------------------*
PROCEDURE Nuevo2(oQry_Mig)
*------------------------------------------------------------*

    For n := 1 to oQry_Mig:FCount()
        aadd( aCtrol , "Control_" + alltrim( str(n) ) )
        aadd( aName  , oQry_Mig:FieldName(n) )

        If oQry_Mig:FieldType(n)=='L'
            Win_Busca1.&(aCtrol[n]).value := .F.
        Elseif oQry_Mig:FieldType(n)=='D'
            Win_Busca1.&(aCtrol[n]).value := ctod("  /  /  ")
        Elseif oQry_Mig:FieldType(n)=='N'
            Win_Busca1.&(aCtrol[n]).value := 0
        Elseif oQry_Mig:FieldType(n)=='C'
            Win_Busca1.&(aCtrol[n]).value := ''
        Elseif oQry_Mig:FieldType(n)=='M'
            Win_Busca1.&(aCtrol[n]).value := ''
        Endif
    Next

RETURN

*------------------------------------------------------------*
PROCEDURE Actualizar2( oQry_Mig )
*------------------------------------------------------------*

    Win_2.TITLE := 'MySQL Table: '+cTable+' - Record View #'+Alltrim(Str(oQry_Mig:RecNo()))

    For n := 1 to oQry_Mig:FCount()
        Win_1.&(aCtrol[n]).Value := oQry_Mig:FieldGet(n)
    Next


Return
*------------------------------------------------------------*
Function BloquearRegistro()
*------------------------------------------------------------*
    Local RetVal := .T.

Return RetVal
*------------------------------------------------------------*
Procedure Eliminar(oQry_Mig)
*------------------------------------------------------------*

    If MsgYesNo ( 'Are you sure?', 'Delete' )

        oQry_Mig:Delete()
        oQry_Mig:Refresh()
        Actualizar2(oQry_Mig)

    EndIf

Return

Procedure Imprimir( oQry_Mig, lCuadro )

   lCuadro := Iif(Empty(lCuadro),.F.,lCuadro)

   cTituloImp    := "MySQLRep"
   nFieldsLimit  := 6

   SELECT PRINTER DEFAULT TO lSuccess PREVIEW

   IF lSuccess

      START PRINTDOC
      START PRINTPAGE

      oQry_Mig:GoTop()

      PAG := 0
      LIN := 0

      DO WHILE .NOT. oQry_Mig:Eof()

         IF LIN>=260 .OR. PAG=0
            cMsgPie := "Continúa en la Hoja: "
            IF PAG <> 0  // Pie de página
               @ LIN+5,220/2-(Len(cMsgPie)/2) PRINT cMsgPie + Ltrim(Str( PAG + 1 ))
               END PRINTPAGE
               START PRINTPAGE
            ENDIF

            PAG++

            // Encabezado
            cHead1 := "MySQL Reporte"

            //@ 5,5    PRINT "0"
            //@ 5,210  PRINT "|"

            @ 20,20  PRINT cHead1
            @ 20,190 PRINT "Hoja: "+LTRIM(STR(PAG)) RIGHT

            cHead2 := "Tabla: "+cTable    // Nombre de la tabla
            nCol2  := 220/2  - ( Len( "25/05/2015"+cHead2+"17:30:00" ) / 2 )

            @ 25,20    PRINT DATE()
            @ 25,nCol2 PRINT cHead2 SIZE 12 BOLD
            @ 25,190   PRINT Hb_Cstr(TIME()) RIGHT

            nCol3 := 200/2 - Len(cTituloImp)/2
            @ 35,nCol3 PRINT cTituloImp FONT "Verdana" SIZE 14 BOLD
            @ 40,20  PRINT 'desde: '
            @ 45,20  PRINT 'hasta: '

            LIN:=55
            nLimit := iif( oQry_Mig:FCount() > nFieldsLimit, nFieldsLimit, oQry_Mig:FCount() )

            IF lCuadro = .T.
               @ LIN, 19 PRINT RECTANGLE TO LIN+5, 39
               @ LIN, 39 PRINT RECTANGLE TO LIN+5,109

               @ LIN,109 PRINT RECTANGLE TO LIN+5,141
            ELSE
               @ LIN+4,20 PRINT LINE TO LIN+4, nLimit * 32 PENWIDTH .01
            ENDIF

            COL := 20
            For n := 1 to nLimit   // Nombre de Campos
                @ LIN,COL PRINT oQry_Mig:FieldName( n ) BOLD CENTER
                COL := COL + Iif( MIN(oQry_Mig:FieldLen(n),50)< 30, 30, MIN(oQry_Mig:FieldLen(n),50) )
            Next

            LIN := LIN + 5

         ENDIF

         IF lCuadro = .T.
            @ LIN, 19 PRINT RECTANGLE TO LIN+5, 39
            @ LIN, 39 PRINT RECTANGLE TO LIN+5,109
            @ LIN,109 PRINT RECTANGLE TO LIN+5,141
         ENDIF

         COL := 20
         For n := 1 to nLimit  // Registros
             If oQry_Mig:FieldType( n )=="N"
                cRegData := TRANSFORM( oQry_Mig:FieldGet( n ), Mascara(oQry_Mig) )
             Else
                cRegData := oQry_Mig:FieldGet( n )
             Endif
             @ LIN,COL PRINT Left( Hb_CStr(cRegData), 15 )
             COL := COL + Iif( MIN(oQry_Mig:FieldLen(n),50)< 30, 30, MIN(oQry_Mig:FieldLen(n),50) )
         Next

         LIN := LIN + 5

         oQry_Mig:Skip()

      ENDDO

      END PRINTPAGE
      END PRINTDOC

   ELSE

      MsgStop( "Couldn't select default printer !", "ERROR !" )

   ENDIF

Return

Function Mascara( oQry_Mig )
   nLongTot := oQry_Mig:FieldLen( n )
   nLongDec := iif(Right( lTrim( oQry_Mig:FieldGet( n ) ),3)=".",2,0)
   cInpMsk  := iif( nLongDec > 0, REPLICATE( "9", nLongTot - nLongDec -1 ) + "." + ;
               REPLICATE( "9", nLongDec ), REPLICATE( "9", nLongTot - nLongDec ) )
Return( cInpMsk )

 

 

Herramienta para MySQL – Código Liberado V

MySQLInfo.prg – Parte V

*------------------------------------------------------------*
Procedure RellenaArray()
*------------------------------------------------------------*
   If lNueva
      Aadd( aServer, CtrlVentana.text_1.value    )
      Aadd( aUser,   CtrlVentana.text_2.value    )
      Aadd( aPass,   CtrlVentana.text_3.value    )
      Aadd( aDbase,  CtrlVentana.text_4.value    )
      Aadd( aFlags,  CtrlVentana.text_5.value    )
      Aadd( aPort,   CtrlVentana.Spinner_1.Value )
   Endif
Return

*------------------------------------------------------------*
Procedure LimpiaArray()
*------------------------------------------------------------*
    aServer := {}
    aUser   := {}
    aPass   := {}
    aDbase  := {}
    aPort   := {}
    aFlags  := {}
Return

*------------------------------------------------------------*
Procedure CambiaArray()
*------------------------------------------------------------*
    i := CtrlVentana.Grid_1.Value
        Afill( aServer, CtrlVentana.text_1.value ,   i )
        Afill( aUser,   CtrlVentana.text_2.value ,   i )
        Afill( aPass,   CtrlVentana.text_3.value ,   i )
        Afill( aDbase,  CtrlVentana.text_4.value ,   i )
        Afill( aFlags,  CtrlVentana.text_5.value ,   i )
        Afill( aPort,   CtrlVentana.Spinner_1.Value ,i )
Return

*------------------------------------------------------------*
Procedure CambiaText( i )
*------------------------------------------------------------*
    n := CtrlVentana.Grid_1.Value
    If n > 0
       If      i == 1
               Afill( aServer, CtrlVentana.text_1.value ,   n )
        ElseIf i == 2
               Afill( aUser,   CtrlVentana.text_2.value ,   n )
        ElseIf i == 3
               Afill( aPass,   CtrlVentana.text_3.value ,   n )
        ElseIf i == 4
               Afill( aDbase,  CtrlVentana.text_4.value ,   n )
        ElseIf i == 5
               Afill( aPort,   CtrlVentana.Spinner_1.Value ,n )
        ElseIf i == 6
               Afill( aFlags,  CtrlVentana.text_5.value,    n )
       Endif
    Endif
    CtrlVentana.Grid_1.Enabled := .T.
Return

*------------------------------------------------------------*
Procedure BorrarSesion()
*------------------------------------------------------------*
    n := CtrlVentana.Grid_1.Value
    If !Empty( CtrlVentana.Grid_1.Item( n ) )
        CtrlVentana.Grid_1.DeleteItem( n )
    Endif
    BorraArray( n )
    NuevaLong()
    if CtrlVentana.Grid_1.ItemCount > 0
       CtrlVentana.Grid_1.Value := 1
       CambiaDatos( CtrlVentana.Grid_1.Value )
    Else
       LimpiarTextos()
    Endif
Return

*------------------------------------------------------------*
Procedure BorraArray( x )
*------------------------------------------------------------*
    ADel( aServer, x )
    ADel( aUser,   x )
    ADel( aPass,   x )
    ADel( aDbase,  x )
    ADel( aPort,   x )
    ADel( aFlags,  x )
Return

*------------------------------------------------------------*
Procedure NuevaLong()
*------------------------------------------------------------*
    s := CtrlVentana.Grid_1.ItemCount
    ASize( aServer, s )
    ASize( aUser,   s )
    ASize( aPass,   s )
    ASize( aDbase,  s )
    ASize( aPort,   s )
    ASize( aFlags,  s )
Return

*------------------------------------------------------------*
Procedure CambiaDatos( i )
*------------------------------------------------------------*
   If !lNueva .AND. CtrlVentana.Grid_1.ItemCount > 0
       i := Iif( i > 0, i, 1)
       CtrlVentana.text_1.value    := aServer[i]
       CtrlVentana.text_2.value    := aUser[i]
       CtrlVentana.text_3.value    := aPass[i]
       CtrlVentana.text_4.value    := aDbase[i]
       CtrlVentana.text_5.value    := aFlags[i]
       CtrlVentana.Spinner_1.Value := aPort[i]
   Endif
Return

*------------------------------------------------------------*
Procedure VerArrays()
*------------------------------------------------------------*
    AutoMsgInfo(aServer,"aServer")
    AutoMsgInfo(aUser,"aUser")
    AutoMsgInfo(aPass,"aPass")
    AutoMsgInfo(aDbase,"aDbase")
    AutoMsgInfo(aPort,"aPort")
    AutoMsgInfo(aFlags,"aFlags")
Return

*------------------------------------------------------------*
Procedure AbrirIni()
*------------------------------------------------------------*

    CtrlVentana.Grid_1.DeleteAllItems

    BEGIN INI FILE "MyCli2.ini"

        GET nTotLog  SECTION 'Sesion' ENTRY 'Totses'   DEFAULT 0

        If nTotLog > 0
            For i := 1 To nTotLog
                GET cSesion  SECTION 'Sesion' ENTRY 'Conecta'+AllTrim(Str(i)) DEFAULT ""
                CtrlVentana.Grid_1.AddItem( cSesion )
                Aadd( aSesion, cSesion )
                GET cServer        SECTION 'Login'+AllTrim(Str(i))  ENTRY "Server"+AllTrim(Str(i)) DEFAULT 'localhost'
                Aadd( aServer, cServer )
                GET cUser          SECTION 'Login'+AllTrim(Str(i))  ENTRY "User"+AllTrim(Str(i))   DEFAULT 'root'
                Aadd( aUser, cUser )
                GET cPass          SECTION 'Login'+AllTrim(Str(i))  ENTRY "Pass"+AllTrim(Str(i))   DEFAULT ''
                Aadd( aPass, EncDec( cPass, 2 ) )
                GET cDbase         SECTION 'Login'+AllTrim(Str(i))  ENTRY "Dbase"+AllTrim(Str(i))  DEFAULT ''
                Aadd( aDbase, cDbase )
                GET nPort          SECTION 'Login'+AllTrim(Str(i))  ENTRY "Port"+AllTrim(Str(i))   DEFAULT 3306
                Aadd( aPort, nPort )
                GET nFlags         SECTION 'Login'+AllTrim(Str(i))  ENTRY "Flags"+AllTrim(Str(i))  DEFAULT 0
                Aadd( aFlags, nFlags )
                cSesion := ""; cServer := "" ; cUser := ""; cPass := ""; cDbase := ""; nPort := 0; nFlags := 0
            Next i
        Else
            LimpiaArray()
        Endif

    END INI

    CtrlVentana.Grid_1.Value := 1
    CambiaDatos( CtrlVentana.Grid_1.Value )

Return

*------------------------------------------------------------*
Procedure GuardaIni()      // Guarda variables en Ini
*------------------------------------------------------------*
    If lNueva
       RellenaArray()
       lNueva := .F.
    Endif

    Erase("MyCli2.ini")

    n := CtrlVentana.Grid_1.ItemCount

    BEGIN INI FILE "MyCli2.ini"

        SET SECTION 'Sesion' ENTRY "Totses" TO n

        If n > 0
            For i := 1 To n
                cSesion := AllTrim(CtrlVentana.Grid_1.Item(i) )
                SET SECTION 'Sesion'                ENTRY "Conecta"+AllTrim(Str(i))  TO cSesion
                cServer := aServer[i]
                SET SECTION 'Login'+AllTrim(Str(i)) ENTRY 'Server'+AllTrim(Str(i))   TO cServer
                cUser := aUser[i]
                SET SECTION 'Login'+AllTrim(Str(i)) ENTRY 'User'+AllTrim(Str(i))     TO cUser
                cPass := EncDec( aPass[i], 1 )
                SET SECTION 'Login'+AllTrim(Str(i)) ENTRY 'Pass'+AllTrim(Str(i))     TO cPass
                cDbase := aDbase[i]
                SET SECTION 'Login'+AllTrim(Str(i)) ENTRY 'Dbase'+AllTrim(Str(i))    TO cDbase
                nPort := aPort[i]
                SET SECTION 'Login'+AllTrim(Str(i)) ENTRY 'Port'+AllTrim(Str(i))     TO nPort
                nFlags := aFlags[i]
                SET SECTION 'Login'+AllTrim(Str(i)) ENTRY 'Flags'+AllTrim(Str(i))    TO nFlags
                cSesion := ""; cServer := "" ; cUser := ""; cPass := ""; cDbase := ""; nPort := 0; nFlags := 0
            Next
        Endif

    END INI

Return

*--------------------------------------------------------------------------*
Procedure MakeObjCon( _cServidor,_cUsuario,_cClave,_cBase,_nPuerto,_nFlags )
*--------------------------------------------------------------------------*
    // Crea el objeto de conexion a MySql.---------------------------------
    IF !Empty( _cServidor ) .AND. !Empty( _cUsuario )
        // Si el servidor esta disponible intenta conectarse.----------
        setMessage( "Conectando al servidor MySql..." , 1 )

        oServidor := TDolphinSrv():New( _cServidor,_cUsuario,_cClave,_nPuerto,_nFlags,_cBase,  ;
                     {| oServer, nError, lInternal | GetError( oServer, nError, lInternal  ) } )

        If !( oServidor:lError )
            _lConectado := .T.
            wndPrincipal.Title := _GEN_PROGRAMA+" - [ "+oServidor:cHost+" ]"
            UpdateTree()
            UpdateVars()
            UpdateStatus()
            SalirConecta()
        ENDIF
        // Actualiza la ventana principal.-------------------------------------
        setMessage()
        UpdateMain()
    ENDIF

Return

 

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