DBU dentro da aplicação Clipper

[duduluiz]

Bom dia a todos os clippeiros.
Gostaria de pedir uma ajuda.

Aqui na empresa, as pessoas sempre modificam informações em arquivo dbf.
Como somente eu sei utilizar o DBU, pensei em fazer um editor estilo DBU para ser compilado com minha aplicação, onde a pessoa escolhe o arquivo DBF e o meu sistema abra o arquivo para edição, independente das colunas/registros dentro do arquivo.

Assim eu poderia fazer um editor de cadastro dinâmico, que serviria para qualquer arquivo dbf.

Gostaria de saber se alguém já fez isso ou então se existe alguma biblioteca pronta para isso.

Muito obrigado. :xau

[alxsts]

Olá1

Bem-vindo ao fórum duduluiz!

É perfeitamente possível fazer isto. Não sei se já existe algo pronto pois nunca usei esta técnica.

Pessoalmente, nunca usaria pois acho muito perigoso deixar nas mãos de usuários um programa do tipo DBU.

Acho que você deveria fazer um levantamento das necessidades dos usuários e criar programas específicos para fazer as alterações. Tudo com controle de acesso via senha e até um registro de log de alterações.

[rochinha]

Amiguinho,

Se não me engano, nas pastas source do Clipper voce encontra o projeto completo de um DBU.

Este aplicativo foi feito para uso stand-alone e se voce o incorporar em sua aplicação tera um trabalhinho com as variáveis iniciais do mesmo.

Já vi em antigos sistemas em Clipper um recurso como este e é muito interessante mesmo pois facilita a tarefa do suporte de dar o suporte(redundância).

Se me lembro bem, o DBU simula uma tela idêntica ao dBase III, toda negra com um pontinho lá em baixo esperando voce digitar algumas sentenças.

Lógico que as sentenças são básicas mas é possivel fazer muita coisa.

Baixe summer.rar e analise o código fonte do DBU.

[Pablo César]

Seja bem vindo ao fórum, Duduluiz !

Como ja disse o colega, reavalie essa questão de liberar o acesso do DBF para os usuário sem o devido controle. Já ví muitos tópicos aqui no fórum, justamente pedindo o contrário: ímpedir que o usuário possa edita os DBFs. Tem várias formas, encryptar os dados, fazer checagem do hash, esconder o dbf, enfim... mas para efeito de aprendizado, o dominio e utilização do Browse, sempre foi uma caracteristica para implementar nos meu programas sempre de forma muito afortunada. Dá trabalho, dá um pouco mais dá trabalho de entender. Vale a pena. O Rochinha bem disse, veja como os fontes do DBU é composto, realmente muito. Enquanto os colegas respondiam eu estava procurando um antigo Browse genérico que fiz bem no começo, encontrei um que você vai gostar:

Código: Selecionar todos

#include "common.ch"
#include "inkey.ch"

Parameters vdbf
Set Deleted Off
Set Century on
If (vdbf = Nil)
   ?
   ? "Deve ser fornecido nome do arquivo na linha de comando"
   Quit
EndIf
If (!(file(vdbf) .OR. file(vdbf + ".DBF")))
   ?
   ? "Arquivo nao encontrado"
   ?
   Quit
EndIf
Set Date British
Set Color To n/bg
Clear Screen
If (Empty(netname()))
   Use (vdbf)
Else
   Use (vdbf) Shared
EndIf
mybrowse(0, 0, MaxRow() - 1, MaxCol())

********************************
Function SKIPPER(n, lappend)

   Local i
   i:= 0
   If (LastRec() != 0)
      If (n == 0)
         Skip 0
      ElseIf (n > 0 .AND. RecNo() != LastRec() + 1)
         Do While (i < n)
            Skip 
            If (EOF())
               If (lappend)
                  i++
               Else
                  Skip -1
               EndIf
               Exit
            EndIf
            i++
         EndDo
      ElseIf (n < 0)
         Do While (i > n)
            Skip -1
            If (BOF())
               Exit
            EndIf
            i--
         EndDo
      EndIf
   EndIf
   Return i

********************************
Function ORDENA

   don:= RecNo()
   ban:= Trim(dbf())
   Goto Top
   modistru(vdbf)
   Goto Top
   DBEval({ || Field->ordem:= RecNo() }, Nil, Nil, Nil, Nil, .F.)
   Append Blank
   ult:= RecNo()
   Replace ordem With don
   Goto don
   Do While (!EOF())
      don:= don + 1
      Replace ordem With don
      Skip 
      If (RecNo() != ult)
         Exit
      EndIf
   EndDo
   Index On ORDEM To XX
   Copy To ZZ All
   Use ZZ
   Copy To (ban) All
   Use (ban)
   Return Nil

********************************

Function MYBROWSE(ntop, nleft, nbottom, nright)

   Local b, column, ctype, n, cmemo, cmemobuff, ccolorsave, ;
      ncurssave, lmore, nkey, lappend
   b:= tbrowsedb(ntop, nleft, nbottom, nright)
   b:headsep("ÍÑÍ")
   b:colsep(" ³ ")
   b:skipblock({ |x| skipper(x, lappend) })
   b:colorspec("N/W, N/BG, B/W, B/BG, B/W, B/BG, R/W, B/R, R/W*, R/BG*, R/W*, R/BG*,")
   @ MaxRow(),  0
   For n:= 1 To FCount()
      If (ISMEMO(fieldget(n)))
         column:= tbcolumnne(FieldName(n), { || "  <Memo>  " })
      Else
         column:= tbcolumnne(FieldName(n), fieldwbloc(FieldName(n), Select()))
      EndIf
      ctype:= ValType(eval(column:block()))
      If (ctype == "N")
         If (Deleted())
            column:defcolor({11, 12})
         Else
            column:defcolor({5, 6})
         EndIf
         // column:colorbloc({ |x| IIf(x < 0, {7, 8}, {5, 6}) })
      ElseIf (Deleted())
         column:defcolor({9, 10})
      Else
         column:defcolor({3, 4})
      EndIf
      b:addcolumn(column)
   Next
   vpg:= .F.
   ccolorsave:= SetColor("N/N")
   @ ntop + 1, nleft + 1 Clear To nbottom, nright + 1
   Set Color To W/W
   @ ntop, nleft Clear To nbottom, nright
   Set Color To (ccolorsave)
   ncurssave:= setcursor(0)
   lappend:= .F.
   lmore:= .T.
   b:freeze := 1
   Do While (lmore)
      If (b:colpos() <= b:freeze())
         b:colpos(b:freeze() + 1)
      EndIf
      Do While (!b:stabilize())
         nkey:= InKey()
         If (nkey != 0)
            Exit
         EndIf
      EndDo
      If (b:stable())
         If (b:hitbottom() .AND. !lappend)
            lappend:= .T.
            nkey:= 24
         Else
            If (b:hittop() .OR. b:hitbottom())
               tone(125, 0)
            EndIf
            nkey:= InKey(0)
         EndIf
      EndIf
      Do Case
      Case nkey == 28
         vqrec:= RecNo()
         cp:= b:colpos()
         campo:= fieldget(cp)
         If (ValType(campo) = "N")
            cpn:= FieldName(cp)
            xtot:= 0
            DBEval(&("{|| XTOT := XTOT + &CPN}"), Nil, Nil, Nil, Nil, .F.)
            @ nbottom + 1,  0
            vtdr:= field(cp)
            If (vtdr == 0)
               vtd:= ""
            Else
               vtd:= "." + Replicate("9", vtdr)
            EndIf
            @ nbottom + 1,  0 Say padc("Total geral do campo " + cpn + ": " + alltrim(Transform(xtot, ;
               "@E 999,999,999,999,999" + vtd)), 80)
            InKey(0)
            @ nbottom + 1,  0
            Goto vqrec
         EndIf
      Case nkey == -3
           if year(ctod("01/01/00"))=1900
              Set Epoch to 2000
           else
              Set Epoch to 1900
           endif
      Case nkey == -2
           if len(dtoc(date()))=8
              Set Century on
           else
              Set Century off
           endif
           lappend:= .F.
           b:refreshall()
      Case nkey == -1
         cp:= b:colpos()
         campo:= fieldget(cp)
         If (ValType(campo) = "N")
            vr:= cp
            calc(0, 0, vr)
            setcursor(0)
            b:refreshall()
         EndIf
      Case nkey == -20
         If (MaxRow() == 24)
            setmode(43, 80)
            lmore:= .F.
            mybrowse(0, 0, MaxRow() - 1, MaxCol())
         Else
            setmode(25, 80)
            lmore:= .F.
            mybrowse(0, 0, MaxRow() - 1, MaxCol())
         EndIf
      Case nkey == 24
         b:down()
      Case nkey == 5
         b:up()
         If (lappend)
            lappend:= .F.
            b:refreshall()
         EndIf
      Case nkey == 3
         b:pagedown()
      Case nkey == 18
         b:pageup()
         If (lappend)
            lappend:= .F.
            b:refreshall()
         EndIf
      Case nkey == 31
         b:gotop()
         lappend:= .F.
      Case nkey == 30
         b:gobottom()
         lappend:= .F.
      Case nkey == 4
         b:right()
      Case nkey == 19
         b:left()
      Case nkey == 1
         b:home()
      Case nkey == 6
         b:end()
      Case nkey == 7
         RLock()
         Delete
         Unlock
         vpg:= .T.
         Set Deleted On
         lappend:= .F.
         b:refreshall()
      Case nkey == 26
         b:panleft()
      Case nkey == 2
         b:panright()
      Case nkey == 29
         b:panhome()
      Case nkey == 23
         b:panend()
      Case nkey == 27
         lmore:= .F.
         If (vpg = .T.)
            Pack
         EndIf
      Case nkey == 13
         cp:= b:colpos()
         ceditfield:= FieldName(cp)
         If (Type(ceditfield) == "M")
            box_open:= .T.
            cmemobuff:= SaveScreen(10, 10, 22, 69)
            Scroll(10, 10, 22, 69, 0)
            @ 10, 10 To 22, 69
            @ 10, (76 - Len(ceditfield)) / 2 Say "  " + ceditfield + ;
               "  "
            cmemo:= memoedit(&ceditfield, 11, 11, 21, 68, .T., "xmemo")
            If (LastKey() == K_CTRL_END)
               keystroke:= K_RIGHT
               lgotkey:= .T.
            Else
               keystroke:= 0
            EndIf
            RestScreen(10, 10, 22, 69, cmemobuff)
            box_open:= .F.
         Else
            RLock()
            doget(b, lappend)
            Unlock
            If (b:colpos() = n - 1)
               b:panhome()
               b:down()
            Else
               b:right()
            EndIf
         EndIf
      Case nkey == 10
         Use (vdbf) Exclusive
         If (neterr())
            @ nbottom + 1,  0
            @ nbottom + 1, 12 Say ;
               "Este arquivo n„o pode ser aberto agora !!"
            Quit
         EndIf
         ordena()
         Use (vdbf) Shared
         b:refreshall()
      Otherwise
         Keyboard Chr(nkey)
         RLock()
         doget(b, lappend)
         Unlock
         If (b:colpos() = n - 1)
            b:panhome()
            b:down()
         Else
            b:right()
         EndIf
      EndCase
   EndDo
   setcursor(ncurssave)
   Return .T.

********************************

Function DOGET(b, lappend)

   Local binssave, lscoresave, lexitsave, column, get, nkey
   Do While (!b:stabilize())
   EndDo
   If (lappend .AND. RecNo() == LastRec() + 1)
      Append Blank
   EndIf
   lscoresave:= Set(_SET_SCOREBOARD, .F.)
   lexitsave:= Set(_SET_EXIT, .T.)
   binssave:= SetKey(K_INS)
   SetKey(K_INS, { || setcursor(IIf(readinsert(!readinsert()), 1, 2)) })
   setcursor(IIf(readinsert(), 2, 1))
   column:= b:getcolumn(b:colpos())
   get:= getnew(Row(), Col(), column:block(), column:heading(), Nil, b:colorspec())
   ReadModal({get})
   setcursor(0)
   Set Scoreboard (lscoresave)
   Set(_SET_EXIT, lexitsave)
   SetKey(K_INS, binssave)
   b:refreshcur()
   nkey:= LastKey()
   If (nkey == 5 .OR. nkey == 24 .OR. nkey == 18 .OR. nkey == 3)
      Keyboard Chr(nkey)
   EndIf
   Return Nil

********************************

Function MODISTRU(zarq)

   zncamp:= FCount()
   Private zcampos[zncamp], ztipo[zncamp], ztam[zncamp], zdec[zncamp]
   afields(zcampos, ztipo, ztam, zdec)
   t:= Len(alltrim(Str(LastRec())))
   Create ARQTMP1
   Use ARQTMP1
   @ MaxRow() + 1,  0 Say padc("Aguarde, criando nova estrutura...", ;
      80)
   Append Blank
   Replace field_name With "ORDEM"
   Replace field_type With "N"
   Replace field_len With t
   Replace field_dec With 0
   For a:= 1 To zncamp
      Append Blank
      Replace field_name With zcampos[a]
      Replace field_type With ztipo[a]
      Replace field_len With ztam[a]
      Replace field_dec With zdec[a]
   Next
   @ MaxRow() + 1,  0 Say padc("Aguarde, salvando registros...", 80)
   Create ARQTMP2 From ARQTMP1
   Close Databases
   Use ARQTMP2
   Append From (zarq) All
   Close Databases
   Erase (zarq + ".DBF")
   Rename ARQTMP2.DBF To (zarq + ".DBF")
   Erase ARQTMP1.DBF
   @ MaxRow() + 1,  5 Say Space(50)
   Use (zarq)
   Return Nil

********************************

Function CALC(mx, my, vr)

   vx:= Row()
   vy:= Col()
   vc_cor:= SetColor()
   vca_tela:= SaveScreen(mx + 0, my + 53, mx + 14, my + 79)
   setcursor(0)
   Set Color To /W
   @ mx + 1, my + 54 Clear To mx + 13, my + 78
   Set Color To RB/W
   @ 2 + mx, 55 + my Say Replicate("Ü", 23)
   @ 3 + mx, 55 + my Say "Û" + Space(21) + "Û"
   @ 4 + mx, 55 + my Say Replicate("ß", 23)
   Set Color To N/W
   @ 0 + mx, 53 + my To 14 + mx, 79 + my Double
   Set Color To N/BG
   @ 6 + mx, 55 + my Say " 7 "
   @ 6 + mx, 60 + my Say " 8 "
   @ 6 + mx, 65 + my Say " 9 "
   @ 8 + mx, 55 + my Say " 4 "
   @ 8 + mx, 60 + my Say " 5 "
   @ 8 + mx, 65 + my Say " 6 "
   @ 10 + mx, 55 + my Say " 1 "
   @ 10 + mx, 60 + my Say " 2 "
   @ 10 + mx, 65 + my Say " 3 "
   @ 12 + mx, 55 + my Say " 0 "
   @ 12 + mx, 60 + my Say " . "
   Set Color To W/B
   @ 6 + mx, my + 70 Say " - "
   @ 12 + mx, my + 75 Say " % "
   @ 8 + mx, my + 70 Say " + "
   @ 8 + mx, my + 75 Say " * "
   @ 10 + mx, my + 75 Say " / "
   Set Color To W/R
   @ 10 + mx, my + 70 Say " = "
   @ 12 + mx, 65 + my Say " T "
   @ 12 + mx, my + 70 Say " I "
   @ 6 + mx, my + 75 Say "C/E"
   vc_result:= 0
   vc_alga:= Space(14)
   vc_dec:= ""
   vc_dig:= Chr(0)
   vc_var:= "VC_ALGA"
   vc_verdad:= .F.
   Set Color To W
   @ 3 + mx, 56 + my Say " " + Str(vc_result, 19, 4) + " "
   vc_uoper:= ""
   vc_perc:= " "
   Do While (vc_dig != "")
      vc_dig:= Chr(InKey(0))
      If (At(vc_dig, Chr(26) + "‘") != 0)
         vmov_tela:= SaveScreen(mx + 0, my + 53, mx + 14, my + 79)
         RestScreen(mx + 0, my + 53, mx + 14, my + 79, vca_tela)
         Do Case
         Case vc_dig = Chr(26)
            my:= my - 1
         Case vc_dig = ""
            my:= my + 1
         Case vc_dig = ""
            mx:= mx - 1
         Case vc_dig = "‘"
            mx:= mx + 1
         EndCase
         Do Case
         Case mx + 0 < 0
            mx:= 0
         Case mx + 14 > 24
            mx:= 10
         Case my + 53 < 0
            my:= -53
         Case my + 79 > 79
            my:= 0
         EndCase
         vca_tela:= SaveScreen(mx + 0, my + 53, mx + 14, my + 79)
         RestScreen(mx + 0, my + 53, mx + 14, my + 79, vmov_tela)
      EndIf
      If (vc_dig = "")
         Save Screen To tela4
         Set Color To W+/B
         @  0,  0 To 21, 79
         @  0, 22 Say " Teclas de Controle da Calculadora "
         Set Color To W+/N
         texto:= memoread("CALCULA.HLP")
         memoedit(texto, 1, 1, 20, 78, .F., "CONTROLA")
         Restore Screen From tela4
      EndIf
      If (vc_dig = "")
         Exit
      EndIf
      vc_xx:= At(vc_dig, "L")
      If (vc_xx != 0)
         vc_dig:= SubStr("0.123456789", vc_xx, 1)
      EndIf
      vc_var:= IIf(vc_dig = ".", "VC_DEC", vc_var)
      vc_alga:= IIf(vc_dig = "." .AND. vc_alga = Space(14), ;
         Space(13) + "0", vc_alga)
      Do Case
      Case vc_dig = "%"
         If (vc_verdad)
            vc_perc:= IIf(vc_perc = "%", " ", "%")
            Set Color To /RB
            @ 3 + mx, 77 + my Say vc_perc
            Set Color To W
         Else
            @ 3 + mx, 57 + my Say Space(13) + "0.0000"
         EndIf
      Case vc_dig $ "0123456789" .AND. Len(LTrim(&vc_var)) != ;
            IIf(vc_var = "VC_DEC", 4, 14)
         &vc_var:= IIf(vc_var = "VC_DEC", &vc_var + vc_dig, ;
            SubStr(&vc_var + vc_dig, 2))
         @ 3 + mx, 57 + my Say vc_alga + "." + SubStr(vc_dec + ;
            SubStr("00000", Len(vc_dec) + 1), 1, 4)
         vc_verdad:= IIf(vc_verdad .AND. vc_uoper $ "=" + Chr(13), ;
            .F., vc_verdad)
      Case vc_dig $ "+-/*=" + Chr(13)
         If (vc_verdad)
            If (Val(vc_alga + "." + vc_dec) != 0)
               If (vc_perc = "%")
                  vope_ra:= Str(vc_result, 19, 4) + vc_uoper + "(" + ;
                     Str(vc_result, 19, 4) + "*" + vc_alga + "." + ;
                     SubStr(vc_dec + SubStr("00000", Len(vc_dec) + ;
                     1), 1, 4) + ")/100.000"
               Else
                  vope_ra:= Str(vc_result, 19, 4) + vc_uoper + ;
                     vc_alga + "." + SubStr(vc_dec + SubStr("00000", ;
                     Len(vc_dec) + 1), 1, 4)
               EndIf
               vc_result:= &vope_ra
               @ 3 + mx, 57 + my Say Str(vc_result, 19, 4)
            EndIf
         ElseIf (vc_dig $ "+-/*")
            vc_verdad:= .T.
            vc_result:= Val(vc_alga + "." + vc_dec)
         EndIf
         Set Color To N/RB
         @ 3 + mx, 55 + my Say IIf(vc_dig $ "+-/*", vc_dig, " ")
         @ 3 + mx, 77 + my Say " "
         Set Color To W
         vc_var:= "VC_ALGA"
         vc_alga:= Space(14)
         vc_dec:= ""
         vc_uoper:= vc_dig
         vc_perc:= " "
      Case vc_dig $ "Ii"
         vc_verdad:= .T.
         vc_result:= fieldget(vr)
         @ 3 + mx, 57 + my Say Str(vc_result, 19, 4)
      Case vc_dig $ "Tt"
         nvalor:= vc_result
         vtr:= fieldsize(vr)
         vtdr:= field(vr)
         vtami:= vtr - vtdr
         If (vtdr > 0)
            vtam:= Replicate("9", vtami - 1) + "." + Replicate("9", ;
               vtdr)
         Else
            vtam:= Replicate("9", vtami)
         EndIf
         If (nvalor <= Val(vtam))
            RLock()
            fieldput(vr, nvalor)
            Unlock
         EndIf
         Exit
      Case vc_dig $ "EeCc"
         vc_var:= "VC_ALGA"
         vc_alga:= Space(14)
         vc_dec:= ""
         vc_perc:= " "
         If (vc_dig $ "Cc")
            vc_verdad:= .F.
            Set Color To N/RB
            @ 3 + mx, 55 + my Say " "
            @ 3 + mx, 77 + my Say " "
            Set Color To W
         EndIf
         @ 3 + mx, 57 + my Say Space(13) + "0.0000"
      EndCase
   EndDo
   Set Color To (vc_cor)
   RestScreen(0 + mx, 53 + my, 14 + mx, 79 + my, vca_tela)
   setcursor(1)
   @ vx, vy Say ""
   Return Nil

* EOF

Você vai precisar compilar junto com a CT.LIB. Boa sorte e tiver dúvidas pode posta-las aqui no fórum que iremos ajudá-lo.

[alxsts]

Olá!

Se me lembro bem, o DBU simula uma tela idêntica ao dBase III, toda negra com um pontinho lá em baixo esperando voce digitar algumas sentenças.

Este é o Dot.Prg, que veio com os exemplos do Clipper 5. Ele simula o dot prompt do dBase, onde se pode digitar os comandos e executar funções. Nossa! nem me lembrava mais disso....

[rochinha]

Amiguinhos,

Hehehe, tá vendo só, não sou o único das antigas na parada.

Inclusive o código dele tá dentro do arquivo que disponibilizei.

[duduluiz]

Senhores, obrigado a Pablo César, rochinha e alxsts.
Agradeço as dicas.

Grande abraço e obrigado.

[billy1943]

Colocar o DBU dentro de uma aplicação em Clipper é bastante temerário.

Você pode colocar um browse() ou dbedit() para que os operadores mais responsáveis possam trabalhar com os dados mais facilmente.

Agora, se você quiser permitir que os usuários do sistema criem novos campos ou alterem os já existentes, existem duas formas, entre outras, que podem ser adotadas:

1. Dicionário de dados
- consiste num banco de dados com uma estrutura onde constam todos os arquivos .DBF do sistema, com seus nomes, localização, e todos os campos dos mesmos;
- havendo alguma alteração em algum campo, ou necessidade de incluir novos campos, basta você enviar esse arquivo para o cliente e o sistema se incumbe de alterá-lo automaticamente comparando a estrutura atual com a informada pelo dicionário
- permitirá também incluir novos arquivos de modo totalmente transparente para o usuário

2. Manutenção dos campos de arquivos de forma on-line
Uma vez informado o arquivo, por operadores autorizados ou pelo próprio analista, consiste em:
- cria uma matriz com todos os campos atualmente existentes
- solicita informação sobre novo campo a criar com seu nome, tipo, tamanho e decimais
- verifica também a necessidade alterar ou excluir algum campo
- cria uma nova estrutura com essa nova matriz alterada
- transfere para o arquivo ora criado os dados do arquivo original

Essas são as ideias com as quais eu trabalho para resolver o assunto deste tópico.