Rotina de inclusão em rede.

[Ademir]

Boa noite a todos mais uma vez. Preciso desenvolver uma rotina de inclusão em rede. Estou trabalhando com 2 arquivos:

Arquivo de pedidos

Numero do pedido NUMPED N 6
Nome do cliente NOMCLI C 50

Arquivo de itens

Numero do pedido NUMPED N 6
Codigo do item CODITEM N 6
Quantidade QTDE N 4


Em vez de trabalhar apenas com um arquivo onde teria que cadastrar o nome do cliente em cada registro, resolvi separar os arquivos.

Para incluir, solicito a digitação do nº do pedido. A partir daí, o que devo fazer quanto ao travamento do registro na rede para que nenhum usuário possa acessá-lo durante a inclusão do pedido ?

Espero que tenha conseguido me fazer entender.

Grato

[gvc]

Veja na seção de código fonte as funções de incluir e bloquear registro em rede, assim como de bloqueio de arquivo.

Pelo que eu entendi, o seu sistema deverá incluir um registro no arquivo de pedido. Usando a função de incluir registro, o mesmo ficará bloqueado até que vc desbloquei com DBUnlock(), feche o mesmo ou bloquei/crie um novo registro.
Com o registro do pedido bloqueado, vc poderá então incluir os itens do pedido.

Me parece que existem alguns exemplos usando essas funções aqui no forum. Use a pesquisa.

[Ademir]

Sim, entendí e agradeço sua atenção. Mas se entendí bem, antes de adicionar o registro do arquivo de pedidos, preciso verificar se o mesmo já está cadastrado ou não certo ? Para isso, eu não teria que bloquear o arquivo, para depois dar o dbseek() ? E como o registro do pedido tem que ficar bloqueado para que outros usuarios nao o deletem enquanto eu estiver incluindo itens, eu não poderia bloquear o arquivo para dar o dbseek. Esta é a minha dúvida.

[Ademir]

Oi Pessoal, boa noite ! Será que ninguem teria alguma dica pra me dar sobre esse rotina de inclusão ? É que estou precisando muito resolver essa pendencia. Estava patinando, agora estou encalhado. Se alguem puder ajudar, agradeceria muito. Abraço a todos.

[alxsts]

Ola Ademir,

dá uma olhada neste programa, que faz manutencão em uma tabela simples. Voce não vai conseguir rodar pois faltam rotinas que estão em outros prgs. Mas dá pra voce estudar e analisar a rotina Edit() onde tem a inclusao, alteracao e exclusao. Copiei para dentro deste prg as rotinas de abertura de arquivo, travamento de arquivo, travamento de registro, e append.

Código: Selecionar todos

//------------------------------------------------------------------------------
//
//     FOL013.PRG - Manutenção da Tabela de Eventos da Folha de Pagamento
//     Alexandre Santos - 23/02/2007 - 15:33
//
//     Nota: Compilar com /N/W/L
//------------------------------------------------------------------------------

#include "Box.ch"
#include "Inkey.ch"
#include "SetCurs.ch"
#include "Common.ch"

// Default column separator
#define DEF_CSEP  " " + chr(179) + " "

// Default heading separator
#define DEF_HSEP chr(196) + chr(194) + chr(196)

// Default footing separator
#define DEF_FSEP chr(196) + chr(193) + chr(196)


PROCEDURE FOL013()

   Local oTbr, oColumn, aSetKeys := {}, cScreen := SaveScreen()
   Local cColor := SetColor( "B/W,N/W*,N/W,B/W,B/W" ), n
   Local aHeadings := { "C¢digo",     ;
                        "Descri?Æo ", ;
                        "Tipo",       ;
                        "Unidade",    ;
                        "Status"      ;
                      }
   Begin Sequence

      If ! NetUse('VERBASFP',.F.,3)
         Break
      Endif

      DbSetIndex( "Verbas01" )
      DbSetIndex( "Verbas02" )

      oTbr := TBrowseDB( 06, 10, 20, 70 )

      oTbr:colSep  := DEF_CSEP
      oTbr:colSep  := DEF_CSEP
      oTbr:headSep := DEF_HSEP
      oTbr:footSep := DEF_FSEP

      For n := 1 to FCount()
         // Make a new column
         oColumn := TBColumnNew( aHeadings[ n ],                         ;
                                 FieldWBlock( Field( n ), Select() ) )
         // Add the column to the browse
         oTbr:addColumn( oColumn )
      Next

      oTbr:goTop()

      // Salva eventuais setkeys
      aSetKeys := {}

      Aadd( aSetKeys, { K_INS,   SetKey( K_INS,   { || VERBASFP->( Edit( oTbr, 1 ) ) } ) } )
      Aadd( aSetKeys, { K_ENTER, SetKey( K_ENTER, { || VERBASFP->( Edit( oTbr, 2 ) ) } ) } )
      Aadd( aSetKeys, { K_DEL,   SetKey( K_DEL,   { || VERBASFP->( Edit( oTbr, 3 ) ) } ) } )

      MsgLine( "Use " + Chr(27) + Chr(24) + Chr(25) + Chr(26) + ;
               "  Ins  Enter  Del  Ctrl  PgUp  PgDn           Esc" )

      DispBox( 04, 05, 20, 75, B_SINGLE + " ", "W+/W" )
      BoxTitle ( 04, 05, 75, "Manuten?Æo da Tabela de Verbas Folha Pagto.", "W+/B*" )
      BoxShadow( 05, 05, 20, 75 )

      VERBASFP->( DBGrid(oTbr, 2 ) )

      // Restaura SetKeys
      Aeval( aSetKeys, { |e| SetKey( e[1], e[2] ) } )

   End Sequence

   RestScreen( ,,,, cScreen )
   DbCloseAll()

   Return

//------------------------------------------------------------------------------
Static Function Edit( oTbr, nRequest )

   // nRequest: 1 Incluir, 2 Alterar, 3 Excluir

   Local lRet := .T., cScreen, aArray, aBkUp, nI, nCount := FCount()
   Local lExit := .F., nOldRec := VERBASFP->( Recno() ), lIns := .T.
   Local nTop := 10, nLeft := 15, nBottom := 18, nRight := 72
   Local nCursor, abSetKeys, nOpt, lFirst := .T., GetList := {}

   Local aAction   := { "InclusÆo ", "Altera?Æo ", "ExclusÆo " }
   Local aTipos    := { "1-Vencimento", "2-Desconto" }
   Local aUnidades := { "H-Hora ", "D-Dia ", "Z-Dozeavo ", "V-Valor ", "%-Percent " }
   Local aStatus   := { "A-Ativo", "I-Inativo" }

   If ( ( nRequest >  1 ) .and. ( LastRec() > 0) ) .or. ;
        ( nRequest == 1 ) .and. ( LastKey() == K_INS)

      abSetKeys := {}

      Aadd( abSetKeys, { K_INS,   SetKey( K_INS,   NIL ) } )
      Aadd( abSetKeys, { K_ENTER, SetKey( K_ENTER, NIL ) } )
      Aadd( abSetKeys, { K_DEL,   SetKey( K_DEL,   NIL ) } )

      MsgLine()

      cScreen := SaveScreen( nTop, nLeft, nBottom + 1, nRight + 1 )

      nCursor := SetCursor( SC_NORMAL )

      While ! lExit
         lRet := .F.

         If nRequest > 1
            // se alteracao ou exclusao, trava registro corrente
            RecLock()
         Else
            // incllusao... move o ponteiro para o ultimo registro do arquivo
            // e salta para o proximo registro (registro em branco)
            If lFirst
               aArray := {}
               DbGoBottom()
               DbSkip()
            Endif
         Endif

         If ( nRequest > 1 ) .or. ( nRequest == 1 .and. lFirst )
            // se alteracao ou exclusao, carrega os campos do registro atual para o array aArray.
            // Se inclusao e primeira vez, carrega uma imagem de um registro em
            // branco (dbgobottom(), dbskip() acima) no array aArray, que será usado para fazer os gets
            aArray := {}
            For nI := 1 to nCount
                Aadd( aArray, FieldGet( nI ) )
            Next
         Endif

         // guarda uma imagem do array recem criado (registro em branco)
         aBkUp := Aclone( aArray )

         lFirst := .F.

         nOpt := 2

         While nOpt == 2

            DispBox( nTop, nLeft, nBottom, nRight, B_SINGLE + " ", "W+/W" )
            BoxTitle( nTop, nLeft + 1, nRight, aAction[ nRequest ] + "de Verba", "W+/B*" )

            BoxShadow( nTop, nLeft, nBottom, nRight )

            // monta getlist para os campos do array
            @ nTop + 2, nLeft + 2 Say " C¢digo   :" ;
                                  Get aArray[1] Pict "9999" ;
                                 When nRequest == 1 ;
                                Valid ! Empty( aArray[1] )

            @ nTop + 3, nLeft + 2 Say " Descri?Æo:" ;
                                  Get aArray[2] ;
                                 Pict "@!" ;
                                Valid ! Empty( aArray[2] )

            @ nTop + 4, nLeft + 2 Say " Tipo     :" ;
                                  Get aArray[3] ;
                                 Pict "@!" ;
                                Valid { |oGet| ScanList( oGet, aTipos ) }

            @ nTop + 5, nLeft + 2 Say " Unidade  :" ;
                                  Get aArray[4] ;
                                 Pict "@!" ;
                                Valid { |oGet| ScanList( oGet, aUnidades ) }

            @ nTop + 6, nLeft + 2 Say " Status   :" ;
                                  Get aArray[5] ;
                                 Pict "@!"  ;
                                Valid { |oGet| ScanList( oGet, aStatus ) }

            If nRequest < 3
               // inclusao ou alteracao ... executa READ
               // senao, nada a fazer pois o registro ja esta exibido na tela
               // pelo metodo get:display() de cada objeto get
               ReadModal( GetList )
            Endif

            GetList := {}

            If LastKey() != K_ESC
               If ( nOpt := Alert( "Confirma " + aAction[nRequest] + "?", { " Sim ", " NÆo "}, "N/W*" ) ) == 1
                  If nRequest < 3
                     // inclusao ou alteracao...
                     If nRequest == 1
                        // Incluir... verifica se ja existe
                        If lIns := ( VERBASFP->( DbSeek( aArray[1] ) ) )
                           Alert( "Esta verba j  existe!", Nil, "N/W*" )
                        Else
                           // nao existe... adiciona registro em branco
                           VERBASFP->( AddRec() )
                        Endif
                     Endif

                     If ( nRequest == 2 ) .Or. ( nRequest == 1 .And. ! lIns )
                        // Se Alteracao, grava os campos do array no arquivo, a partir
                        // da posicao 2 ( veja If( nRequest == 1, 1, 2 ) abaixo )
                        // Senao, inclusao... grava os campos a partir da posicao 1 (chave do arquivo)
                        Aeval( aArray, { |e, p| FieldPut( p, e ) }, If( nRequest == 1, 1, 2 ) )
                     Endif
                     lIns := .F.
                     // refresh no tbrowse
                     oTbr:refreshAll():forceStable()
                     lRet := .T.
                  Else
                     // excluir...
                     // note que ja executou o RecLock() na linha 121 acima, quando não é inclusao
                     VERBASFP->( DbDelete() )
                  Endif
                  // coloca a copia do registro em branco, anteriormente guardado, em aArray
                  aArray := AClone( aBkUp )
               Else
                  // se exclusao, sai da rotina
                  If nRequest == 3
                     lExit := .T.
                     Exit
                  Endif
               Endif
            Else
               lExit := .T.
               Exit
            Endif
         Enddo
         // se inclusao, permite que o usuario inclua varios registros na sequencia
         // senao, verifica se foi digitado ESC
         lExit := ( nRequest > 1 ) .or. LastKey() == K_ESC

      Enddo

      // restaura SetKey()
      Aeval( aBSetKeys, { |e| SetKey( e[1], e[2] ) } )

      RestScreen( nTop, nLeft, nBottom + 1, nRight + 1, cScreen )

      MsgLine( "" )

      SetCursor( nCursor )

      oTbr:refreshall():forceStable()
   Endif

   Return lRet

//------------------------------------------------------------------------------
//  AddRec( <tempo segundos> ) --> lSuccess
//  Alexandre Santos - 12/01/06 - 11:39 - Otimiza?Æo do original Nantucket

FUNCTION AddRec( nWaitSeconds )

   // Inclusao de registro em rede...

   DbAppend()

   IF .NOT. NETERR()
      RETURN (.T.)
   ENDIF

   nWaitSeconds := If( Empty( nWaitSecond ), 5, nWaitSeconds )

   While .T.
      DO WHILE nWaitSeconds > 0
         DbAppend()
         IF .NOT. NETERR()
            RETURN .T.
         ENDIF
         INKEY(.5)         // Wait 1/2 second
         nWaitSeconds  = nWaitSeconds  - .5
      ENDDO
      If Alert( "NÆo foi poss¡vel inserir no arquivo " + Alias() + ".DBF.;" + ;
                    " (Arquivo em manuten?Æo por outro usu rio).;; " + ;
                    "Deseja tentar novamente?", {" Sim "," NÆo " } ) == 2
         Exit
      Endif

      nWaitSeconds := 5
   Enddo

   RETURN (.F.)         // Not locked

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

// FilLock( <tempo segundos> ) --> lSuccess
// #Alexandre Santos - 12/01/06 - 11:39 - Otimiza?Æo do original Nantucket

FUNCTION FilLock( nSeconds )

   // Travamento de ARQUIVO em rede (TAVA O ARQUIVO INTEIRO)
   IF FLOCK()
      RETURN (.T.)      // Locked
   ENDIF

   nSeconds := If( Empty( nSeconds ), 5, nSeconds )

   While .T.
      DO WHILE nSeconds
         INKEY(.5)         // Wait 1/2 second
         nSeconds = nSeconds - .5
         IF FLOCK()
            RETURN (.T.)   // Locked
         ENDIF
      ENDDO
      If Alert( "NÆo foi poss¡vel bloquear o arquivo " + Alias() + ".DBF.;" + ;
                    " (Arquivo em manuten?Æo por outro usu rio).;; " + ;
                    "Deseja tentar novamente?", {" Sim "," NÆo " } ) == 2
         Exit
      Endif
      nSeconds := 5

   Enddo
   RETURN (.F.)         // Not locked

//------------------------------------------------------------------------------
#define     DB_SHARED     .F.
#define     DB_EXLUSIVE   .T.
//---

FUNCTION NetUse( cDatabase, lOpenMode, nSeconds, cAlias )

   // Abertura de arquivo em rede

   // NetUse( <arquivo>, <modo abertura>, <tempo segundos> ) --> lSuccess

   // Otimiza?Æo do original Nantucket
   // Alexandre Santos - 04/01/06 - 15:40 - Implementar o parametro Alias
   //  e verifica?Æo dos parametros de entrada.

   LOCAL lForever , nPos, wsqual

   If Empty( cDatabase )
      Return .F.
   Endif

   lOpenMode := If( Empty( lOpenMode ), DB_SHARED, lOpenMode )
   nSeconds  := If( nSeconds == Nil, 5, nSeconds )
   cAlias    := If( Empty( cAlias ), FileBase( cDataBase ), cAlias )
   //---
   lForever = (nSeconds = 0)

   DO WHILE .T.          // (lForever .OR. nSeconds > 0)
     IF lOpenMode
         USE (cDatabase) EXCLUSIVE NEW Alias (cAlias)
     ELSE
         USE (cDatabase) SHARED NEW Alias (cAlias) // Shared
     ENDIF
     IF .NOT. NETERR()          // USE succeeds
        RETURN (.T.)
     ENDIF

     INKEY(1)                 // Wait 1 second

     nSeconds = nSeconds - 1

     if nSeconds < 0
       If Àlert( "NÆo foi poss¡vel abrir o arquivo " + cDataBase + ".DBF.;" + ;
                     " (Arquivo em manuten?Æo por outro usu rio).;; " + ;
                     "Deseja tentar novamente?", {" Sim "," NÆo " } ) == 2
          Exit
       Endif

       nSeconds := 5

     endif
   ENDDO
   RETURN (.F.)                // USE fails
//------------------------------------------------------------------------------
FUNCTION RecLock( nSeconds )

   // Travamento de registro em rede

   //  RecLock( <tempo segundos> ) --> lSuccess

   IF RLOCK()
      RETURN (.T.)        // Locked
   ENDIF

   nSeconds := If( Empty( nSeconds ), 5, nseconds )

   While .T.
      DO WHILE nSeconds > 0
         IF RLOCK()
            RETURN (.T.)     // Locked
         ENDIF
         INKEY(.5)           // Wait 1/2 second
         nSeconds = nSeconds - .5
      ENDDO

      If Alert( "NÆo foi poss¡vel bloquear registro no arquivo " + Alias() + ".DBF.;" + ;
                    " (Arquivo em manuten?Æo por outro usu rio).;; " + ;
                    "Deseja tentar novamente?", {" Sim "," NÆo " } ) == 2
         Exit
      Endif
      nSeconds := 5
   Enddo

   RETURN (.F.)           // Not locked
//------------------------------------------------------------------------------
*
*  FileBase( <cFile> ) --> cFileBase
*
*  Extract the eight letter base name from a filename
*
*  Copyright Nantucked

// Extrai os nome do arquivo (cFile) fornecido (8 primeiras letras, sem path ou drive)

FUNCTION FileBase( cFile )

   LOCAL nPos           // Marks the position of the last "\", if any
   LOCAL cFileBase      // Return value containing the filename

   DO CASE
   CASE ( nPos := RAT( "\", cFile )) != 0

      // Strip out full path name leaving only the filename (with
      // extension)
      cFileBase := SUBSTR( cFile, nPos + 1 )

   CASE ( nPos := AT( ":", cFile )) != 0

      // Strip drive letter if cFile contains only drive letter
      // no subdirectories
      cFileBase := SUBSTR( cFile, nPos + 1 )

   OTHERWISE

      // Assume it's already taken care of
      cFileBase := cFile

   ENDCASE

   // Strip out the file extension, if any
   IF ( nPos := AT( ".", cFileBase )) != 0
      cFileBase := SUBSTR( cFileBase, 1, nPos - 1 )
   ENDIF

   RETURN ( cFileBase )

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

Espero que ajude. Dúvidas? É só postar.

[]s
AlxSts

[gvc]

Sim, entendí e agradeço sua atenção. Mas se entendí bem, antes de adicionar o registro do arquivo de pedidos, preciso verificar se o mesmo já está cadastrado ou não certo ? Para isso, eu não teria que bloquear o arquivo, para depois dar o dbseek() ? E como o registro do pedido tem que ficar bloqueado para que outros usuarios nao o deletem enquanto eu estiver incluindo itens, eu não poderia bloquear o arquivo para dar o dbseek. Esta é a minha dúvida.

[Ademir]

Vc não precisa bloquear nada para usar o DBSEEK. O bloqueio só é necessário quando vc vai gravar/apagar registro.

Vc pode localizar o Pedido. Se ele não existir, vc cria o registro. Se já existir e vc vai incluir algo na tabela de itens, vc só precisa bloquear o registro de Pedido. Se conseguir bloquear, vc pode incluir itens. Se não conseguir é que já tem alguém usando o Pedido.
Não dá para bloquear o arquivo, pois outros usuários podem estar usando o arquivo de Pedidos.