Olá Gabriel,
Veja se isso te ajuda.
Defines:
#define true .T.
#define false .F.
#define FALSO .F.
#define OK .T.
#define ESC 27
#define P_DEF(Par, Def) Par := if( Par = Nil, Def, Par )
Função para abrir arquivo BD:
*-----------------------------------------------*
function NetUse( cBcoDados, lModo, nSegundos, cAlias )
*-----------------------------------------------*
LOCAL cScreen := SaveScreen()
LOCAL nArea := 0
LOCAL Restart := OK
LOCAL cStr1
LOCAL cStr2
LOCAL cStr3
LOCAL cStr4
LOCAL cStr5
LOCAL cStr6
LOCAL lForever
LOCAL cTela
LOCAL lAberto := FALSO
P_DEF( lModo, OK )
P_DEF( nSegundos, 2 )
cBcoDados := StrTran( cBcoDados, '.DBF')
cAlias := Iif( cAlias = NIL, cBcoDados, cAlias )
lForever := ( nSegundos = 0 )
lAberto := (cBcoDados)->(Used())
if lAberto // 14:03 25/04/2018
(cBcoDados)->(DbCloseArea())
lAberto := false
endif
while Restart
while (lForever .OR. nSegundos > 0)
if lModo
Use (cBcoDados) SHARED NEW Alias ( cAlias )
else
Use (cBcoDados) EXCLUSIVE NEW Alias ( cAlias )
endif
if !NetErr()
ResTela( cScreen )
return( OK )
endif
cTela := Mensagem("Tentando acesso a " + Upper(AllTrim(cBcoDados)) + ".DBF...")
Inkey(.5)
nSegundos -= .5
ResTela( cTela )
EndDo
nOpcao := Conf("Acesso Negado a " + Upper(AllTrim( cBcoDados )) + " Novamente ? ")
if nOpcao = OK
ResTart := OK
else
ResTart := FALSO
DbCloseAll()
FChDir( oAmbiente:xBase )
SetColor("")
Cls
cStr1 := "#1 Se outra estação estiver usando o sistema, finalize-a. ;;"
cStr2 := "#2 Se outra estação estiver indexando, aguarde o término. ;;"
cStr3 := "#3 Se SHARE estiver instalado, aumente os parãmetros de ;"
cStr4 := " travamento de arquivos. Ex.: SHARE /F:18810 /L:510. ;;"
cStr5 := "#4 Em ambiente de rede NOVELL, verifique o arquivo NET.CFG;"
cStr6 := " e se necessário, acrescente a linha FILE HANDLES=127. ;"
Alert( cStr1 + cStr2 + cStr3 + cStr4 + cStr5 + cStr6, "W+/B")
Break
//Quit
endif
EndDo
return( FALSO )
funções para travar arquivo, travar registro, incluir registro, e liberar:
function TravaReg( nTentativa, aRegistros )
*+-----------------------------------+*
LOCAL cScreen := SaveScreen()
LOCAL Restart := OK
LOCAL lContinua
hb_default(@nTentativa, 2)
lContinua := ( nTentativa == 0 )
while Restart
while (!RLock() .AND. ( nTentativa > 0 .OR. lContinua ))
Mensagem(" Travando Registro " + AllTrim(Str( Recno())) + " no Arquivo " + Alias(), CorBox())
if inKey(1) = K_ESC
exit
endif
nTentativa--
enddo
if !RLock()
if !Conf("Registro em uso. Tentar Novamente ?" )
ResTela( cScreen )
return( false )
endif
ResTart := OK
nTentativa := 2
else
ResTela( cScreen )
return( true )
endif
EndDo
function TravaArq()
*+-----------------------------------+*
if Flock()
return( true )
endif
while !FLock()
ErrorBeep()
if !Conf("Arquivo em uso em outra Estaçao. Tentar Novamente ?" )
return( false )
endif
if FLock()
return( true )
endif
enddo
return( true )
function Incluiu()
*+-----------------------------------+*
DbAppend()
if !NetErr()
return( true )
endif
while NetErr()
ErrorBeep()
if !Conf("Registro em uso em outra Estaçao. Tentar Novamente ?")
return( false )
endif
DbAppend()
if !NetErr()
return( true )
endif
EndDo
return( true )
function Libera()
*+-----------------------------------+*
//DbCommit() // Atualiza Buffers
DbSkip(0) // Refresh
DbGoto( Recno()) // Refresh
DbUnLock() // Libera Registros / Arquivos
return Nil
Qualquer dúvida, é só dar um tok.
att,
Harbour, C, C++, Ruby, Python, Go, Delphi, Haskell, Html, PHP, mingw, gtwvg, multithread, dbfcdx, letodb
=================================================
Senhor, sem Ti, nada podemos fazer!