PC Toledo

Ola amigos,

Eu uso o harbour e o xharbour e gostaria de aprender algumas coisas sobre a codificação abaixo, postada a algum tempo atrás pelo Leonardo:

Código: Selecionar todos

REQUEST HB_MEMIO
PROC Main()
 LOCAL nI
 FIELD F1

 DBCREATE("mem:test", {{"F1", "N", 9, 0}},, .T., "memarea")
 FOR nI := 1 TO 1000
     DBAPPEND(); F1 := HB_RANDOM() * 1000000
 NEXT
 INDEX ON F1 TAG f1
 DBEVAL({|| QOUT(F1)})  <-
 DBCLOSEAREA()
 DBDROP("mem:test") // Free memory resource

 RETURN

1) Qual o objetivo da Linha 11 ?

Código: Selecionar todos

 DBEVAL({|| QOUT(F1)})

2) Notei que o exemplo gera registro em branco usando o Dbappend() tal como é feito nos Dbfs em disco, entretanto, não vi
o comando "Replace " ser usado para jogar o conteudo no campo F1.

Como então é feito o preenchimento do campo F1 de cada registro ?

3) O arquivo é indexado pela chave F!, então, Como dar um seek em uma determinada chave ?

4) Depois de gerado o arquivo "Test" , Como devo proceder para:
1-Abrir o arquivo gerado
2-Ir para o topo do aruqivo ?
3-Ler sequencialmente o conteúdo do campo F1 de cada registro gerado ?
4-deletar algum dos registros ?

Grato,

Saudações!

Qual o objetivo da Linha 11 ?

Salvo engano parece que mostra o conteúdo do campo F1 na tela durante a indexação (função Qout = ?)

Como então é feito o preenchimento do campo F1 de cada registro ?

Código: Selecionar todos

DBAPPEND(); F1 := HB_RANDOM() * 1000000

Veja acima:
dbappend() // cria um registro em branco.
F1 := HB_RANDOM() * 1000000 // coloca na variável F1 o retorno da operação matemática (note que a variável é um campo do dbf)

3) O arquivo é indexado pela chave F!, então, Como dar um seek em uma determinada chave ?

exemplo: seek 500
Neste caso vai procurar o campo F1 que é igual a 500

Yugi386

Para ver o que acontece com as outras questões compile e execute:

Código: Selecionar todos

REQUEST HB_MEMIO
PROC Main()
 LOCAL nI
 FIELD F1

 DBCREATE("mem:test", {{"F1", "N", 9, 0}},, .T., "memarea")
 FOR nI := 1 TO 1000
     DBAPPEND(); F1 := HB_RANDOM() * 1000000
 NEXT
 
 DBAPPEND(); F1 := 1000
 
 INDEX ON F1 TAG f1
 DBEVAL({|| QOUT(F1)})
 
// indo para o topo
 go top
 seek 1000
 if found()
      ? "achou"
 endif
 seek 1001 // pesquisando
 if .not.found()   // verifica se achou
      ? "não achou"
 endif
 
 go top
 ? f1
 
 delete // delete mas não apaga
 ? f1
 ? deleted()
 pack    // apaga de vez
 
 go top   // vai para o topo de novo
 ? f1
 
 
 DBCLOSEAREA()
 DBDROP("mem:test") // Free memory resource  destroi o banco

 RETURN

Valeu, Yugi, compreendi quase tudo.

A exceção ficou por conta de como atribuir um select() ao arquivo mem:Test, para permitir que ele seja aberto em um LOOP onde tb haja
outros arquivos sendo abertos.

É q no exemplo usado até agora, o mem:Test tem sido arquivo único... Seria algo assim ?

Código: Selecionar todos

REQUEST HB_EMIO
proc Main()

Field F1, F2     // 2 campos a criar
DbCreate("mem:test", {{"F1", "N", 9, 0}}, {{"F2", "C", 20, 0}}, .T., "memarea")
Index on F1 tag F!  // Será q Pode Montar Chave com arquivo ainda Vazio ??

Sele 1
use Mem:Test  alias Temp// <- Seria assim ?????

sele 2
use Cadastro alias Cad 
go top
do while .not. eof()
    Tmat=Matricula  
    Tnome=Nome

     sele Temp //  < - Seria assim ???
     seek Tmat
     if eof()
        DBAPPEND()
        F1 := TMat
        F2=Tnome
     endif

     sele cad
     skip
enddo

sele Cad 
use

E Como faz pra ler mem:test sequencialmente e exibir seu conteudo ? As clausuila eof() e SKIP funcionam ?

Código: Selecionar todos

********************************
* Descarreganso o mem:Test
*********************************
sele Temp 
go top
L=1
do while .not. eof()
    @ l,10  say f1 pict "999999999"
    @ l,20  say F2
    skip
enddo
DBCLOSEAREA()
DBDROP("mem:test") // Free memory resource destroi o banco
retu nil

Teoricamente não existe diferença dos comandos
Todos os comandos do dbf podem ser usados em um arquivo criado em memória.
replace, locate, seek, etc...

Saudações,
Itamar M. Lins Jr.

Olá Pessoal,

Segue abaixo uma classe que desenvolvi aqui apara controlar DBF em memória e também um exemplo como se usar.

Classe TDBFMEM -> TDBFMEM.PRG

Código: Selecionar todos

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

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

CLASS TDBFMEM

    DATA cNome     INIT ""
    DATA cNomeTemp INIT ""
    DATA cAlias    INIT ""
    DATA cModo     INIT "E"  // E=Exclusivo   /  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 type( "aTDBF_Aliases" ) = "U"
      public aTDBF_Aliases // 23/04/14
      aTDBF_Aliases := hb_hash()
   endif

   cDirTemp := hb_GetEnv( "TEMP" )
   if empty( cDirTemp ) ; cDirTemp := hb_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( aTDBF_Aliases, ::cAlias )
      msginfo( "Alias [" + ::cAlias + "] já Existe na memória !!!" + CRLF + ;
               "O sistema será abandonado !!!", "..:: Atenção ::.." )
      return .F.
   else
      aTDBF_Aliases[::cAlias] := "MEM:" + ::cNome
   endif   

   DbCreate( (::cNomeTemp + ::cNome), ::aStruct, "DBFCDX", .T., (::cAlias) )
/*
   if !hb_dbCreateTemp( (::cAlias), (::aStruct), "DBFCDX", ,  )
      msginfo( "Não consegui criar a tabela temporária [" + ::cAlias + "] !!!" + CRLF + ;
               "O sistema será abandonado !!!", "..:: Atenção ::.." )
      return .F.
   endif
*/
   ::close()

//   ::Open()

return .T.

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

METHOD Open() CLASS TDBFMEM

   aTDBF_Aliases[::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( aTDBF_Aliases, ::cAlias ) ) > 0
      hb_hDelAt( aTDBF_Aliases, n )
   endif

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

return NIL

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

METHOD destroy() CLASS TDBFMEM

   if empty( aTDBF_Aliases )
      aTDBF_Aliases := NIL
   endif

   hb_dbdrop( ::cNomeTemp + ::cNome )

//   hb_GCALL( .T. )

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

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

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

local aAlias := { }, cKey
local aKeys

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

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

return aAlias

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

// EOF //

Exemplo de uso dela -> TDBF.PRG

Código: Selecionar todos

* Para Compilar: hbmk2 tdbf.prg tdbfmem.prg -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

Espero que gostem.

Sugestões e correções serão bem vindas

Obs: Testada somente em harbour.

T+

Rossine.

Obrigado Yugi, Itamar e Rossine...

E agora eu vou estudar

Zebra, amigos...

Nenhuma das funções abaixo funcionaram.

1)
Index on F1 tag F! // o List mostrou que o "Index()" Nao indexou nada q foi gerado em memória

2)
Sele 1
use Mem:Test alias Temp // o comando Use() nem executou. Deu erro pq só serve para DBF em disco

3)
sele Temp // o Sele() nem foi possível testar, já que o use não funcionou

4)
Seek() e goto() // Tb nem foi possível testar

Pelo menos para mim, a grande questão q ficou foi:
Pra que serve o HBMEMIO() , se o aquivo gerado em memória não pode ser manipulados como se um DBF fosse ?

PS: Infelizmente eu não tive capacidade de compreender a colaboração do Rossine. A Rotina está anos-luz à frente da minha sofrível qualificação

Em Harbour ok 100%

Agora em xHarbour deu os seguintes erros devido as funções não encontradas, alguém sabe as correlatas ou como resolver?

Turbo Incremental Link 5.00 Copyright (c) 1997, 2000 Borland
Error: Unresolved external '_HB_FUN_HB_PROCESSOPEN' referenced from D:\PROJETOS\SISTEMAS\_LIBS\X\LIBx.LIB|Funcoes_Div
Error: Unresolved external '_HB_FUN_HB_PROCESSCLOSE' referenced from D:\PROJETOS\SISTEMAS\_LIBS\X\LIBx.LIB|Funcoes_Div
Error: Unresolved external '_HB_FUN_HB_HASH' referenced from D:\PROJETOS\SISTEMAS\OBJ_DEBUG\ALIQ.OBJ
Error: Unresolved external '_HB_FUN_HB_GETENV' referenced from D:\PROJETOS\SISTEMAS\OBJ_DEBUG\ALIQ.OBJ
Error: Unresolved external '_HB_FUN_HB_HHASKEY' referenced from D:\PROJETOS\SISTEMAS\OBJ_DEBUG\ALIQ.OBJ
Error: Unresolved external '_HB_FUN_HB_HPOS' referenced from D:\PROJETOS\SISTEMAS\OBJ_DEBUG\ALIQ.OBJ
Error: Unresolved external '_HB_FUN_HB_HDELAT' referenced from D:\PROJETOS\SISTEMAS\OBJ_DEBUG\ALQ.OBJ
Error: Unresolved external '_HB_FUN_HB_HKEYS' referenced from D:\PROJETOS\SISTEMAS\OBJ_DEBUG\ALIQ.OBJ
Error: Unresolved external '_HB_FUN_HB_HGET' referenced from D:\PROJETOS\SISTEMAS\OBJ_DEBUG\ALIQ.OBJ

[]´s

Olá Fladimir,

Olhando o arquivo \harbour\contribs\xhb\hbcompat.ch do harbour tem um xtranslate para estas funções abaixo.

Troque HB_HASH por HASH
Troque HB_GETENV por GETENV
Troque HB_HHASKEY por HHASKEY
Troque HB_HPOS por HGETPOS
Troque HB_HDELAT por HDELAT
Troque HB_HKEYS por HGETKEYS
Troque HB_HGET' por HGET

As únicas duas que eu não sei te dizer são as funções:

HB_PROCESSOPEN
HB_PROCESSCLOSE

Pois como uso somente harbour, então não sei lhe dizer. Talvez alguém que use o xHarbour saberá lhe informar se existe estas funções do xharbour.

Abraço,

Rossine.

Vlw Rossine...

Com excessão do hb_processOpen() e da hb_processClose() (referente a outra função não pertinente a este tópico, mas q esta no fonte e foi comentada)

As demais q são pertinentes ao tópico em questão ficaram ok..

Grato

[]´s

Prezado Lugab. Eis a solução:

Código: Selecionar todos

REQUEST HB_MEMIO
PROC Main()
 LOCAL nI
 FIELD F1, F2   // não esqueça de declarar os campos

 cls
 
 // Cria primeiro arquivo
 DBCREATE("mem:test1", {{"F1", "N", 9, 0}},, .T., "memarea")
 FOR nI := 1 TO 1000
     DBAPPEND(); F1 := HB_RANDOM() * 1000000
 NEXT
 INDEX ON F1 TAG f1    // indexando arquivo 1
DBCLOSEAREA()   // fecha arquivo
 
// Cria Segundo arquivo 
 DBCREATE("mem:test2", {{"F2", "N", 9, 0}},, .T., "memarea")
 FOR nI := 1 TO 1000
     DBAPPEND(); F2 := HB_RANDOM() * 1000000
 NEXT
 INDEX ON F2 TAG f2  // indexando arquivo 2
DBCLOSEAREA()   // fecha arquivo
  
 // Abrindo os dois arquivos juntos:
  
 db1 = "mem:test1"
 use &db1 alias arq1 
 set order to f1
 go top
 ? "teste arq1 " + str(f1)
  
 db2 = "mem:test2"
 use &db2 new alias arq2
 set order to f2
 go top
 ? "teste arq2 " + str(f2)
 
 // Trocando as areas de trabalho
 
 DBSELECTAREA("arq1")
 skip
 ? "arquivo 1 " + str(f1)
 
 DBSELECTAREA("arq2")
 skip
 ? "arquivo 2 " + str(f2)
 
 // passeando pelos arquivos
 DBSELECTAREA("arq1")
 skip
 ? "arquivo 1 " + str(f1)
 
 DBSELECTAREA("arq2")
 skip
 ? "arquivo 2 " + str(f2)
 
 // fechando os arquivos
 DBSELECTAREA("arq1")
 dbclosearea()
 
 DBSELECTAREA("arq2")
 dbclosearea()
 
 DBDROP("mem:test1") // destroi o arquivo 1
 DBDROP("mem:test2") // destroi o arquivo 2

 RETURN

[]s

Yugi386

Desculpe amigos no código anterior os índices não estavam funcionando.
Agora parece que está. Segue correção:

Código: Selecionar todos

REQUEST HB_MEMIO
PROC Main()
 LOCAL nI
 FIELD F1, F2   // não esqueça de declarar os campos

 cls
 
 // Cria primeiro arquivo
 DBCREATE("mem:test1", {{"F1", "N", 9, 0}},, .T., "memarea")
 FOR nI := 1 TO 1000
     DBAPPEND(); F1 := HB_RANDOM() * 1000000
 NEXT
 // INDEX ON F1 TAG f1    // indexando arquivo 1
 DBCREATEINDEX( "F1", "F1",,,"memarea")
 
DBCLOSEAREA()   // fecha arquivo
 
// Cria Segundo arquivo 
 DBCREATE("mem:test2", {{"F2", "N", 9, 0}},, .T., "memarea")
 FOR nI := 1 TO 1000
     DBAPPEND(); F2 := HB_RANDOM() * 1000000
 NEXT
 // INDEX ON F2 TAG f2  // indexando arquivo 2
 DBCREATEINDEX( "F2", "F2",,,"memarea")
DBCLOSEAREA()   // fecha arquivo
  
 // Abrindo os dois arquivos juntos:
  
 db1 = "mem:test1"
 use &db1 alias arq1 
 // set order to f1
 DBsetindex("F1","memarea")
 go top
 ? "teste arq1 " + str(f1)
  
 db2 = "mem:test2"
 use &db2 new alias arq2
 // set order to f2
 DBsetindex("F2","memarea")
 go top
 ? "teste arq2 " + str(f2)
 
 // Trocando as areas de trabalho
 
 DBSELECTAREA("arq1")
 skip
 ? "arquivo 1 " + str(f1)
 
 DBSELECTAREA("arq2")
 skip
 ? "arquivo 2 " + str(f2)
 
 // passeando pelos arquivos
 DBSELECTAREA("arq1")
 skip
 ? "arquivo 1 " + str(f1)
 
 DBSELECTAREA("arq2")
 skip
 ? "arquivo 2 " + str(f2)
 
 ?
 ? "Arquivo 1 - Indexação:"
 ?
  // fechando os arquivos
 DBSELECTAREA("arq1")
 // verificando se os índices estão corretos:
 go top
 for ct:= 1 to 10 
    ? F1
    skip
 next
 dbclosearea()
 
 ?
 ? "Arquivo 2 - Indexação:"
 ?
  DBSELECTAREA("arq2")
 go top
 for ct:= 1 to 10 
    ? F2
    skip
 next
 dbclosearea()
 
 DBDROP("mem:test1") // destroi o arquivo 1
 DBDROP("mem:test2") // destroi o arquivo 2

 RETURN

[]s

Yugi386

Mais uma correção: os índices estavam sendo criados no disco.
Agora parece que está tudo certo:

Código: Selecionar todos

REQUEST HB_MEMIO
PROC Main()
 LOCAL nI
 FIELD F1, F2   // não esqueça de declarar os campos

 cls
  
 // Cria primeiro arquivo
 DBCREATE("mem:test1", {{"F1", "N", 9, 0}},, .T., "memarea")
 FOR nI := 1 TO 1000
     DBAPPEND(); F1 := HB_RANDOM() * 1000000
 NEXT
 indice1 = "mem:F1"
 DBCREATEINDEX( indice1, "F1")
 DBCLOSEAREA()   // fecha arquivo
 
// Cria Segundo arquivo 
 DBCREATE("mem:test2", {{"F2", "N", 9, 0}},, .T., "memarea")
 FOR nI := 1 TO 1000
     DBAPPEND(); F2 := HB_RANDOM() * 1000000
 NEXT
  indice2 = "mem:F2"
  DBCREATEINDEX( indice2, "F2")
  DBCLOSEAREA()   // fecha arquivo
  
 // Abrindo os dois arquivos juntos:
  
 db1 = "mem:test1"
 use &db1 alias arq1 
 DBsetindex(indice1)
 go top
 ? "teste arq1 " + str(f1)
  
 db2 = "mem:test2"
 use &db2 new alias arq2
 DBsetindex(indice2)
 go top
 ? "teste arq2 " + str(f2)
 
 // Trocando as areas de trabalho
 
 DBSELECTAREA("arq1")
 skip
 ? "arquivo 1 " + str(f1)
 
 DBSELECTAREA("arq2")
 skip
 ? "arquivo 2 " + str(f2)
 
 // passeando pelos arquivos
 DBSELECTAREA("arq1")
 skip
 ? "arquivo 1 " + str(f1)
 
 DBSELECTAREA("arq2")
 skip
 ? "arquivo 2 " + str(f2)
 
 ?
 ? "Arquivo 1 - Indexação:"
 ?
  // fechando os arquivos
 DBSELECTAREA("arq1")
 // verificando se os índices estão corretos:
 go top
 for ct:= 1 to 10 
    ? F1
    skip
 next
 dbclosearea()
 
 ?
 ? "Arquivo 2 - Indexação:"
 ?
  DBSELECTAREA("arq2")
 go top
 for ct:= 1 to 10 
    ? F2
    skip
 next
 dbclosearea()
 
 DBDROP("mem:test1") // destroi o arquivo 1
 DBDROP("mem:test2") // destroi o arquivo 2

RETURN

[]s

Yugi386

Obrigado, Yugi .... again !!

Vou experimentar ( de dedos cruzados)

Grato

PC Toledo

Arquivo Temporario em Memória

Arquivo Temporario em Memória

Arquivo Temporario em Memória

Arquivo Temporario em Memória

Arquivo Temporario em Memória

Arquivo Temporario em Memória

Arquivo Temporario em Memória

Arquivo Temporario em Memória

Arquivo Temporario em Memória

Arquivo Temporario em Memória

Arquivo Temporario em Memória

Arquivo Temporario em Memória

Arquivo Temporario em Memória

Arquivo Temporario em Memória

Arquivo Temporario em Memória

Arquivo Temporario em Memória