LetoDBf (fork) -> LetoDb com espinafre

[rubens]

Bom dia..

Alguém tem o o manage compilado para compartilhar?
O Console eu consegui compilar já o manage não. Precisa da HwGui e eu não tenho ela.

Obrigado

Rubens

[asimoes]

Tem que olhar o manual, quem está tomando erro com unlock veja se está usando controle de transação

Sobre controle de transação: leto_BeginTransaction(), leto_CommitTransaction() e leto_Rollback()

leto_BeginTransaction() o unlock e a gravação dos registros das tabelas é feito com leto_CommitTransaction()

Usando leto_CommitTransaction() se usar DbUnLock() ou DbRUnlock() o letodb entra em condição de erro, não pode usar essas funções! (está no manual)

Resumindo:

leto_BeginTransaction() ou leto_BeginTransaction(.t.) precisa usar leto_CommitTransaction() para gerar o registro

O legal disso é que não entra registro fantasma e se tem por exemplo 3 tabelas fazendo append blank e se estivrem dentro de begin sequence with __BreakBlock()

No Recover você pode usar leto_Rollback() que desfaz todos os appends blank, com isso as tabelas envolvidas não ficam inconsistentes.

Código: Selecionar todos

begin sequence with __BreakBlock()
   leto_BeginTransaction()
   tabela1->( DbAppend() )
   tabela2->( DbAppend() )
   tabela3->( DbAppend() )
    leto_CommitTransaction() //gera os registros das tabelas e faz unlock
Recover
   leto_Rollback() // desfaz a transação e faz unclock
End

[porter]

Olá pessoal,
Porquê em determinados momentos, da esse erro: Error LETO/1000 : Erro de sintaxe

Lá no LETODBF\BIN\letodbf.log
11.23.2018 13:35:28 INFO: disconnect 192.168.0.100:1415 estoque.exe users=(1 : 1 : 1), tables=(0 : 19)

O que pode estar desconectando o LetoDbf ?
Obrigado.

[asimoes]

Porter,

Como ta definida a conexão com Leto_Connect() ?, observe que o timeout está com -1, tinha problema de conexão quando informava 30000 (30 seg), com -1
Nunca mais tive problema.

::nTimeOut := -1

Leto_Connect( cServidorDB, , , ::nTimeOut )

[porter]

Como ta definida a conexão com Leto_Connect() ?, observe que o timeout está com -1, tinha problema de conexão quando informava 30000 (30 seg), com -1 Nunca mais tive problema.

::nTimeOut := -1
Leto_Connect( cServidorDB, , , ::nTimeOut )

Olá asimões, estou fazendo assim:

cPath := "SERVIDOR:2812"
nConect := leto_Connect( cPath)

Se fizer da forma como você sugeriu, precisa alterar também o timeout no arquivo letodb.ini, aqui o Timeout está com 360
Por curiosidade, porquê o exemplo que você passou, está assim ::nTimeOut, o que significa ::

Obrigado.

[asimoes]

Por curiosidade, porquê o exemplo que você passou, está assim ::nTimeOut, o que significa ::

é propriedade da classe, você pode usar:

nConect := leto_Connect( cPath, , , -1)

Obs.: ;TimeOut = 360 está comentado no meu letodb.ini

Meu letodb.ini

Código: Selecionar todos

;Server = \\192.168.56.1
;IP = 127.0.0.1
Port = 2812
DataPath = DB
;LogPath = /tmp
Default_Driver = CDX
;Lock_Scheme = 6
;Memo_Type = FPT
Share_Tables = 0
Trigger = "Leto_Trigger"
No_Save_WA = 1
Lower_Path = 0
EnableFileFunc = 1
EnableAnyExt = 1
Allow_UDF = 1
Pass_for_Login = 0
Pass_for_Manage = 0
Pass_for_Data = 0
;Pass_File = "leto_users"
Cache_Records = 21
;Max_Vars_Number = 1000
;Max_Var_Size = 67108864
;Tables_Max  = 999
;Users_Max = 99
Debug = 1
Optimize = 1
;HardCommit = 0 ver readme.txt
;AutOrder = 0
;ForceOpt = 0
;TimeOut = 360
;Zombie_Check = 30
;Server_User = advantage
;Server_UID = 1000
;Server_GID = 4
;BC_Services = letodb;
;BC_Interface = eth2
;BC_Port = 2812
DataBase = DB
;Backup = C:\Users\cisin\Documents\GitHub\LetoDBf\bin\backup
Mask = *.dbf,*.dbt,*.ntx
Lock = 1
Seconds = 30
Wait = 1
ArcCmd = tar -cvzf /tmp/backup/leto.tar.gz /tmp/backup/*

[porter]

Asimões,
O Timeout meu também está comentado, fiz da forma que você disse, e até agora não deu mais erro,
acho que resolveu o problema.

Obrigado por sua atenção.

[porter]

Olá pessoal, com essa rotina, estou conectando o LetoDBF, e verifico se a conexão foi bem sucedida,
qual é o comando que verifica se o LetoDBF, ainda está em execução, não é toda hora, mas de tempos em tempos
recebo a mensagem de erro Error LETO/1000 : Erro de sintaxe, então gostaria de testar no sistema se
é o Leto que está desconectando ou é a Rede que cai.

Mesmo desconectando o LetoDbf com net stop letodbf_service, a rotina abaixo, sempre retorna zero(0), na abertura do sistema,
funciona normal, mas se em alguma parte do sistema, eu desconectar o leto, ai a rotina abaixo, não funciona.

Código: Selecionar todos

cPath := "SERVIDOR:2812"
IF leto_Connect( cPath ) < 0
    MsgExclamation( "Perdeu conexão.................. !")
ENDIF

//Conectar e testar conexão foi bem sucedida...

Código: Selecionar todos

PROCEDURE ConectaLetoDbf(cPath)
    nTimeOut := -1
    nConect := leto_Connect( cPath, , , nTimeOut )
    // Faz o teste de conexao
    IF nConect == -1
       SetColor( "GR+/B" )
	   CLS
       nRes := leto_Connect_Err()
       IF nRes == LETO_ERR_LOGIN
          alert( "Falha ao Logar" )
       ELSEIF nRes == LETO_ERR_RECV
          alert( "Error ao conectar" )
       ELSEIF nRes == LETO_ERR_SEND
          alert( "Erro de envio" )
       ELSE
          MsgExclamation( "Nao conectado ao servidor: " + cPath + " , habilitar porta 2812 no servidor.")
       ENDIF
       Return .F.
  	ENDIF

[Jairo Maia]

Olá porter,

não é toda hora, mas de tempos em tempos recebo a mensagem de erro Error LETO/1000 : Erro de sintaxe, então gostaria de testar no sistema se é o Leto que está desconectando ou é a Rede que cai.

Não está relacionado a conexão do Leto. É outro problema. A rotina de erro deve dar o caminho onde ocorreu o erro. Trata-se de "erro de sintaxe", e não de falha de conexão.

Identifique onde está ocorrendo o erro, e se puder, post o trecho do código.

[porter]

Olá Jairo,

A rotina de erro deve dar o caminho onde ocorreu o erro. Trata-se de "erro de sintaxe"

Essa rotina de erro seria o arquivo c:\letodbf\bin\letodbf.log ?
Se for, está retornando a seguinte mensagem:
12.05.2018 09:23:38 INFO: disconnect 192.168.0.120:23354 estoque.exe users=(1 : 1 : 2), tables=(0 : 12)
Nessa mensagem de erro, em tables=(0 : 12), sei que tables se refere ao arquivo e "0 : 12" o que é ?
Estou cadastrando códigos e valores pela estação, esse erro ocorre na estação.

Identifique onde está ocorrendo o erro, e se puder, post o trecho do código.

O erro não acontece toda hora, se conseguisse saber em qual linha do sistema está o erro ficaria mais fácil,
assim eu postaria o código.

Obrigado por sua atenção.

[Jairo Maia]

Olá porter,

Desconsidere o que eu disse antes. Segundo o Itamar pode ser sim erro na rede. Veja a parir desse tópico: https://pctoledo.org/forum/viewto ... 99#p122799

[porter]

Olá Jairo,
Eu já havia lido o post que você sugeriu, no caso dele o problema era com o Avast, no momento
estou cadastrando várias notas fiscais com bastante itens, e até o momento não deu erro,
fiz um teste também desconectando e conectando em seguida o cabo da rede e mesmo assim
o erro não está ocorrendo, gostaria de tratar o erro quando ocorressem reconectar e continuar
usando o sistema de onde parou, mas até agora, não sei onde está ocorrendo o erro, vou continuar
procurando.

Obrigado.

[rossine]

Bom dia,

Estou fazendo testes com LetoDBF e usando o exemplo que peguei aqui no fórum, modifiquei para usar ao mesmo tempo LETODBF e DBFCDX.

Dois detalhes iniciais que percebi:

1) O DBRlock feito pelo LETO não é entendido pelo DBFCDX

2) No LETODBF a função "DbRLockList()" sempre retornar vazio. (Existe no LETODBF alguma função que me retorne isto ?)

Estou fazendo este teste pois pretendo usar o LETODBF em um novo projeto dentro de meu sistema que uso em DBFCDX.

Então pergunto: O RDDLETO trabalha em concomitância com o DBFCDX ?

Segue abaixo o exemplo que modifiquei e vejam as linhas: 272, 274, 296, 299, 305

Código: Selecionar todos

#include "inkey.ch"
#include "rddleto.ch"
#include "hbgtinfo.ch"
#include "wvtwin.ch"
#include "hbgtwvg.ch"
#include "dbinfo.ch"

//sc delete letodbf_service
//net stop letodb_service
//net stop letodbf_service

request LETO
request DBFCDX

REQUEST HB_LANG_PT
REQUEST HB_CODEPAGE_PTISO
REQUEST HB_GT_WVT_DEFAULT
REQUEST HB_GT_WVT

Procedure Main(cIP)

  HB_SETCODEPAGE('PTISO')
  HB_LANGSELECT('PT')

//  RDDSETDEFAULT( "LETO" )
  RDDSETDEFAULT( "DBFCDX" )

set date       to BRITISH
set device     to screen
set epoch      to 2000
set print      OFF
set bell       OFF
set scoreboard OFF
set unique     OFF
set cursor     OFF
set confirm    OFF
set escape     ON
set deleted    ON
set wrap       ON
set century    ON

ReadInsert( .F. )

setcancel( .F. )

set( _SET_AUTOPEN, .F. )
set( _SET_AUTORDER, 0 )
set( _SET_AUTOSHARE, .F. )

Set( _SET_DIRSEPARATOR, "\" )
Set( _SET_FILECASE, "LOWER" )
Set( _SET_DIRCASE, "LOWER" )

set( _SET_DBFLOCKSCHEME, DB_DBFLOCK_COMIX )

//  LETO_INIT()

  WVT_SETONTOP()
  WVT_SETICON('icon_sys.ico')
  wvw_SetCodepage(255)
  wvw_SetTitle('Demo LetoDB Server - pctoledo')

  Set(39, 255)

  Set(40,159)

  nFontWidth:=Int(hb_gtinfo(HB_GTI_DESKTOPWIDTH)/80)
  nFontSize:=Int(hb_gtinfo(HB_GTI_DESKTOPHEIGHT)/25)
  HB_GtInfo(HB_GTI_FONTWIDTH, nFontWidth)
  HB_GtInfo(HB_GTI_FONTSIZE, nFontSize)

  SetMode( MaxRow() + 1, MaxCol() + 1 )

  HB_GtInfo( HB_GTI_ALTENTER, .T. )
  HB_GtInfo( HB_GTI_CLOSABLE, .F. )

  SetBlink(.f.)
  SET SCOREBOARD OFF
  SET CONFIRM ON
  SET DELETED ON
  SET DATE TO BRITISH
  SET CENTURY ON

  SetColor("N/BG")
  @ 0,0 Clear to MaxRow(), MaxCol()
  SetColor("W+/RB")
  @ 0,0 Clear to 0,MaxCol()
  @ 0,0 Say PadC("Abrindo DBF/CDX com LetoDB Server",80)
  SetColor("N/W")
  @ MaxRow(),0 Clear to MaxRow(),MaxCol()
  @ MaxRow(),1 Say "PCToledo - www.pctoledo.com.br/forum"

  cTela1:=SaveScreen(0,0,MaxRow(),MaxCol())

  If pcount()==0

    Janela(5,5,20,73,"Conexão com o LetoDB","N/W","W+/B","N/W")
    @ 7,7 Say "Escolha uma das formas de conexão:"
    @ 9,7  Say "Conexão Local  = o LetoDB Server tem que estar instalado no mesmo"
    @ 10,7 Say "                 computador  onde  este  programa  está  sendo"
    @ 11,7 Say "                 executado (localhost)."
    @ 13,7 Say "Informar IP    = o LetoDB Server foi instalado em um outro"
    @ 14,7 Say "                 computador na sua rede local."
    @ 16,7 Say "Conexão Remota = o LetoDB Server está instalado em um servidor"
    @ 17,7 Say "                 na Internet."
    SetColor("N/W,W+/R")
    @ 19,11 PROMPT " Conexão Local "
    @ 19,32 PROMPT " Informar IP "
    @ 19,51 PROMPT " Conexão Remota "
    MENU TO nPrompt

    If nPrompt==0
      Return
    Endif

    RestScreen(0,0,MaxRow(),MaxCol(),cTela1)

    DO CASE
      CASE nPrompt = 1
        cIP:="localhost"
      CASE nPrompt = 2
        Janela(8,18,14,59,"LetoDB na Rede Local","N/W","W+/B","N/W")
        @ 10,20 Say "Informe o Endereço de IP do computador"
        @ 11,20 Say "onde o LetoDB Server está instalado:"
        cIPInf:=spac(15)
        @ 13,30 Get cIPInf
        READ
        If Lastkey()=27 .or. Empt(cIPInf)
          Return
        Endif
        RestScreen(0,0,MaxRow(),MaxCol(),cTela1)
        cIP:=alltrim(cIPInf)
      CASE nPrompt = 3
        cIP:="pctoledo.noip.me"
    ENDCASE
  Endif

  PathLeto :=  "//"+cIP+":2812/"   
  nConect := leto_Connect( PathLeto )
  If nConect == -1
    nRes := leto_Connect_Err()
    If nRes == LETO_ERR_LOGIN
      Alert( "Falha ao Logar" )
    ElseIf nRes == LETO_ERR_RECV
      Alert( "Error ao conectar" )
    ElseIf nRes == LETO_ERR_SEND
      Alert( "Erro de envio" )
    Else
      Alert( "Erro na conexão com o servidor: " + PathLeto )
    Endif
    Quit
  Endif

  // Depois de conectar no Banco de dados através do LETODBF, tem que setar o DBCDX como default novamente.
  RDDSETDEFAULT( "DBFCDX" )

//wait RDDSETDEFAULT()

   ? 'leto_memowrite( "test2.txt", 4095 * "B" ) - '
   ?? iif( leto_memowrite( "test2.txt", REPLICATE( "B", 4095 ) ), "Ok", "Failure" )
   ?? iif( leto_filesize( "test2.txt" ) == 4096, "!", "@" )  /* +1 for strg-z */
   ? 'leto_filesize( "test2.txt" ) - '
   ?? leto_filesize( "test2.txt" )
   cBuf := leto_memoread( "test2.txt" )
   IF cBuf == REPLICATE( "B", 4095 )
      ?? " fine"
   else
      ?? " wrong"
   ENDIF

  nPrompt:=1
  DO WHILE .T.
    RestScreen(0,0,MaxRow(),MaxCol(),cTela1)

    Janela(6,15,11,52,"Escolha uma das Opções","N/W","W+/G","N/W")
    SetColor("W+/GR+")
    @ 11,15 Clear to 11,52
    @ 11,16 Say "<Esc=Cancela>"
    SetColor("N/W,W+/R")
    @ 7,15 PROMPT " Abrir Banco de Dados                 "
    @ 8,15 PROMPT " Informações Básicas do LetoDB Server "
    @ 9,15 PROMPT " Lista de Usuários Conectados         "
    @ 10,15 PROMPT " Tabelas Abertas                      "
    MENU TO nPrompt

    If nPrompt==0
      Exit
    Endif

    DO CASE
      CASE nPrompt = 1
        BrowseDB(2,2,21,76,"Arquivo: NOMES.DBF")
        Close All
      CASE nPrompt = 2
        InfBasicas()
      CASE nPrompt = 3
        ListUsers()
      CASE nPrompt = 4
        ListTabelas()
    ENDCASE

  ENDDO

  leto_DisConnect()
Return

*****************************
Procedure Janela(nLini,nColi,nLinf,nColf,cTitJan,cCorJan,cCorTit,cCorTex)
  HB_Shadow(nLini,nColi,nLinf,nColf)
  SetColor(cCorJan)
  @ nLini,nColi Clear to nLinf,nColf
  SetColor(cCorTit)
  @ nLini,nColi Clear to nLini,nColf
  @ nLini,nColi Say PadC(cTitJan,(nColf-nColi)+1)
  SetColor(cCorTex)
Return

*****************************
Procedure BrowseDB(nLiniDB,nColiDB,nLinfDB,nColfDB,cTitDB)

  LOCAL lEnd, nKey, brw_regAnt, nRecno
  LOCAL cTela2:=SaveScreen(0,0,24,79)

  Private oBrowse

  SetColor("W+/B")

  cls

  DbUseArea( .t., "LETO", /*PathLeto +*/ "NOMES.DBF", "NOMES_LETO", .t. )

  ? "LETODBF-NETERR()", NETERR()

  if !leto_file( "nomes.cdx" )
     index on field->codigo /*NOMES_LETO->codigo*/ tag "001" to nomes
     index on field->nome   /*NOMES_LETO->nome  */ tag "002" to nomes
  endif

  set index to nomes

  NOMES_LETO->( DbSetOrder(1) )

  ? "indexkey()->LETO=", NOMES_LETO->( indexkey() )

  GO BOTTOM

  cCodigo:=StrZero(Val(NOMES_LETO->CODIGO)+1,4)

  NOMES_LETO->(DbAppend())

  If NOMES_LETO->(RLock())
     REPLACE NOMES_LETO->CODIGO   WITH cCodigo,;
             NOMES_LETO->NOME     WITH "Novo nome - " + time(),;
             NOMES_LETO->ENDERECO WITH "Endereco",;
             NOMES_LETO->CIDADE   WITH "Cidade",;
             NOMES_LETO->ESTADO   WITH "UF",;
             NOMES_LETO->CEP      WITH "00000000",;
             NOMES_LETO->SEXO     WITH "M"
     NOMES_LETO->(DbCommit())
     NOMES_LETO->(DbUnLock())
  endif

  nRecno := NOMES_LETO->( OrdKeyCount() )

  NOMES_LETO->( OrdKeyGoto( nRecno ) )

  ? "recno->", NOMES_LETO->( recno() ), "OrdKeyno->", NOMES_LETO->( ordkeyno() )

  ? ""
  ? "DbRLock-LETODBF=", NOMES_LETO->( DbRLock() ) , "  <- Aqui LETO travou o registro - OK"
  ? ""
  ? "DbRLockList()-LETO", hb_valtoexp( NOMES_LETO->( DbRLockList() ) ), " <- Esta funcao nao funciona no LETO ?
  ? ""

  DbUseArea(.t.,"DBFCDX", "dbf\NOMES.DBF", "NOMES_CDX", .t. )

  ? "DBFCDX-NETERR()", NETERR()

  if !file( "dbf\nomes.cdx" )
     index on field->codigo tag "001" to "dbf\nomes"
     index on field->nome   tag "002" to "dbf\nomes"
  endif

  set index to "dbf\nomes"

  NOMES_CDX->( DbSetOrder(1) )

  ? "indexkey()->DBFCDX=", NOMES_CDX->( indexkey() )

  NOMES_CDX->( OrdKeyGoto( nRecno ) )

  ? "recno->", NOMES_CDX->( recno() ), "OrdKeyno->", NOMES_CDX->( ordkeyno() )

  ? "DbRLock-DBFCDX=",   NOMES_CDX->( DbRLock() ), "<- Aqui o DBFCDX tambem conseguiu travar o mesmo registro :("
  ? ""

  ? "DbRLockList()-DBFCDX", hb_valtoexp( NOMES_CDX->( DbRLockList() ) ), " <- Aqui esta OK"

  ? "DbRUnLock-DBFCDX=", NOMES_CDX->( DbRUnLock() )

  ? "DbRUnLock-LETODBF=", NOMES_LETO->( DbRUnLock() )

  ? "DbRLock-DBFCDX="  , NOMES_CDX->( DbRLock() ), " <-Aqui OK porque o LETO destravou o registro"
  ? "DbRUnLock-DBFCDX=", NOMES_CDX->( DbRUnLock() )

  wait "Tecle ENTER..."

  RestScreen(0,0,24,79,cTela2)

  Janela(nLiniDB,nColiDB,nLinfDB,nColfDB,cTitDB,"W+/B","W+/RB","W+/B")
  SetColor("N/W")
  @ nLinfDB,nColiDB Clear to nLinfDB,nColfDB
  @ nLinfDB,nColiDB+1 Say "<Enter=Editar>  <Ins=Inserir>  <Del=Excluir>  <F2=Busca>  <F3=Localiza>"
  SetColor("R/W")
  @ nLinfDB,nColiDB+2 Say "Enter"
  @ nLinfDB,nColiDB+18 Say "Ins"
  @ nLinfDB,nColiDB+33 Say "Del"
  @ nLinfDB,nColiDB+48 Say "F2"
  @ nLinfDB,nColiDB+60 Say "F3"

  SetColor("W+/B")
  oBrowse := TBrowse():New(nLiniDB+1,nColiDB,nLinfDB-1,nColfDB)

  oBrowse:ColSep        := " "+chr(179)+" "
  oBrowse:HeadSep       := chr(205)+chr(209)+chr(205)
  oBrowse:GoTopBlock    := {|| dbGoTop() }
  oBrowse:GoBottomBlock := {|| dbGoBottom() }
  oBrowse:SkipBlock     := {| nSkip | dbSkipBlock( nSkip, oBrowse ) }

  oBrowse:AddColumn( TBColumnNew( "Código", FieldBlock("CODIGO") ) )
  oBrowse:AddColumn( TBColumnNew( "Nome", FieldBlock("NOME") ) )
  oBrowse:AddColumn( TBColumnNew( "Endereço", FieldBlock("ENDERECO") ) )
  oBrowse:AddColumn( TBColumnNew( "Cidade", FieldBlock("CIDADE") ) )
  oBrowse:AddColumn( TBColumnNew( "UF", FieldBlock("ESTADO") ) )
  oBrowse:AddColumn( TBColumnNew( "Cep", FieldBlock("CEP") ) )
  oBrowse:AddColumn( TBColumnNew( "Sexo", FieldBlock("SEXO") ) )

  oBrowse:configure()

  lEnd := .F.
  DO WHILE ! lEnd
     oBrowse:ForceStable()

     SetCursor(0)

     SetColor("W+/RB")
     @ nLiniDB,nColiDB+1 Say "Registro: "+Ltrim(Str(Recno())) + "/" + Ltrim(Str(Lastrec()))+Spac(3)
     SetColor("W+/B")

     nKey := Inkey( 0, HB_INKEY_ALL )

     IF oBrowse:applyKey( nKey ) == -1
       SetCursor(1)
       EXIT
     ENDIF
     DO CASE
       CASE nKey == K_ENTER
         EditarDB(.F.)
         oBrowse:refreshall()
       CASE nKey == K_INS
         EditarDB(.T.)
         oBrowse:refreshall()
       CASE nKey == K_DEL
         ExcluirDB()
         oBrowse:refreshall()
       CASE nKey == K_F2
         brw_regAnt = RECNO()
         BuscaDB()
         If brw_regAnt != RECNO()
           oBrowse:rowpos = 1
         Endif
         oBrowse:configure()
       CASE nKey == K_F3
         brw_regAnt = RECNO()
         LocalizaDB()
         If brw_regAnt != RECNO()
           oBrowse:rowpos = 1
         Endif
         oBrowse:configure()
     ENDCASE

  ENDDO

Return

*****************************
Procedure EditarDB(lNovo)
  LOCAL cTela2:=SaveScreen(7,7,13,70), nRec:=RECNO()
  Janela(7,7,12,68,"Cadastro de Clientes","N/W","W+/G","N/W")
  SetColor("W+/R")
  @ 12,7 Clear to 12,68
  @ 12,8 Say "<Esc=Cancela>"
  SetColor("N/W,w+/BG,N/W,N/W,N/W")
  If lNovo
    GO BOTTOM
    SKIP
  Endif

  If !NOMES_LETO->(RLock()) // Rossine 01/11/18
     Alert( "Registro bloqueado por outro usuário.;Tente novamente!")
     return NIL
  Endif

  cCodigo:=NOMES_LETO->CODIGO
  cNome:=NOMES_LETO->NOME
  cEndereco:=NOMES_LETO->ENDERECO
  cCidade:=NOMES_LETO->CIDADE
  cUF:=NOMES_LETO->ESTADO
  cCep:=NOMES_LETO->CEP
  cSexo:=NOMES_LETO->SEXO

  @ 8,8 Say "Código:       Nome:"
  @ 8,16 Say cCodigo
  @ 8,28 Get cNome Picture "@!" Valid !Empt(cNome)
  @ 9,8 Say "Endereço:" Get cEndereco
  @ 10,8 Say "Cidade:" Get cCidade
  @ 10,47 Say "Estado:" Get cUF Picture "!!"
  @ 11,8 Say "Cep:" Get cCep Picture "99999-999"
  @ 11,24 Say "Sexo:" Get cSexo Picture "!" Valid cSexo$"MF"
  Read

  If Lastkey()=K_ESC
    GO nRec
    RestScreen(7,7,13,70,cTela2)
    Return
  Endif
  If lNovo
    GO BOTTOM
    cCodigo:=StrZero(Val(NOMES_LETO->CODIGO)+1,4)
    NOMES_LETO->(DbAppend())
  Endif
  If NOMES_LETO->(RLock())
    REPLACE NOMES_LETO->CODIGO WITH cCodigo,;
            NOMES_LETO->NOME WITH cNome,;
            NOMES_LETO->ENDERECO WITH cEndereco,;
            NOMES_LETO->CIDADE WITH cCidade,;
            NOMES_LETO->ESTADO WITH cUF,;
            NOMES_LETO->CEP WITH cCep,;
            NOMES_LETO->SEXO WITH cSexo
    NOMES_LETO->(DbCommit())
    NOMES_LETO->(DbUnLock())
  Else
    If lNovo
      Alert("Não foi possível adicionar o Novo Registro.;Tente novamente!")
    Else
      Alert("Registro bloqueado por outro usuário.;Aguarde um momento e tente novamente!")
    Endif
    GO nRec
  Endif
  RestScreen(7,7,13,70,cTela2)
Return

*****************************
Procedure ExcluirDB()
  LOCAL cMsg:= "Confirma exclusão do registro?",;
        aOpcoes:= {"Sim", "Não"}
  If Alert( cMsg, aOpcoes) == 1
    If NOMES_LETO->(RLock())
      NOMES_LETO->(DbDelete())
      NOMES_LETO->(DbCommit())
      NOMES_LETO->(DbUnLock())
    Endif
  Endif
Return

*****************************
Procedure BuscaDB()
  LOCAL cTela2:=SaveScreen(10,31,14,50), nRec:=RECNO(),;
        nPromptB, cCodigo, cNome, nOrdAnt
  Janela(10,31,13,48,"Opção de busca","N/W","W+/G","N/W")
  SetColor("W+/GR+")
  @ 13,31 Clear to 13,48
  @ 13,32 Say "<Esc=Cancela>"
  SetColor("N/W,W+/R")
  @ 11,31 PROMPT "  Por Código      "
  @ 12,31 PROMPT "  Por Nome        "
  MENU TO nPromptB

  RestScreen(10,31,14,50,cTela2)
  If nPromptB==0
    Return
  Endif

  DO CASE
    CASE nPromptB = 1
      nOrdAnt:=DbSetOrder(1)
      cCodigo:=spac(4)
      cTela2:=SaveScreen(10,28,15,53)
      Janela(10,28,14,51,"Busca por Código","N/W","W+/BG","N/W")
      SetColor("W+/R")
      @ 14,28 Clear to 14,51
      @ 14,29 Say "<Esc=Cancela>"
      SetColor("N/W,w+/BG,N/W,N/W,N/W")
      @ 12,29 Say "Informe o Código:" Get cCodigo Picture "9999"
      READ
      If Lastkey()=K_ESC .or. Val(cCodigo)<1
        RestScreen(10,28,15,53,cTela2)
        DbSetOrder(nOrdAnt)
        Return
      Endif
      DbSeek(StrZero(Val(cCodigo),4))
      If !Found()
        Alert("Código não encontrado!")
        DbSetOrder(nOrdAnt)
        GO nRec
      Endif
      RestScreen(10,28,15,53,cTela2)
    CASE nPromptB = 2
      nOrdAnt:=DbSetOrder(2)
      cNome:=spac(40)
      cTela2:=SaveScreen(10,11,15,70)
      Janela(10,11,14,68,"Busca por Nome","N/W","W+/BG","N/W")
      SetColor("W+/R")
      @ 14,11 Clear to 14,68
      @ 14,12 Say "<Esc=Cancela>"
      SetColor("N/W,w+/BG,N/W,N/W,N/W")
      @ 12,12 Say "Informe o Nome:" Get cNome
      READ
      If Lastkey()=K_ESC .or. Empt(cNome)
        RestScreen(10,11,15,70,cTela2)
        DbSetOrder(nOrdAnt)
        Return
      Endif
      DbSeek(Alltrim(cNome))
      If !Found()
        Alert("Nome não encontrado!")
        DbSetOrder(nOrdAnt)
        GO nRec
      Endif
      RestScreen(10,11,15,70,cTela2)
  ENDCASE
Return

*****************************
Procedure InfBasicas()
  Local aInf:=LETO_MGGETINFO(), aDtHs:=LETO_MGGETTIME(),;
        nSec,nDay,nHour,nTransAll,nTransBad,nKey
  Janela(5,11,20,68,"Informações Básicas do LetoDB Server","N/W","W+/B","N/W")
  SetColor("W+/R")
  @ 20,11 Clear to 20,68
  @ 20,12 Say "<Esc=Sair>"
  SetColor("N/W")
  @ 07,12 Say "Versão: "+LETO_GETSERVERVERSION() + "    RddDefault: " + RDDSETDEFAULT()
  @ 08,12 Say "Data/Hora do Servidor: "+DToC(aDtHs[1])+" - "+TString(aDtHs[2])

  @ 10,12 Say "Usuários Online....: "+PadL(aInf[1],5)+"  Máximo: "+PadL(aInf[2],5)
  @ 11,12 Say "Tabelas abertas....: "+PadL(aInf[3],5)+"  Máximo: "+PadL(aInf[4],5)
  @ 12,12 Say "Indices abertos....: "+PadL(aInf[9],5)+"  Máximo: "+PadL(aInf[10],5)
  nSec := Val( aInf[5] )
  nDay := Int(nSec/86400)
  nHour := Int((nSec%86400)/3600)
  @ 13,12 Say "Tempo decorrido....: "+ Ltrim(Str(nDay)) + Iif(nDay>1," dias "," dia ") + ;
               Ltrim(Str(nHour))+Iif(nHour>1," horas "," hora ") + ;
               Ltrim(Str(Int((nSec%3600)/60))) + " minutos"
  @ 14,12 Say "Operações..........: "+Ltrim(aInf[6])
  @ 15,12 Say "KBytes enviados....: "+Ltrim(str(Int(Val(aInf[7])/1024)))
  @ 16,12 Say "KBytes lidos.......: "+Ltrim(str(Int(Val(aInf[8])/1024)))
  nTransAll := Val( aInf[14] )
  nTransBad := nTransAll - Val( aInf[15] )
  @ 17,12 Say "Total de transações: "+Ltrim(Str(nTransAll))+"  Falhas: "+Ltrim(Str(nTransBad))
  @ 18,12 Say "Tempo de espera....: "+Ltrim(aInf[13])+"  Máximo: "+Ltrim(aInf[12])

  Do While .T.
    nKey:=inkey(0)
    If nKey==K_ESC
      Exit
    Endif
  Enddo
Return

*****************************
Procedure ListUsers()
  Local aUsers:=LETO_MGGETUSERS(),;
        nUsers,cMsg
  Janela(5,6,19,72,"Lista de Usuários Conectados","N/W","W+/B","N/W")
  SetColor("W+/R")
  @ 19,6 Clear to 19,72
  @ 19,7 Say "<Esc=Sair>"
  SetColor("N/W")
  nUsers := Len(aUsers)
  If nUsers>0
    cMsg:="Ordem Endereço IP      Nome Cliente/Net  Programa        Tempo"+hb_eol()
    For i=1 To nUsers
      cMsg+=PadC(aUsers[i,1],5)+" "+PadR(aUsers[i,2],15)+"  "+;
            PadR(aUsers[i,3],16)+"  "+PadR(aUsers[i,4],15)+" "+;
            Padl(Ltrim(Str(Int((Val(aUsers[i,5])%86400)/3600))),2,'0')+":"+;
            Padl(Ltrim(Str(Int((Val(aUsers[i,5])%3600)/60))),2,'0') +":"+;
            Padl(Ltrim(Str(Int(Val(aUsers[i,5])%60))),2,'0')+hb_eol()
    Next
  Else
    cMsg:="Nenhum Usuário Conectado!"
  Endif
  MemoEdit(cMsg,6,7,18,71,.F.)

Return

*****************************
Procedure ListTabelas()
  Local aTables:=LETO_MGGETTABLES(),;
        nTbls, cMsg
  Janela(5,6,19,72,"Tabelas Abertas","N/W","W+/B","N/W")
  SetColor("W+/R")
  @ 19,6 Clear to 19,72
  @ 19,7 Say "<Esc=Sair>"
  SetColor("N/W")
  nTbls := Len(aTables)
  If nTbls>0
    cMsg:="Ordem Nome da Tabela"+hb_eol()
    For i=1 To nTbls
      cMsg+=PadC(aTables[i,1],5)+" "+PadR(aTables[i,2],15)+hb_eol()
    Next
  Else
    cMsg:="Nenhum Tabela aberta!"
  Endif
  MemoEdit(cMsg,6,7,18,71,.F.)

Return

*****************************
STATIC FUNCTION DbSkipBlock( n, oTbr )

  LOCAL nSkipped := 0

  IF n == 0
     dbSkip( 0 )

  ELSEIF n > 0
     DO WHILE nSkipped != n .AND. TBNext( oTbr )
        nSkipped++
     ENDDO
  ELSE
     DO WHILE nSkipped != n .AND. TBPrev( oTbr )
        nSkipped--
     ENDDO
  ENDIF

RETURN nSkipped

*****************************
STATIC FUNCTION TBNext( oTbr )

  LOCAL nSaveRecNum := RecNo()
  LOCAL lMoved := .T.

  HB_SYMBOL_UNUSED( oTbr )

  IF Eof()
     lMoved := .F.
  ELSE
     dbSkip( 1 )
     IF Eof()
        lMoved := .F.
        dbGoto( nSaveRecNum )
     ENDIF
  ENDIF

RETURN lMoved

*****************************
STATIC FUNCTION TBPrev( oTbr )

  LOCAL nSaveRecNum := RecNo()
  LOCAL lMoved := .T.

  HB_SYMBOL_UNUSED( oTbr )

  dbSkip( -1 )

  IF Bof()
     dbGoto( nSaveRecNum )
     lMoved := .F.
  ENDIF

RETURN lMoved

*****************************
Procedure LocalizaDB()
  Local nTamanhoNomeParaPesquisa:= 1
  Local nQuantRegistrosProcessados:= 0
  Local nQuantMaximaDeRegistrosNoGrid:= 60
  Local nRec:=RECNO(), nOrdAnt:=DBSetOrder(2)

  Janela(4,15,19,65,"Localizar Registro","N/W","W+/G","N/W")
  @ 5,16 Say "? e * podem ser usados na busca, por exemplo:"
  @ 6,16 Say "PAULO B* ou P* CA?* A*"
  @ 7,16 Say "Informe o Nome:"
  SetColor("W+/R")
  @ 19,15 Clear to 19,65
  @ 19,16 Say "<Esc=Sair>  <Enter=Seleciona>  "+CHR(24)+CHR(25)

  brw_mat:={{"",""}}

  brw:=TBrowse():New(8,16,18,64)
  private n:= 1, ntot:=len(brw_mat)

  brw:colorspec := "N/W,W+/R,W+/R,W+/BG,GR+/GR"
  brw:headsep:=chr(205)+chr(209)+chr(205)
  brw:colsep:=" "+chr(179)+" "
  brw:gotopblock({|| n:= 1})
  brw:gobottomblock({|| n:=ntot})
  brw:skipblock({|_1| (n:= n + _1, iif(n < 1, _1:= _1 - n + (n:= ;
                1), iif(n > ntot, _1:= _1 - (n - (n:= ;
                ntot)), Nil)), _1)})


  brw:addcolumn(tbcolumnnew("Código",{|| TRANS(brw_mat[n,1],"9999")}))
  brw:getcolumn(1):width := 4
  brw:getcolumn(1):cargo := {"9999"}
  brw:addcolumn(tbcolumnnew("Nome",{|| TRANS(brw_mat[n,2],"@!")}))
  brw:getcolumn(2):width := 40
  brw:getcolumn(2):cargo := {"@!"}
  volta_db=.t.
  st_pesq:=""
  idx=1
  cCorAnt:=SetColor("N/BG")
  @ 7,32 SAY spac(33)
  SetColor(cCorAnt)
  DO WHILE volta_db
    SETCOLOR("W+/B")
    SET CURSO OFF
    e=1
    DO WHILE !brw:stabilize() .AND. NEXTKEY()=0
    ENDD
    READINSERT(.f.)

    cCorAnt:=SetColor("N/BG")
    @ 7,32 SAY LEFT(st_pesq+spac(40),33)
    SetColor(cCorAnt)
   
    tecl_p=INKEY(0)
    carac_ = UPPER(CHR(tecl_p))
    IF (tecl_p>31 .and. tecl_p<1000) .or. tecl_p = K_BS
      If tecl_p = K_BS
        st_p=Left(st_pesq,Len(st_pesq)-1)
      Else
        st_p=st_pesq+carac_
      Endif
    
      st_p_:=st_p
      nTamanhoNomeParaPesquisa:= Len(st_p_)
      nQuantRegistrosProcessados:= 0
      NOMES_LETO->(DBSeek(st_p_))
      Private brw_mat:={}
      IF LEFT(st_p_,1)="*" .OR. "*" $ st_p_ .OR. "?" $ st_p_
        IF LEN(st_p_)>1
          st_p_+="*"
          nPas_:=1
          DO WHILE OrdWildSeek( st_p_, iif(nPas_=1,.F.,.T.) )
            aadd(brw_mat, {NOMES_LETO->CODIGO,NOMES_LETO->NOME} )
            nPas_+=1
            if nPas_ > nQuantMaximaDeRegistrosNoGrid
              EXIT
            EndIf
          ENDDO
        ENDIF
      ELSE
        SEEK st_p_
        IF FOUND() .and. !EMPT(st_p_)
          Do While !Eof()
            If Substr(NOMES_LETO->NOME,1,nTamanhoNomeParaPesquisa) == st_p_
              nQuantRegistrosProcessados += 1
              if nQuantRegistrosProcessados > nQuantMaximaDeRegistrosNoGrid
                EXIT
              EndIf
              aadd(brw_mat, {NOMES_LETO->CODIGO,NOMES_LETO->NOME} )
            ElseIf Substr(NOMES_LETO->NOME,1,nTamanhoNomeParaPesquisa) > st_p_
              EXIT
            Endif
            SKIP
          EndDo
        ENDIF
      ENDIF
      if Len(brw_mat)==0
        brw_mat:={{"",""}}
      Endif
      st_pesq=st_p
      n:=1
      ntot:=len(brw_mat)
      brw:rowpos=1
      brw:configure()
      LOOP
    ENDIF
    SET CURSO ON
    brw:dehilite()
    DO CASE
      CASE tecl_p = K_ENTER
        DBSetOrder(nOrdAnt)
        If Val(brw_mat[n,1])>0
          NOMES_LETO->(DBSeek(brw_mat[n,1]))
        Else
          GO nRec
        Endif
        volta_db=.f.
      CASE tecl_p = K_ESC
        DBSetOrder(nOrdAnt)
        GO nRec
        volta_db=.f.
      CASE tecl_p = K_UP
        brw:up()
      CASE tecl_p = K_DOWN
        brw:down()
      CASE tecl_p = K_RIGHT
        brw:right()
      CASE tecl_p = K_LEFT
        brw:left()
      CASE tecl_p = K_HOME   
        brw:home()
      CASE tecl_p = K_END   
        brw:end()
      CASE tecl_p = K_PGUP   
        brw:pageup()
      CASE tecl_p = K_PGDN   
        brw:pagedown()
      CASE tecl_p = K_CTRL_PGDN
        brw:gobottom()
      CASE tecl_p = K_CTRL_PGUP
        brw:gotop()
      CASE tecl_p = K_CTRL_END   
        brw:panend()
      CASE tecl_p = K_CTRL_HOME   
        brw:panhome()
      CASE tecl_p = K_CTRL_LEFT   
        brw:panleft()
      CASE tecl_p = K_CTRL_RIGHT   
        brw:panright()
    ENDC
*    st_pesq=""
  ENDD

Return

Obrigado,

[rossine]

Olá,

Sobre o travamento de registros funcionou. Tive que mudar a configuração "Lock_Scheme" no letodb.ini

No DbInfo.ch está assim:

Código: Selecionar todos

#define DB_DBFLOCK_COMIX        2   /* COMIX and CL53 DBFCDX hyper locking scheme */

Então mudei para "2" no letodb.ini

Código: Selecionar todos

;Lock_Scheme = 6
Lock_Scheme = 2

Reiniciei o servidor do LetoDBF e funcionou.

Agora vou procurar algo sobre o DbRLockList.

T+

[rossine]

Olá,

Sobre a função DbRLockList(), no LetoDBF tem a "leto_MgGetLocks()" que retorna a lista dos locks.

Um detalhe interessante no LetoDBF é que no RDDCDX se você tem um sistema rodando no servidor e outro no terminal, a lista de Locks de um programa não é enxergada pelo outro programa e no LetoDBF sempre mostra todos os locks de ambos sistemas.

T+