HMGforum.com

Code: Select all

* Para Compilar: hbmk2 sample -lxhb

#include "dbinfo.ch"

#xcommand DEFAULT <uVar1> := <uVal1> ;
               [, <uVarN> := <uValN> ] => ;
                  If( <uVar1> == nil, <uVar1> := <uVal1>, ) ;;
                [ If( <uVarN> == nil, <uVarN> := <uValN>, ); ]

#translate CRLF => HB_OsNewLine()

request DBFCDX

*************
function MAIN
*************

cls

aStruct := { }

AAdd( aStruct, { "cod_plano", "c",  7, 0 } )
AAdd( aStruct, { "nome"     , "c", 20, 0 } )
AAdd( aStruct, { "diavenc"  , "D",  8, 0 } )
AAdd( aStruct, { "valor"    , "n", 12, 2 } )
AAdd( aStruct, { "sel_ok"   , "l",  1, 0 } )

oData1 := TDBFMEM():new()

oData1:cNome   := "TESTE1"
oData1:cAlias  := "TST1"
oData1:aStruct := aStruct
oData1:aIndex  := { { "cod_plano", "" }, ;
                    { "nome + cod_plano", "val(cod_plano) >= 1 .and. val(cod_plano) <= 10" } } 

if !oData1:create()
   quit
endif

oData1:open()

? "Vou arquivo o arquivo " + oData1:cAlias
? "Area do arquivo " + oData1:cAlias, oData1:nArea() //  o mesmo que: select( oData1:cAlias )

oData2 := TDBFMEM():new()

oData2:cNome   := "TESTE2"
oData2:cAlias  := "TST2"
oData2:aStruct := aStruct
oData2:aIndex  := { { "cod_plano", "" }, ;
                    { "nome + cod_plano", "val(cod_plano) >= 1 .and. val(cod_plano) <= 10" } } 

if !oData2:create()
   quit
endif

oData2:open()

? "Vou arquivo o arquivo " + oData2:cAlias
? "Area do arquivo " + oData2:cAlias, oData2:nArea() //  o mesmo que: select( oData1:cAlias )

msginfo( "Tecle ENTER..." )

cls

? "Arquivos carregados na memoria"

msginfo( sl_tostring( ALIAS_TEMP() ) )

cls

? "Estrutura do arquivo " + oData2:cAlias

msginfo( sl_tostring( (oData2:cAlias)->( dbstruct() ) ) )

cls

? "Informacoes do arquivo ", oData1:cAlias
? "used() ", hb_valtostr( (oData1:cAlias)->( used() ) )
? "select() ", alltrim(hb_valtostr( select( oData1:cAlias ) ))

msginfo( "Tecle ENTER..." )

cls

? "Fechei o arquivo ", oData1:cAlias

oData1:close() // Pode-se fazer assim tambem: (oData1:cAlias)->( DBCLOSEAREA() )

? "Informacoes do arquivo ", oData1:cAlias
? "used() ", hb_valtostr( (oData1:cAlias)->( used() ) )
? "select() ", alltrim(hb_valtostr( select( oData1:cAlias ) ))

msginfo( "Tecle ENTER..." )

cls

oData1:open()

? "Abri novamente o arquivo ", oData1:cAlias
? "used() ", hb_valtostr( (oData1:cAlias)->( used() ) )
? "select() ", alltrim(hb_valtostr( select( oData1:cAlias ) ))

msginfo( "Tecle ENTER..." )

cls

for n = 1 to 100
    (oData1:cAlias)->( dbappend() )
    (oData1:cAlias)->COD_PLANO := strzero( n, 7 )
    (oData1:cAlias)->NOME      := chr( 75 - n ) +"TESTE" + alltrim(str( n, 7 ))
    (oData1:cAlias)->DIAVENC   := date() + n
    (oData1:cAlias)->VALOR     := n * 1.23
    (oData1:cAlias)->SEL_OK    := iif( n % 2 = 0, .T., .F. )
next

for n = 1 to 100
    (oData2:cAlias)->( dbappend() )
    (oData2:cAlias)->COD_PLANO := strzero( n, 7 )
    (oData2:cAlias)->NOME      := chr( 75 - n ) +"TESTE" + alltrim(str( n, 7 ))
    (oData2:cAlias)->DIAVENC   := date() + n
    (oData2:cAlias)->VALOR     := n * 1.23
    (oData2:cAlias)->SEL_OK    := iif( n % 2 = 0, .T., .F. )
next

? "Posicionando no registro 2 do arquivo " + oData1:cAlias

(oData1:cAlias)->( dbgoto(2) )

? "Registro atual do arquivo " + oData1:cAlias, (oData1:cAlias)->( recno() )

? "Index atual",   "[" + (oData1:cAlias)->( DBORDERINFO( DBOI_INDEXNAME, "_" + oData1:cNome, 1 ) ) + "]"
? "Condicao do index atual", "[" + (oData1:cAlias)->( DBORDERINFO( DBOI_CONDITION, "_" + oData1:cNome, 2 ) ) + "]"

msginfo( "Tecle ENTER..." )

cls

? "Agora vou ler um registro do arquivo " + oData1:cAlias + " ordenado por " + oData1:aIndex[1,1]

(oData1:cAlias)->(DBSETORDER(1))

(oData1:cAlias)->(DBGOTOP())
if (oData1:cAlias)->( DBSEEK( "0000004", .F. ) )
   ? "0000004 EXISTE"
ELSE
   ? "0000004 NAO EXISTE"
ENDIF

? "Agora vou ler um outro registro do arquivo " + oData1:cAlias + " ordenado por " + oData1:aIndex[1,1]

(oData1:cAlias)->(DBGOTOP())
if (oData1:cAlias)->( DBSEEK( "0000112", .F. ) )
   ? "0000112 EXISTE"
ELSE
   ? "0000112 NAO EXISTE"
ENDIF

msginfo( "Tecle ENTER..." )

cls

msginfo( "Agora vou mostrar o browse do arquivo " + oData1:cAlias + " ordenado por " + oData1:aIndex[1,1] )

cls

(oData1:cAlias)->(DBGOTOP())
(oData1:cAlias)->( browse() )

cls

msginfo( "Agora vou mostrar o browse do arquivo " + oData1:cAlias + " ordenado por " + oData1:aIndex[2,1] )

cls

(oData1:cAlias)->(DBSETORDER(2))
(oData1:cAlias)->(DBGOTOP())
(oData1:cAlias)->( browse() )

msginfo( "Agora vou mostrar o browse do arquivo " + oData2:cAlias + " ordenado por " + oData1:aIndex[1,1] )

(oData2:cAlias)->(DBSETORDER(1))
(oData2:cAlias)->(DBGOTOP())
(oData2:cAlias)->( browse() )

cls

oData1:close()

? "Fechei <TESTE1>"
? "Quais alias estao na memoria ?"

msginfo( sl_tostring( ALIAS_TEMP() ) )

cls

msginfo( "Vou reabrir <TESTE1>" )

oData1:Open()

cls

? "Quais alias estao na memoria ?"

msginfo( sl_tostring( ALIAS_TEMP() ) )

msginfo( "Agora vou mostrar o browse do arquivo " + oData1:cAlias + " ordenado por " + (oData1:cAlias)->(indexkey()) )

(oData1:cAlias)->(DBGOTOP())
(oData1:cAlias)->( browse() )

cls

? "Fechando o arquivo " + oData1:cAlias

oData1:close()
oData1:destroy()

oData1 := NIL

msginfo( "Fechando o arquivo " + oData2:cAlias )

oData2:close()
oData2:destroy()

oData2 := NIL

cls

? "Quais alias estao na memoria ?"

msginfo( sl_tostring( ALIAS_TEMP() ) )

cls

? ""
? ""
? "bye..."
? ""
? ""
? ""

return NIL

********************
function SL_ToString( x, lLineFeed, lInherited, lType, cFile, lForceLineFeed )
********************

    local s := ''
    local t := valtype( x )
    local i, j

    DEFAULT lLineFeed      := .T.
    DEFAULT lInherited     := .F.
    DEFAULT lType          := .F.
    DEFAULT cFile          := ""
    DEFAULT lForceLineFeed := .F.
    
    do case
       case ( t == "C" )
            s := iif( lType, "[C]=", "" ) + '"' + x + '"'
       case ( t == "N" )
            s := iif( lType, "[N]=", "" ) + alltrim(str( x ))
       case ( t == "D" )
            s := iif( lType, "[D]=", "" ) + "ctod('"+ dtoc(x) +"')"
       case ( t == "L" )
            s := iif( lType, "[L]=", "" ) + iif( x, '.T.', '.F.' )
       case ( t == "M" )
            s := iif( lType, "[M]=", "" ) + '"' + x + '"'
       case ( t == "B" )
            s := iif( lType, "[B]=", "" ) + '{|| ... }'
       case ( t == "U" )
            s := iif( lType, "[U]=", "" ) + 'NIL'
       case ( t == "A" )
            s := iif( lType, "[A]=", "" ) + "{"
            if len(x) = 0
               s += " "
            else
               s += iif( valtype( x[1] ) = "A" .or. lForceLineFeed, CRLF, "" )
               j := len(x)
               
               for i := 1 to j
                   s += iif( valtype( x[i] ) == "A", "  ", " " ) + iif( lForceLineFeed, " ", "" ) + SL_ToString( x[i], .F. )
                   s += iif( i <> j, ",", "" )
                   if lLineFeed
                      if !lInherited .and. ( valtype( x[i] ) == "A" .or. lForceLineFeed )
                         s += CRLF
                      endif
                   endif
               next
            endif         
            s += iif( !lForceLineFeed, " ", "" ) + "}"

       case ( t == "O" )
            if lInherited
               && É necessário linkar \harbour\lib\xhb.lib
               s := iif( lType, "[O]=", "" ) + hb_dumpvar( x ) + iif( lLineFeed, CRLF, "" )
            else
               s := iif( lType, "[O]=", "" ) + x:ClassName()+'():New()' + iif( lLineFeed, CRLF, "" )
            endif
    endcase
    
    if !empty( cFile )
       memowrit( cFile, s )
    endif
    
return s

****************
function msginfo( cMsg )
****************

wait cMsg

return NIL

#include "tdbfmem.prg"

Code: Select all

#include "dbinfo.ch"
#include "hbclass.ch"

//----------------------------------------------------------------------------//
static aAliases
//----------------------------------------------------------------------------//

CLASS TDBFMEM

    DATA cNome     INIT ""
    DATA cNomeTemp INIT ""
    DATA cAlias    INIT ""
    DATA cModo     INIT "E"   // E=Exclusive / S=Shared
    DATA aStruct   INIT { }
    DATA aIndex    INIT { }
    
    METHOD Create()
    METHOD Open()
    METHOD Close()
    METHOD Destroy()
    METHOD nArea() INLINE select( ::cAlias )

    METHOD New() CONSTRUCTOR

ENDCLASS

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

METHOD New() CLASS TDBFMEM

   local cDirTemp

   if valtype( aAliases ) = "U"
      aAliases := { => } // hb_hash()
   endif

   cDirTemp := GetEnv( "TEMP" )
   if empty( cDirTemp ) ; cDirTemp := GetEnv( "TMP" ) ; endif
   if empty( cDirTemp ) ; cDirTemp := "."             ; endif

   ::cNomeTemp := cDirTemp + "\MEM:"

return SELF

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

METHOD Create() CLASS TDBFMEM

   local n, cData, cCond, aAlias

   ::cAlias := upper(::cAlias)
   ::cNome  := upper(::cNome)

   aAlias   := ALIAS_TEMP()

   if ascan( aAlias, { |aElem| aElem[1] == ("MEM:" + ::cNome) } ) > 0
      MsgInfo( "Nome de arquivo [" + ::cNome + "] já Existe na memória !!!" + CRLF + ;
               "O sistema será abandonado !!!", "..:: Atenção ::.." )
      return .F.
   endif   

   if hb_HHasKey( aAliases, ::cAlias )
      MsgInfo( "Alias [" + ::cAlias + "] já Existe na memória !!!" + CRLF + ;
               "O sistema será abandonado !!!", "..:: Atenção ::.." )
      return .F.
   else
      aAliases[::cAlias] := "MEM:" + ::cNome
   endif   

   DbCreate( (::cNomeTemp + ::cNome), ::aStruct, "DBFCDX", .T., (::cAlias) )

   ::close()

//   ::Open()

return .T.

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

METHOD Open() CLASS TDBFMEM

   aAliases[::cAlias] := "MEM:" + ::cNome
   
   if ::cModo = "E"
      Use ( ::cNomeTemp + ::cNome ) Alias (::cAlias) via "DBFCDX" New Exclusive
   else                                                                   
      Use ( ::cNomeTemp + ::cNome ) Alias (::cAlias) via "DBFCDX" New shared   
   endif

   if !empty( ::aIndex )
      for n = 1 to len(::aIndex)
          cData := ::aIndex[n,1]
          cCond := ::aIndex[n,2]
          if empty( cCond  )
             (::cAlias)->( ordCondSet(      ,,,,         ,, recno(),,,,,, iif( n = 1, .F., .T. ),,,,, .T.,, ) )
          else
             (::cAlias)->( ordCondSet( cCond,,,, &(cCond),, recno(),,,,,, iif( n = 1, .F., .T. ),,,,, .T.,, ) )
          endif
          (::cAlias)->( ordCreate( "_" + ::cNome, "I" + strzero( n, 2 ), cData, &(cData), ) )
      next
   endif

return ::nArea

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

METHOD close() CLASS TDBFMEM

   local n

   if ( n := hb_hPos( aAliases, ::cAlias ) ) > 0
      hb_hDelAt( aAliases, n )
   endif

   (::cAlias)->( dbclosearea() )

return NIL

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

METHOD destroy() CLASS TDBFMEM

   if empty( aAliases )
      aAliases := NIL
   endif

   hb_dbdrop( ::cNomeTemp + ::cNome )

   hb_GCALL( .T. )

return NIL // ( ferase( "mem" ) = 0 )

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

*******************
function ALIAS_TEMP
*******************

local aAlias := { }, cKey
local aKeys

if valtype( aAliases ) = "U"
   return aAlias
endif
   
aKeys := hb_HKeys( aAliases )

for each cKey IN aKeys
    aadd( aAlias, { hb_HGet( aAliases, cKey ), cKey } )
next      

return aAlias

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

// EOF //