Rotina de codigo automático

[Josmar dos Santos]

Ola pessol, to precisando de uma rotina de colocar codigo automatico em um determinado campo caracter. Gostaria se possível, uma rotina que rode em rede. Se alguém tiver, eu agradeceria muito, pois to precisando com certa urgência.
Um abraço a todos....
:xau

[Maligno]

Se for um código automático que apenas dê uma identidade única a certo objeto, sugiro o uso de um número aleatório. Eu faço isso e nunca tive problema. Funciona em modo local ou rede. O único detalhe é que, na (remota) possibilidade de já existir um número igual ao que foi gerado, antes deve ser feita uma pesquisa no arquivo. Se já existir, é só gerar outro. Eu uso a função Rand() da CATools. Mas uso apenas a parte fracionária e sobre ela gero o CRC32() que me dá no retorno uma string de tamanho menor e fixo. Essa função tenho no meu site, caso queira.

[gvc]

Veja sobre semaforo em:

https://pctoledo.org/forum/viewto ... f=1&t=2762

Lá, alende de uma dica do Mestre Maligno, tem uma modesta contribuição minha, que controla número sequencial para pedidos.

[Josmar dos Santos]

Volto novamente a falar desse topico, porque ainda não tive sucesso, ja colhi algumas informações, mas a verdade e que preciso adaptar essa rotina a minha atual. O problema e que esse sistema que to tentando manipilar ja foi feito aos dez anos atras. O pior e que nessa epoca ele foi feito pelo miro3. Acho q vocês ja notarao isso ! Ja consegui fazer algumas alterações...mas tem muitos problemas a ser resolvido q ate agora nao tive sucesso ! Por exemplo: quando dou um enter, ele entra no cadastro, mas quando dou "esc" e volto novamente, ele pula o codigo automatico de dois em dois. O pior de tuudo, e que ele nem registra na dbu !
Coloco as duas rotinas, uma que funciona sem problema em ntx e a outra que estou tentando adaptar ao cdx. É lógico que se os colegas tiverem alguma outra soluçao sem usar essa rotina ...vai ser bem aceito.

Código: Selecionar todos

* -> tentando adaptar para cdx
function carreg01( tipo_acao )
me_mo := "[memo]"
if tipo_acao = inclusao
   goto bott
   skip
endif
cod_cli := clientes->cod_cli
nom_cli := clientes->nom_cli
dat_cli := clientes->dat_cli
val_cli := clientes->val_cli
obs_c := clientes->obs_c
if tipo_acao = inclusao
area_arq := alltrim( str( select(), 5 ) )
   set order to 1
   goto bott
   cod_cli := (cod_cli,5)
   while .t.
      seek (cod_cli)
      if eof()
            append blank
            replace all cod_cli with strzero(recno(),5)
            commit
            unlock
         exit
      else
         cod_cli := strzero(cod_cli,5) 
      endif
   enddo
   sele &area_arq
endif

* - > funcao adaptada para ntx
function carreg01( tipo_acao ) //funcao que carrega os dados para o banco de dados
me_mo := "[memo]"
if tipo_acao = inclusao
   goto bott
   skip
endif
cod_cli := clientes->cod_cli
nom_cli := clientes->nom_cli
dat_cli := clientes->dat_cli
val_cli := clientes->val_cli
obs_c := clientes->obs_c
*-> Codigo automatico
if tipo_acao = inclusao
area_arq := alltrim( str( select(), 5 ) ) // ->busca o prg que cria os arquivos no bando de dados
   set order to 1
   goto bott
    cod_cli:= strzero( val( field->cod_cli) + 1, 5 )
    sele 100
    while .t.
        seek padr( "002" + cod_cli, 100 ) // 002 -> indice de controle do ntx e 100 - > indice de controle da rede
        if eof()
            if adireg( 0 )
                replace dados with padr( "002" + cod_cli, 100 )
                commit
                unlock
                aadd( re_gistros, recn() ) //funcao que registra o arquivo
            endif
            exit
        else
            cod_cli:= strzero( val( cod_cli) + 1, 5 )
        endif
    enddo
    sele &area_arq //->busca o prg que cria os arquivos no bando de dados
endif

um abraço a todos
:xau

[Ademir]

Oi Josmar, boa tarde !

Acho que o mais fácil pra vc resolver esse problema seria o seguinte:

Antes de gravar o codigo, bloqueie o arquivo. Em seguida, dê um go bott, some mais 1 ao codigo atribuindo esse valor a uma variavel e em seguida grave o registro com esse codigo. Logo após, claro, dê um dbcommit() e desbloqueie o arquivo. Isso lhe dará a certeza de que o código é válido, pois bloqueando o arquivo, somente o usuario que confirmou a inclusão primeiro terá a prioridade. Se outro usuario tentar isso, quando conseguir bloquear o arquivo já pegará um novo codigo e assim por diante. Vale lembrar que essa operação toda é muito rapida. Para bloquear esse arquivo, vc poderá usar um contador de tempo com uns 5 segundos mais ou menos. E bloqueando o arquivo vc nem precisa dar seek para saber se está cadastrado ou não. Seria algo mais ou menos assim:

Código: Selecionar todos

if acao=´Inclusao´
   if arqlock(5)
      go bott
      vcodi=strzero(val(codi)+1,5)
      repl codi with vcodi, .....
      dbcommit()
      unlock
   endif
endif

Espero ter ajudado. Abraço.

[Josmar dos Santos]

Blz..Ademir
Obrigado pela sua atenção !
Pode deixar, vou testar o seu teste !
:)Pos

[asimoes]

Olá,
Se não me engano eu peguei este exemplo aqui no forum.
Eu uso e funciona!

[]´s

Código: Selecionar todos

SELECT C0001
IF lAdicionar
   cCodigo:=STRZERO(PsqControle( DBF() ),2)
   DbAppend()
   C0001->Cod:=cCodigo
ELSE
   Rec_Lock()
ENDIF
C0001->Nome:= cNome
C0001->(DbCommit())
C0001->(DbUnlock())

FUNCTION PsqControle( cDataBase )
   // Inicializa controle com um numero diferente do total de registros
   //Exemplo:
   //CLIENTES->IDCLIENTE := PsqControle( DBF() )
   //APPEND BLANK
   //...
   //COMMIT
   //...
   DEFAULT cDirSys TO ""
   nControle := IIF( RecCount()=0, 1, RecCount()+(RecCount()/2) )
   // Guarda a área atual do .DBf a ser controlado
   OldArea := Select()
   IF !File(cDirSys+"CONTROLE.DBF")
      // Cria a estrutura do controlador caso ainda não exista
      aStru_DBF := { ;
           { "DATABASE"  , "C",12, 0 } , ;  // Guarda o nome do DBF/ALIAS
           { "CONTADOR"  , "N", 9, 0 } }    // Armazena o contador
            DBCREATE( cDirSys+"CONTROLE", aStru_DBF )
   ENDIF
   IF Select("CONTROLE") == 0 // Se ainda não estiver aberto, abre...
      USE &cDirSys.CONTROLE NEW
   ELSE
      DbSelectar("CONTROLE")  // Se ja estiver aberto SELECIONA
   ENDIF
   // Verifica a existencia da chave( que pode ser também uma palavra )
   LOCATE FOR UPPER(CONTROLE->DataBase) = UPPER(cDataBase)
   IF Found()
      // Encontrando incrementa o contador
      //nControle := controle->contador + 1
      RLOCK() // Usado no caso de rede
      nControle := CONTROLE->Contador + 1
      CONTROLE->Contador := nControle
      CONTROLE->(DbCommit())
      CONTROLE->(DbUnlock())
   ELSE
      // Caso a chave ainda não exista será criada
      APPEND BLANK
      CONTROLE->DataBase := cDataBase
      CONTROLE->Contador := nControle
      CONTROLE->(DbCommit())
   ENDIF
   // Volta a área antiga
   SELECT (OldArea)
   // Retorna o numero de controle
RETURN nControle 

[SandroBelarmino]

No exemplo do Ademir falta um dbappend(), o codigo ficaria assim:

Código: Selecionar todos

if acao=´Inclusao´
   if arqlock(5)
      go bott
      vcodi=strzero(val(codi)+1,5)

      dbappend()  // colocar esse comando, senao vai gravar o novo codigo por cima do ultimo existente.

      repl codi with vcodi, .....
      dbcommit()
      unlock
   endif
endif

Abraços.

[Josmar dos Santos]

Ola asimoes, essa rotina que vc descreveu, serve também para campo caracter ou somente campo numérico ??
:)Pos

[gvc]

Veja sobre semaforo em:

https://pctoledo.org/forum/viewto ... f=1&t=2762

Lá, alende de uma dica do Mestre Maligno, tem uma modesta contribuição minha, que controla número sequencial para pedidos.

O bloqueio do arquivo ou último registro costuma dar problemas. Veja o post referido acima.

[asimoes]

Olá Josmar,

Ola asimoes, essa rotina que vc descreveu, serve também para campo caracter ou somente campo numérico ??

Sim, tanto campo númerico como caracter.

O Retorno da função PsqControle é do tipo númerico.

Caso queira gravar em um campo caracter tem que converter usando funções do tipo strzero ou str

O uso da função PsqControle é interessante quando a casos em que é feito um pack na tabela de sistema que tenho um campo código, como a tabela controle é que fornece o número não tem como gear um código com numero 1 ou 001 por exemplo.

[]´s

[Ademir]

Boa tarde amigos !

Em primeiro lugar agradeço ao Sandro por corrgir meu exemplo. Com relação a funcionalidade de se obter o proximo codigo /numero bloqueando o arquivo, posso dizer que funciona perfeitamente, pois o arquivo apenas ficara bloqueado por nao mais que 5 segundos e esse tempo é muito mais que suficiente para isso. Agora, se esse arquivo for "limpo" periodicamente, seria interessante optar por obter o proximo codigo/numero utilizando um arquivo de controle de sequencias, pois num arquivo limpo, o proximo numero seria o 1 que poderia já existir anteriormente.

[asimoes]

Ademir,

O problema que você mencionou está resolvido no exemplo que eu postei.
Com a função PsqControle()

[Josmar dos Santos]

Ola to levantando a lebre sobre esse assunto de novo ! Essa rotina q estou passando é do miro3, faz parte de um sistema bem antigo no qual estou tentando melhorá-lo. Estou tentando introduzir a função PsqControle() para colocar um número sequêncial. É claro q há varias alternativas, mas escolhi essa. Andei fazendo algumas tentativas de se colocar o mesmo, mas houve dois problemas de cara:
Prime: O número aparece, mas so de eu entrar no cadastro e ficar dando <ESC> e saindo, o número fica pulando sendo q não foi registrado nada!
Pergunto: Qual seria o local ideal para se chamar essa função para não ocorrer tais erros ?
Segundo: Ao tentar registrar o codigo, após confirmar as informações gera esse erro

Código: Selecionar todos

Error DBFNTX/1020 Data type error

E também o codigo gerado após a confirmação mesmo dando esse erro não registra o codigo no campo cod_cli

Código: Selecionar todos

LOCAL CONTAR
RE_GISTROS := {}
MENSAGEM( "Aguarde abertura de arquivos" )
SELE 1
IF !USEREDE( "CLIENTES", .F., 10 )
   BEEP()
   MENSAGEM( "O arquivo CLIENTES n„o est  dispon¡vel", 3 )
   RETURN
ELSE
   SET INDEX TO CLIEN001, CLIEN002
ENDIF
IF !REDE_CONTROLE()
   BEEP()
   MENSAGEM( "O arquivo OFIC.RED n„o est  dispon¡vel", 3 )
   RETURN
ENDIF
SELE CLIENTES
COR( "MENU" )
@ LIN_MENU, 00
@ LIN_MENU, 01 SAY "Cadastro ³ CLIENTES"
DU_PLICIDADE := .F.; MOSTRA_RESULTADO := .F.
PRIVATE COD_CLI, NOM_CLI, DAT_CLI
WHILE .T.
   MENSAGEM( "Tecle <ESC> para retornar" )
   IF !(DU_PLICIDADE )
      CARREG01( INCLUSAO )
   ELSE
      MOSTRA_RESULTADO := .T.
   ENDIF
   IF CARGET01( INCLUSAO )=.F.
      EXIT
   ENDIF
   IF PERG( "Confirma as informa‡”es ?" ) = "N"
       DU_PLICIDADE := .T.
       LOOP
   ENDIF
   DU_PLICIDADE := .F.
   MOSTRA_RESULTADO := .F.
   IF !ADIREG( 0 )
       DU_PLICIDADE := .T.
      MENSAGEM( "Inclus„o n„o foi bem sucedida", 3 )
      LOOP
   ENDIF
   SALVAR01()
   COMMIT
   UNLOCK
ENDDO
SELE 100
FOR CONTAR := 1 TO LEN( RE_GISTROS )
   GOTO RE_GISTROS[ CONTAR ]
   IF REGLOCK( 2 )
      DELE
      UNLOCK
   ENDIF
NEXT
RESTSCREEN( LIN_MENU + 1, 00, 23, 79, TELA_PRI )
 
FUNCTION CARREG01( TIPO_ACAO )
IF TIPO_ACAO = INCLUSAO
   GOTO BOTT
   SKIP
ENDIF
COD_CLI := CLIENTES->COD_CLI
NOM_CLI := CLIENTES->NOM_CLI
DAT_CLI := CLIENTES->DAT_CLI
DAT_CLI := DATE()

// -> Codigo automatico
IF TIPO_ACAO = INCLUSAO
   SET ORDER TO 1
   COD_CLI:=PsqControle("CLIENTES")
ENDIF
 
FUNCTION CARGET01( TIPO_ACAO )
IF TIPO_ACAO != MOSTRA_PAG_1
   AL_TERAR := .F.
ENDIF
JANELA( 3, 9, 12, 68, "CLIENTES" )
COR( "CERCADURAS" )
@  4, 10 TO 11, 67 DOUBL
COR( "GETS" )

@  4, 29 SAY "CADASTRO DE CLIENTES"
@  7, 12 SAY "CODIGO:"
@ 7,21 SAY COD_CLI PICTURE "@!"
@  7, 29 SAY "DATA:" GET DAT_CLI
@  9, 12 SAY "NOME..:" GET NOM_CLI PICTURE "@!"
IF TIPO_ACAO = MOSTRA_PAG_1
   CLEAR GETS
   RETURN .F.
ENDIF
IF TIPO_ACAO = CONSULTA .OR. TIPO_ACAO = EXCLUSAO
   CLEAR GETS
   IF TIPO_ACAO = EXCLUSAO
      RETURN .T.
   ENDIF
   MENSAGEM( "Tecle algo para continuar" )
   IF INKEY( 0 ) = T_ESC
      RETURN .F.
   ENDIF
ELSE
   CURSOR( LIGA )
   READ
   CURSOR( DESLIGA )
   IF LASTKEY() = T_ESC
      RETURN .F.
   ENDIF
ENDIF
RETURN .T.
 
FUNCTION SALVAR01
CLIENTES->COD_CLI := COD_CLI
CLIENTES->NOM_CLI := NOM_CLI
CLIENTES->DAT_CLI := DAT_CLI


FUNCTION PsqControle( database )
   nControle := iif( recco()=0, 1, recco()+(recco()/4) )
   OldArea := Select()
   if !file( "CONTROLE.DBF" )
      ESTRU_DBF := { { "DATABASE"  , "C",12, 0 } , ;
                     { "CONTADOR"  , "N", 7, 0 } }    // Controle de FINANCEIRO
      DBCREATE( "CONTROLE", ESTRU_DBF )
   endif
   If Select("CONTROLE") == 0
      USE controle NEW
   Else
      DbSelectar("CONTROLE")
   EndIf
   LOCATE FOR UPPER(controle->database) = UPPER(database)
   if found()
      nControle := controle->contador + 1
      RLOCK()
      controle->contador := nControle
      COMMIT
   else
      APPEND BLANK
      controle->database := database
      controle->contador := nControle
      COMMIT
   endif
   SELE (OldArea)
   RETURN nControle

sem mais
Josmar
:%

[rochinha]

Amiguinhos,

Salvo quando utilizamos inclusao de 1 para N, exemplo pedido de vendas somente neste caso necessitamos de um codigo de vinculo, o que podemos chamar de codigo temporario ou orcamento.

E porque neste caso voce cria o código temporario? é necessário para que os itens e parcelamentos sendo inclusos fiquem ligados a tabela pai e no momento da efetivação ou gravação, é pesquisado o codigo sequencial final e aplicado a tabela pai e aos filhos.

No caso de uso de codificação em cadastros, ainda mais quando se trata de tratamento de tabelas em rede é praxe assinalar o código final na conclusão da rotina.

Código: Selecionar todos

...
// FLAGeia o procedimento usando uma variavel
    local lAppend := "INCLUSAO" 
// abre tabelas
// cria tela
// Coloca os campos/gets
// le os dados/read
// pergunta se confirma
// seleciona a tabela alvo
// critica a operacao seguinte
     if  lAppend = "INCLUSAO" 
         M->CODIGO := psqControle( "TABELA" )
         dbAppend()
     else
         dbRLock()
     endif
     // salva os registros na tabela
     // salva o cache/COMMIT e libera registro
...

Veja um trecho de código no qual a tecnica se aplica:

Código: Selecionar todos

STATIC FUNCTION CADASTRA( lAppend )
                                                                         
   local lSave := .f. // Nunca salva
   local nOldRec := RecNo()
                                                                         
   lAppend := iif( lAppend=nil, "NOVO", lAppend )
                                                                         
   if lAppend = "NOVO"
      // Vai ao registro fantasma
      GOTO BOTTOM                                                                         
      SKIP                                                                         
   endif                                                                         
                                                                         
   SELE CUSTOMER

   // deéndendo do conteudo de lAppend pucha registro vazio ou com dados
   CR_CUSTOMER( lAppend ) 
                                                                         
   CLEAR SCREEN
   @ BOX ...
   @  1,  1 SAY "FIRST:"
   @  3,  1 SAY "LAST:"
   @  5,  1 SAY "STREET:"
   @  7,  1 SAY "CITY:"
   @  9,  1 SAY "STATE:"
   @ 11,  1 SAY "ZIP:"
   @ 13,  1 SAY "HIREDATE:"
   @ 15,  1 SAY "MARRIED:"
   @ 17,  1 SAY "AGE:"
   @ 19,  1 SAY "SALARY:"
   @  1,  1 SAY "NOTES:"
   @  1, 15 GET        VAR M->FIRST
   @  3, 15 GET         VAR M->LAST
   @  5, 15 GET       VAR M->STREET
   @  7, 15 GET         VAR M->CITY
   @  9, 15 GET        VAR M->STATE
   @ 11, 15 GET          VAR M->ZIP
   @ 13, 15 GET     VAR M->HIREDATE
   @ 17, 15 GET          VAR M->AGE
   @ 19, 15 GET       VAR M->SALARY
   @  1, 15 GET        VAR M->NOTES
  
   IF SuaFuncaoDePergunta( "Deseja salvar?" ) = "S"
       lSave := .t.
   ENDIF                                                                         
                                                                         
   if lSave                                                                          
      SELE CUSTOMER
      if lAppend ="NOVO"
         // Neste caso o praze seria usar o nome da propria tabela alvo assim não haveria necessidade de lembrar
         // o nome de cada variavel
         M->NUMBER    := Psqcontrole( dbf() )
         APPEND BLANK                                                                         
      else                                                                         
         RLOCK()                                                                         
      endif                                                                         
      SV_CUSTOMER()                                                                         
      COMMIT                                                                         
   endif                                                                         
return nil                                                                         

FUNCTION CR_CUSTOMER( TIPO_ACAO )
   //
   // -> Carrega variaveis para entrada ou altercao de dados
   IF TIPO_ACAO = "NOVO"
      GOTO BOTT
      SKIP
   ENDIF
   M->NUMBER    := CUSTOMER->NUMBER
   M->FIRST        := CUSTOMER->FIRST
   M->LAST         := CUSTOMER->LAST
   M->STREET       := CUSTOMER->STREET
   M->CITY         := CUSTOMER->CITY
   M->STATE        := CUSTOMER->STATE
   M->ZIP          := CUSTOMER->ZIP
   M->HIREDATE     := CUSTOMER->HIREDATE
   M->AGE          := CUSTOMER->AGE
   M->SALARY       := CUSTOMER->SALARY
   M->NOTES        := CUSTOMER->NOTES
   IF TIPO_ACAO = "NOVO"
      //
      // -> Deficao de valores constantes
   ENDIF
   RETURN .T.
   
FUNCTION SV_CUSTOMER
   //
   // -> Salva o conteudo das variaveis de entrada no arquivo
   CUSTOMER->NUMBER    := M->NUMBER
   CUSTOMER->FIRST        := M->FIRST
   CUSTOMER->LAST         := M->LAST
   CUSTOMER->STREET       := M->STREET
   CUSTOMER->CITY         := M->CITY
   CUSTOMER->STATE        := M->STATE
   CUSTOMER->ZIP          := M->ZIP
   CUSTOMER->HIREDATE     := M->HIREDATE
   CUSTOMER->AGE          := M->AGE
   CUSTOMER->SALARY       := M->SALARY
   CUSTOMER->NOTES        := M->NOTES
   COMMIT
   RETURN .T.

//---------------------------------------------------------------------------//
STATIC FUNCTION FUN( oLbx )                                                                         
RETURN NIL