SELECT( DBCADPROPO )
IF .NOT. NETERR()
SET ORDER TO 01
GO TOP
cAlias := ALIAS() // ALIAS DE CADPROPO.DBF
ELSE
MsgInfo( "ERROR DE RED. Verifique!", "Confirma? " )
BREAK
ENDIF
// ------------------------------------------------------------------------
// Programa ..: REDE.PRG - controla os *.DBFS otimo para a classe TDATABASE.PRG
//
// Descri‡Æo..: Fun‡äes de usuario (UDF) para Rede.
//
// Autor .....: Aulaware - A. Canudas
//
// Fun‡äes Comentarios
// ------------ -----------------------------------------------------------
// NetUse Abre Uma Tabela em Rede.
// NetCloseAll Fecha Uma Tabela em Rede.
// NetFileLock Bloqueia uma tabela aberta e compartilhada.
// NetRecLock Bloqueio de registros em Rede.
//
// Datas Comentarios
// ------------ -----------------------------------------------------------
// Maio, 2000 MODIFICADO EM: 28/11/2019 Usar se necessario.
// ------------------------------------------------------------------------
#Include "FiveWin.Ch"
// ------------------------------------------------------------------------
// Fun‡Æo.....: NetUse
// Descri‡Æo..: Abre um Arquivo DBF, em modo EXCLUSIVE (.F.), ou SHARED (.T.)
// Par metros : cDbf -> Nome da Base de Dados
// lShared -> SHARED (.T.), EXCLUSIVE (.F.)
// Devolve ..: .T. -> Si se ha podido abrir.
// .F. -> Si no se ha podido abrir.
// ------------------------------------------------------------------------
FUNCTION NetUse( cDbf, lShared )
LOCAL cAlias := cFileName( cDbf )
LOCAL bAlias := cFileName( cDbf )
// CONTROLE DE PARAMETROS DE ENTRADA =====================
If cDbf = NIL .OR. !File( cDbf + ".DBF" )
MsgStop( "NOME DO ARQUIVO INCORRETO" + CRLF + CRLF + ;
"NÃO ACHEI BANCO DE DADOS." + CRLF + CRLF + ;
cDbf + ".DBF", "ERRO FATAL!!" )
RETURN( .F. )
ENDIF
IIf( lShared = NIL, lShared := .F., lShared )
// ======================================================
IF lShared = .T.
USE ( cDbf ) ALIAS ( cAlias := GetNewAlias( cAlias ) ) ;
VIA "DBFCDX" SHARED NEW
ELSE
USE ( cDbf ) ALIAS ( cAlias ) VIA "DBFCDX" EXCLUSIVE NEW
ENDIF
IF !NetErr()
RETURN( .T. )
ENDIF
// Se nÆo podemos abrir, solicita repeti‡Æo
MsgStop( "IMPOSSIVEL ABRIR BANCO DE DADOS: " + cAlias + CRLF + ;
OemToAnsi( "BLOQUEADO POR OUTRO USUµRIO." ), ;
"ERRO FATAL DE REDE! FECHAR BANCO DE DADOS." )
RETURN( .F. )
// ------------------------------------------------------------------------
// Funci¢n ...: NetCloseAll
// Descripci¢n: Libera todos los ficheros, vuelca posibles datos de memoria
// a disco duro, y cierra todos los ficheros.
// Par metros : Ninguno.
// Devolve ..: NIL
// ------------------------------------------------------------------------
FUNCTION NetCloseAll()
DbUnLockAll()
DbCommitAll()
DbCloseAll()
RETURN NIL
// ------------------------------------------------------------------------
// Funci¢n ...: NetFileLock
// Descripci¢n: Bloquea un fichero DBF.
// Par metros : Ninguno.
// Devolve ..: .T. -> Si se ha podido bloquear.
// .F. -> Si no se ha podido bloquear.
// ------------------------------------------------------------------------
FUNCTION NetFileLock()
IF fLock()
RETURN( .T. )
ENDIF
MsgStop( "BANCO DE DADOS " + Alias() + " BLOQUEADO Por Outro Usuario.", ;
"ERROR DE REDE" )
RETURN( .F. )
// ------------------------------------------------------------------------
// Funci¢n ...: NetRecLock
// Descripci¢n: Bloquea un registro de fichero DBF, abierta en modo SHARED.
// Par metros : oDbf -> Objeto DATABASE.
// Devolve ..: .T. -> Si se ha podido bloquear.
// .F. -> Si no se ha podido bloquear.
// ------------------------------------------------------------------------
FUNCTION NetRecLock( oDbf )
IF oDbf:RecLock()
RETURN( .T. )
ENDIF
MsgStop( "REGISTRO BLOQUEADO." + CRLF + ;
"Outro Usuario o Esta Usando.", "ERRO DE REDE" )
RETURN( .F. )
// ------------------------------------------------------------------------
/*
// verificamos que no ocurra error si otros usuario están ocupando la Tabela
If MiTabela->( neterr() )
? "Imposible Agregar Registro en este momento"
Return Nil
Else
// si no ocurrió error, la Tabela está libre para agregarle un registro
// en blanco, Porem queda bloqueado así que...
MiTabela->( LastRec( DbUnLock() ) )
// Con LastRec() nos aseguramos que sea el último registro físico
// Agora se Podem reemplazar valores
replace miTabela->campo1 with xvalor1
replace miTabela->campo2 with ...etc, etc
Endif
if ( !NETERR() )
Ferase("MiTabela.cdx")
INDEX ON MiTabela->nombre1 TAG nom1
INDEX ON ...etc, etc
else
? "Lo Siento.... Imposible Reindexar Agora"
endif
*/
// ------------------------------------------------------------------------
// Funci¢n ...: GetNewAlias
// Descripci¢n: Asigna un nuevo alias £nico, es decir, que no exista.
// Es imprescindible para trabajo en MDI, al poder abrir
// la misma ventana varias veces.
// Par metros : cAlias -> Alias asignado previamente.
// Devolve ..: un alias £nico.
// Notas .....: Extraida de un ejemplo del uso MDI en Fivewin
// \SAMPLES\TESTMDI8.PRG
// ------------------------------------------------------------------------
FUNCTION GetNewAlias( cAlias )
STATIC n := 0
RETURN cAlias + StrZero( ++n, 4 )
// ------------------------------------------------------------------------
// Funci¢n ...: GetIndices
// Descripci¢n: Devolve un array con los nombres de los TAGs abiertos.
// Par metros : Ninguno.
// Devolve ..: acIndices -> Array con los nombres.
// Notas .....: De esta forma puede aparecer un nombre inteligible en los
// browse (combobox al lado bot¢n de Salir).
// ------------------------------------------------------------------------
FUNCTION GetIndices()
LOCAL i := 0
LOCAL acIndices := {}
FOR i := 1 TO 15
IF !Empty( OrdName( i ) )
aAdd( acIndices, OrdName( i ) )
ENDIF
NEXT
// Si no hay ning£n indice ...
IF Len( acIndices ) = 0
aAdd( acIndices, "Nenhum Indice" )
ENDIF
RETURN acIndices
FUNCTION TRAVEREG(TEMPO)
DO WHILE .NOT. REGLOCK(TEMPO)
SYSREFRESH()
MSGWAIT( "AGUARDE ACESSO ARQUIVO", "Bloqueando o registro...Aguarde", 01 )
ENDDO
RETURN(0)
FUNCTION ADICIONE(TEMPO)
DO WHILE .NOT. ADIREG(TEMPO)
SYSREFRESH()
MSGWAIT("AGUARDE ACESSO ARQUIVO", "Adição de novo registro...Aguarde", 01 )
ENDDO
RETURN(0)
// ADIREG(TEMPO)
// RETORNA VERDADEIRA SE O REGISTRO FOI APENDADO.O NOVO REG.PASSA A SER O
// REG.ATUAL BLOQUEADO
// PAR: 1-NUMERICO-TEMPO DE ESPERA
FUNCTION ADIREG(TEMPO)
LOCAL SEMPRE, TELA
APPEND BLANK
IF .NOT. NETERR()
TRAVEREG(0)
RETURN(.T.)
ENDIF
SEMPRE=(TEMPO=0)
DO WHILE( SEMPRE .OR. TEMPO > 0 ) .AND. INKEY() <> 27
SYSREFRESH()
APPEND BLANK
IF .NOT. NETERR()
TRAVEREG(0)
RETURN(.T.)
ENDIF
SYSWAIT(.5)
TEMPO=TEMPO-.5
ENDDO
RETURN( .F. ) && NAO BLOQUEADO
FUNCTION REGLOCK(TEMPO)
// TENTA TRAVAR O REGISTRO ATUAL
// PAR: 1-NUMERICO-TEMPO ESPERA
LOCAL SEMPRE, TELA
IF RLOCK()
RETURN(.T.) && BLOQUEADO
ENDIF
SEMPRE = ( TEMPO = 0 )
DO WHILE (SEMPRE .OR. TEMPO > 0 ) .AND. INKEY() <> 27
SYSREFRESH()
IF RLOCK()
RETURN(.T.) && BLOQUEADO
ENDIF
SYSWAIT( .5 )
TEMPO=TEMPO-.5
ENDDO
RETURN( .F. ) && NAO BLOQUEADO
FUNCTION DESTRAVA()
COMMIT
UNLOCK
RETURN(NIL)
// FIM DO PROGRAMA
Return to FiveWin para Harbour/xHarbour
Users browsing this forum: Google [Bot] and 99 guests