Harbour (ou xHarbour) BASICO com MYSQL

[manuel1437]

Meus Caros

Ainda estou na luta para trabalhar com Harbour ou xHarbour ...

O amigo Claudio mandou um exemplo para compilar um programa simples do Clipper. Mas preciso da ajuda de vocês.

O programa aborda conceitos. Não faz parte de qualquer "solução" pré-existente. Eu montei um exemplo anexo, em Clipper, na sua forma mais simples para facilitar o aprendizado:
usando dois arquivos dbf
abertura de arquivos, uso de índices (se necessário)
com campos character, numeric com duas ou três casas e com cálculo de com campos data
uma rotina de consulta simples usando o dbedit
comandos de inclusão, alteração, exclusão, pesquisa
utilizacao de lnk para compilar varios prg

Gostaria de saber se alguém já tem experiencia usando o modo caracter (janela DOS) com mysql remoto, num servidor qualquer.
É o inicio de tudo: MODO CARACTER usando MYSQL

Imagino que o Executável fique numa pasta c:\sistemas e, alimente uma base MYSQL localizado na nuvem, em qualquer lugar do mundo.
Neste primeiro momento, não penso no ambiente gráfico. Sei que existem várias opções e até mesmo poderíamos aproveitar este modelo para facilitar comparação entre elas.

Aliás, a título de curiosidade: eu poderia usar o MYSQL e trabalhar junto com alguns DBF localizados em c:\sistemas ?
Explico: utilizo alguns dbf's temporários para preparar bases para relatorios - estaria lendo MYSQL e gravando em DBF temporário para depois fazer o trabalho da impressão

A sugestão é copiar o programa lote01.prg para lote02.prg e substituir o que é necessario para criar este cenário Caracter-MYSQL. É um modelo pequeno, mas que traz as principais rotinas que precisamos no dia-a-dia.

Com isto, poderemos ter tutoriais para cada um dos cenários que o Harbour ou xHarbour possibilita, incluindo interface gráfica, mouse, mysql ou outro bd, permitindo que mais pessoas se aventurem rapidamente neste universo. A partir disto, acredito que cada um buscará o seu próprio caminho, aprofundando o conhecimento.

Com o mesmo desafio para cada "combo", o usuario podera optar pelo que entender ser mais interessante para seu proprio uso.

De alguma forma, é o velho ACME.

Abraços, e obrigado pela compreensão. Tenho pesquisado a literatura e já li até sobre a aplicação funcionar como CGI - é preciso focar um pouco para não se perder diante de tantas possibilidades e avançar mais rapidamente. Entao, vamos partir do modelo mais basico possivel.

Abracos

Manuel

Toledo: obrigado pelo retorno por email.

[JoséQuintas]

Banco de dados não tem nada a ver com tela.
Se acompanhou meu post, estou fazendo justamente isso: DBF + MySQL ao mesmo tempo, até terminar.

Sei que não vai gostar de ler isto, mas:
Um primeiro trabalho seria melhorar os fontes, mesmo pra DBF e mesmo pra Clipper.
Isto não tem nada a ver com o fonte estar certo ou errado, ou de funcionar ou não.

Aliás, usar como exemplo pra uma coisa que falo várias vezes no fórum:
Dá pra programar pra Harbour usando o próprio Clipper.

1. Uma coisa é fazer o programa funcionar compilando com Harbour.
2. Outra coisa é melhorar o fonte, pra tornar fácil qualquer mudança.
3. E a última é acrescentar recursos.

Se puder fazer tudo de uma vez melhor, senão, uma etapa de cada vez facilita a outra.

Uma coisa que reparei:
A consulta usa um TBROWSE, com opção de mudar a ordem.
Isso vai precisar de uma rotina diferente de um relatório com as mesmas opções, e vai sempre precisar do arquivo inteiro.
Talvez não seja uma boa opção pra forma didática.
Num caso desses, minha escolha seria criar um arquivo temporário a partir da base MySQL, o que resultaria na mesma rotina de navegação.

[JoséQuintas]

Vamos lá... primeira etapa....
Aqui não funciona Clipper, porque meu Windows é 64 bits, então fui direto pro Harbour.

O compila.bat tem muitas linhas, e tem o compila.lnk em separado.
Poderia ser reduzido pra:

Código: Selecionar todos

clipper lote01
clipper c_lote
rtlink fi lote01, c_lote

No caso do Harbour, compilei usando isto:

Código: Selecionar todos

hbmk2 lote01, c_lote

foi de primeira.

Já se vê diferença. Na tela, aonde mostra memória disponível, apareceu 4.194.303 kb (4GB).
Provavelmente no Clipper mostre 640kb ou algo próximo, ou com Blinker 16.000kb.
Significa que memória deixou de ser problema.

Rodei direto o exemplo.
No primeiro teste, tive que usar Alt-C pra sair, porque não vi como sair.
Vai precisar algo mais no Harbour, porque usou meu default de 1.000 linhas de altura, e fica ruim de enxergar a tela.

[JoséQuintas]

Me chamou a atenção isto:

Código: Selecionar todos

func datavol4                    // Funcao: Converte AAAAMMDD para dd/mm/aaaa
   * para chamar esta rotina:
   *        variavel = datavol4(campo texto no formato aaaammdd)
   *        a variavel acabou de ser criada como data
   *        deixar sempre SET CENTURY ON - trabalhar com 4 casas no ano
   *        quando gravar, utilizar DTOS(variavel data)
   *        portanto, no DBF o campo data sera TEXTO de 8 posicoes

   set century on
   parameters wdv_data
   w_data_dv = ctod(subst(wdv_data,7,2)+"/"+subst(wdv_data,5,2)+"/"+subst(wdv_data,1,4))

return (w_data_dv)

Não era mais fácil usar campo Date no DBF? Campo Date grava ano com 4 dígitos, e no DBF seriam usados os mesmos 8 caracteres.

Ok, tudo bem.
Considere que são mais coisas que podem ser melhoradas, não importa se é Clipper, Harbour, ou MySQL.
Se usar formato diferente, vai ter que fazer rotinas especiais, em Clipper, Harbour e pode se complicar no MySQL, ou deixar de aproveitar recursos.

Ao usar SET CENTURY ON, as datas aparecem com 4 dígitos na tela.
Isto é somente pra tela. No banco de dados sempre é gravado com 4 dígitos.

SET EPOCH TO 1920
Este é um comando pra definir um default.
Caso sejam digitados apenas 2 dígitos na data, o Clipper/Harbour vai considerar a partir de 1920.
Se digitar 21/05/15, o Clipper considera como sendo ano 2015.
Se digitar 21/05/21, o Clipper considera como sendo ano 1921.
É pra isso que serve o SET EPOCH.

Isso reforça mais ainda:
Dá pra converter pra Harbour usando o próprio Clipper.
Esta é uma mudança que poderia ser feita usando o próprio Clipper.

Porque repito isso:
Tem gente apanhando pra ir pro Harbour, ou pra usar LIB gráfica.
Tudo bem, não tenha pressa, pode ir adiantando o serviço usando Clipper.
Pode ir melhorando o fonte, e depois fica até mais fácil.
Vai melhorando o fonte, e se não compila agora, é possível que compile depois tranquilamente.

Aconteceu comigo de aprender coisas do Clipper que não conhecia antes.
Melhorar o fonte é mais importante do que qualquer outra coisa.

Isso vira um vício, então procure fazer do melhor jeito, pra não se viciar em algo que complique.

Na prática:
Ao invés do sentimento de não conseguir no Harbour, vai ter um sentimento de "estou melhorando cada vez mais".
Parece que não, mas isso faz diferença.

Não conseguir no Harbour, vai te deixar desanimado pra continuar. É só tristeza.
Melhorar os fontes, vai te deixar animado em melhorar cada vez mais. É só alegria.
Então... trabalhe com alegria.
E um testezinho no Harbour de vez em quando, não vai tirar a alegria.
Vai estar sempre indo em frente e melhorando.

Vou mostrar o fonte LOTE01.PRG sendo alterado, com o objetivo de demonstrar essa "alegria" em melhorar o fonte.
Já funcionou em Harbour, melhor ainda, mas vou me limitar ao Clipper, até ficar do "meu jeito".
Talvez alguns só entendam o que estou querendo dizer no fonte final.
Mas vou chegar aonde quer, tenha paciência.

[JoséQuintas]

Começar pelo fonte original, tirando as anotações do MySQL.
É grande (na postagem) quase 350 linhas:

Código: Selecionar todos

clear

********************************************
@ 07,59 say "CLIPPER BASICO"

@ 03,01 say "PROC01 Clipper               ³"
@ 04,01 say "                             ³"
@ 05,01 say "PROC11 Harbour Local  DBF    ³"
@ 06,01 say "PROC12 Harbour Remoto DBF    ³"
@ 07,01 say "PROC13 Harbour Remoto MYSQL  ³"
@ 08,01 say "                             ³"
@ 09,01 say "PROC21 xHarbour Local  DBF   ³"
@ 10,01 say "PROC22 xHarbour Remoto DBF   ³"
@ 11,01 say "PROC23 xHarbour Remoto MYSQL ³"
@ 12,01 say "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"

@ 16,01 say "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
@ 17,01 say "- Testando os campos b sicos ³"
@ 18,01 say "- C lculo de Data + Dias     ³"
@ 19,01 say "- Inclus„o/Altera‡„o/Exclus„o³"
@ 20,01 say "- Uso DbEdit para Consulta   ³"
@ 21,01 say "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"

******************************************************************
******************************************************************
* CLIPPER
******************************************************************
******************************************************************

***************************************************** TELA E SET BASICO
   set date brit
   set epoch to 2001
   set delete on
   @ 02,01 to 02,80
   @ 23,01 to 23,80
   set color to w/b
      @ 01,01 say space(80)
      @ 01,01 say "LOTES - Aprendizado Harbour e xHarbour"
      @ 01,70 say date()
   set color to w/n
   memoria = memory()
   @ 03,54 say memory() pict "9,999,999,999"
   @ 03,68 say "Kb Mem¢ria"
   dc = " "

***************************************************** ABERTURA DE ARQUIVOS
   sele a
      use lotes alias lotes
         index on lote                                to ilote1
         index on estado+lote+dt_entrada              to ilote2
         index on dt_entrada+lote                     to ilote3
         index on dt_saida+lote                       to ilote4
      set index to ilote1, ilote2, ilote3, ilote4
      go top
      set order to 1
   sele b
      use estado alias estado
         index on sigla_uf                            to iuf1
      go top
      set order to 1

***************************************************** OPERACAO
   wlote       = space(07)
   westado     = space(02)
   wdt_entrada = datavol4(space(08))
   wdias       = 0
   wdt_saida   = datavol4(space(08))
   wqtde       = 0
   wvlr_unit   = 0
   wvlr_total  = 0

   do while .t.

      msg_1 ( "Informe o LOTE                              [branco] finaliza" )
      @ 09,34 say "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
      @ 10,34 say "³ Lote....: °°°°°°          ? Pesquisa ³"
      @ 11,34 say "³                                      ³"
      @ 12,34 say "³ Estado..: °° °°°°°°°°°°°°°°°°°°°     ³"
      @ 13,34 say "³                                      ³"
      @ 14,34 say "³   Entrada       Dias     Devolu‡„o   ³"
      @ 15,34 say "³ ÄÄÄÄÄÄÄÄÄÄ      ÄÄÄÄ    ÄÄÄÄÄÄÄÄÄÄ   ³"
      @ 16,34 say "³ °°/°°/°°°°   +  °°°°  = °°/°°/°°°°   ³"
      @ 17,34 say "³                                      ³"
      @ 18,34 say "³    Qtde      Unit rio    Valor Total ³"
      @ 19,34 say "³ ÄÄÄÄÄÄÄÄÄ   ÄÄÄÄÄÄÄÄÄ   ÄÄÄÄÄÄÄÄÄÄÄÄ ³"
      @ 20,34 say "³ °°°°°°°°° x °°°°°.°°° = °°°°°°°°°.°° ³"
      @ 21,34 say "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
      @ 22,34 say "                                        "

      @ 10,46 get wlote pict "@!"
      read
      if wlote = " "
         clear
         return
      endif
      if wlote = "?"
         consulta()
         loop
      endif

      ******************************* consulta
      sele lotes
         set order to 1
         go top
      seek (wlote)

      if .not. eof()
         westado     = estado
         wdt_entrada = datavol4(dt_entrada)
         wdias       = dias
         wdt_saida   = datavol4(dt_saida)
         wqtde       = qtde
         wvlr_unit   = vlr_unit
         wvlr_total  = vlr_total

         set color to g+/n
            @ 12,46 say westado
            @ 16,36 say wdt_entrada
            @ 16,52 say wdias        pict "9999"
            @ 16,60 say wdt_saida
            @ 20,36 say wqtde        pict "9,999.999"
            @ 20,48 say wvlr_unit    pict "9,999.999"
            @ 20,60 say wvlr_total   pict "9,999,999.99"
            sele estado
               set order to 1
               go top
            seek (westado)
            if eof()
               alert ( "Erro - deveria existir o ESTADO" )
            else
               @ 12,49 say estado
            endif
            sele lotes
         set color to w/n

         msg_1 ( "Registro existente. Deseja Alterar, Excluir ou Voltar ? ... A/E/V ..." )
         @ 24,73 get dc pict "!" valid dc $ "AEV"
         read
         if upper(dc) = "V"
            loop
         elseif upper(dc) = "A"
            woquefazer = "ALT"
         elseif upper(dc) = "E"
            woquefazer = "EXC"
         endif
      else
         woquefazer = "INC"
      endif

      ******************************* exclusao
      if woquefazer = "EXC"
         msg_3 ( "Confirma a exclus„o do Lote " + rtrim(wlote) + " ? ... S/N ..." )
         if upper(dc) = "S"
            sele lotes
               set order to 1
               go top
            seek (wlote)
            if eof()
               alert ( "Erro - chamar CPD - registro n„o existe mais" )
            else
               delete
            endif
         endif
         loop
      endif

      ******************************* inclusao e alteracao
      set color to g+/n
         if woquefazer = "INC"
            @ 22,35 say "Registro Novo"
         elseif woquefazer = "ALT"
            @ 22,35 say "Edi‡„o de Registro"
         endif
      set color to w/n

      pede_campo = "01"
      preenche = "S"
      do while preenche = "S"

         if pede_campo = "01"
            msg_1 ( "Informe o ESTADO                            [branco] abandona" )
            @ 12,46 get westado pict "@!"
            read
            if westado = " "
               msg_3 ( "Deseja abandonar este registro ? ... S/N ..." )
               if upper(dc) = "S"
                  preenche = "ABANDONA"
               endif
               loop
            endif

            sele estado
               set order to 1
               go top
               seek (westado)
            if eof()
               alert ( "Estado n„o encontrado" )
               loop
            else
               set color to g+/n
                  @ 12,49 say estado
               set color to w/n
            endif
            pede_campo = "02"
         endif

         if pede_campo = "02"
            msg_1 ( "Informe a Data de Entrada                   [branco] retorna campo anterior" )
            @ 16,36 get wdt_entrada
            read
            if dtos(wdt_entrada) = space(08)
               pede_campo = "01"
            elseif wdt_entrada > date() .or. dtos(wdt_entrada) < "20150101"
               loop
            else
               pede_campo = "03"
            endif
         endif

         if pede_campo = "03"
            msg_1 ( "Informe o prazo em DIAS para devolu‡„o do lote" )
            @ 16,52 get wdias        pict "9999" valid wdias > 0
            read

            * calcula wdt_saida
            wdt_saida = wdt_entrada + wdias
            set color to g+/n
              @ 16,60 say wdt_saida
            set color to w/n
            pede_campo = "04"
         endif

         if pede_campo = "04"
            msg_1 ( "Informe a Quantidade e Pre‡o Unit rio         [zero] retorna campo anterior" )
            @ 20,36 get wqtde                pict "9,999.999" valid wqtde >= 0
            @ 20,48 get wvlr_unit            pict "9,999.999" valid wvlr_unit >= 0
            read

            if wqtde = 0
               pede_campo = "02"
            else
               * calcula wvlr_total
               wvlr_total = wqtde * wvlr_unit
               set color to g+/n
                  @ 20,60 say wvlr_total        pict "9,999,999.99"
               set color to w/n
               pede_campo = "CONFIRMA_DADOS"
            endif
         endif

         if pede_campo = "CONFIRMA_DADOS"
            msg_3 ( "Confirma os dados ? ... S/N ..." )
            if upper(dc) = "S"
               preenche = "DADOS_OK"
            else
               msg_3 ( "Deseja continuar neste registro ? ... S/N ..." )
               if upper(dc) = "S"
                  pede_campo = "01"
                  loop
               endif
               preenche = "ABANDONA"
            endif
         endif
      enddo

      if preenche = "DADOS_OK"
         if woquefazer = "INC"
            sele lotes
            go bottom
            append blank
         elseif woquefazer = "ALT"
            sele lotes
               set order to 1
               go top
            seek (wlote)
            if eof()
               alert ( "Erro - chamar CPD - registro n„o existe mais" )
               loop
            endif
         endif
         rlock()
            replace lote         with wlote
            replace estado       with westado
            replace dt_entrada   with dtos(wdt_entrada)
            replace dias         with wdias
            replace dt_saida     with dtos(wdt_saida)
            replace qtde         with wqtde
            replace vlr_unit     with wvlr_unit
            replace vlr_total    with wvlr_total
         unlock
      endif
   enddo

*****************************************************************************
*****************************************************************************
proc msg_1 (w_msg)                  // Procedure: Mensagem Sistema SEM parada

   set color to w/n
      @ 24,01 say space(80)
   set color to gr+/n
      @ 24,03 say w_msg
   set color to w/n

return

*****************************************************************************
*****************************************************************************
proc msg_2 (w_msg)                  // Procedure: Mensagem Sistema COM parada

   set color to w/n
      @ 24,01 say space(80)
   set color to gr+/n
      @ 24,03 say w_msg
      inkey(0)
   set color to w/n
      @ 24,01 say space(80)            // Limpa apos a exibicao da mensagem

return

*****************************************************************************
*****************************************************************************
proc msg_3 (w_msg)                         // Procedure: Mensagem Com Retorno
                                           //          : SIM ou NAO
   set color to w/n
      @ 24,01 say space(80)
   set color to gr+/n
      dc = " "
      @ 24,03 say w_msg get dc pict "!" valid dc $ "SNsn"
      read
   set color to w/n
      @ 24,01 say space(80)            // Limpa apos a exibicao da mensagem

return

*****************************************************************************
*****************************************************************************
func datavol4                    // Funcao: Converte AAAAMMDD para dd/mm/aaaa
   * para chamar esta rotina:
   *        variavel = datavol4(campo texto no formato aaaammdd)
   *        a variavel acabou de ser criada como data
   *        deixar sempre SET CENTURY ON - trabalhar com 4 casas no ano
   *        quando gravar, utilizar DTOS(variavel data)
   *        portanto, no DBF o campo data sera TEXTO de 8 posicoes

   set century on
   parameters wdv_data
   w_data_dv = ctod(subst(wdv_data,7,2)+"/"+subst(wdv_data,5,2)+"/"+subst(wdv_data,1,4))

return (w_data_dv)

[manuel1437]

Caro José Quintas

Obrigado pelas respostas. O exemplo que montei, na verdade, visava ser o mais direto e linear possível, sem usar muitas funções, com o uso de muitas variáveis e algumas rotinas que devem ser condensadas através de boas técnicas de programação. Eu sabia que haveria a liberação da memória, por isso coloquei aquele memory() ali para mostrar o tamanho do ganho (aliás, num computador em que testei tinha.. 70kb de memória livre, rs).

A consulta usando o dbedit foi a última coisa que resolvi colocar, até para aproveitar para ter dois prg e assim usar um @lnk - claro que o sistema não se resolveria em dois prg (tenho sistema com mais de 250 prg, mesmo usando funções), de modo que fazer tudo numa única linha seria inviável (dai o questionamento sobre o lnk). Para falar a verdade, se tem algo que raramente uso é o dbedit - aqui eu padronizei gerar o relatorio tanto para impressora quanto para tela (que na verdade é a impressão para um arquivo padrao.txt e a visualização com um pequeno programa dos chamado lis.com, que permite exibir arquivos monstruosos com rapidez e alguns recursos). Certamente com o SQL não tem porque trafegar toda a base de dados (seria uma loucura,rs).

Você tem razão, a tela (caracter ou gráfica) não tem nada a ver com banco de dados. Mas a intenção inicial era continuar no ambiente caracter, porém acessando um mysql instalado remotamente, pois neste caso o primeiro aprendizado seria muito mais rápido e, inclusive, permitiria soluções urgentes para atender demandas de vida curta. Na segunda etapa, partiria para conhecer alguma ferramenta gráfica. Por isso que enfatizei o começo pela tela caracter + mysql.

Sobre as 1000 linhas, eu vi que existe um setmode() para criar a janela dos com um tamanho diferente do velho padrão 25x80. E o programinha tem como porta de saída deixar o campo lote em branco. Se branco, fim de programa. Ao longo do tempo, cansei de dar suporte em sistemas que usavam um fonte para inclusão, e outro para alteração do registro. Se mudasse uma regra, teria que alterá-la nos dois programas. Do jeito que montei o lote01.prg, altero esta regra uma única vez.

Mais uma vez, agradeço seu retorno. Tenho convivido com sistemas antigos ao longo destes últimos anos - para você ter idéia, dou suporte em uma plataforma chamada Superbase IV, software com banco de dados proprietário com telas gráficas que funcionam até no Windows 3.11, com algumas instruções SQL que convivem com modo linear de programação. Fiquei muito pra trás... já mexi alguma coisa com PHP, ASP ... mas confesso que faço (do meu jeito) com o velho Clipper coisas que não consigo fazer com as outras linguagens. Dai a resistência fica ainda maior. Hoje, eu me sentiria feliz em trocar o DBF pelo MYSQL num servidor lá do Japão, mesmo sabendo que tem muitas outras ferramentas. Um passo de cada vez...

Não sei se perdi alguma coisa, mas você escreveu "Se acompanhou meu post, estou fazendo justamente isso: DBF + MySQL ao mesmo tempo, até terminar." ... faltou um post ? Perdão, se puder postar o lote02.prg fazendo este tipo de acesso, é o ponto de partida que preciso para entrar no mundo Harbour.

Grande Abraço **** acabei de ver que ja postou mais duas mensagens, vou ler e responde-las imediatamente.

Manuel

[manuel1437]

José Quintas

Eu tinha certeza de que alguém iria questionar porque não utilizar campos DATA no DBF para armazenar Datas ... é o óbvio! Sim, é verdade.

Mas a gente aprende na porrada, e se a solução dá certo, se acostumamos a ela. Quando rodava na velha Novell 3.11, eu tinha muitos, mas muitos mesmo, problemas com Corruption Detected. E isto acontecia com menor frequência (mas acontecia) com instalações na própria máquina. Descobri que 99,9% dos meus problemas aconteciam com índices compostos que usavam campos data..

Com índices string+str(valor) eu não tinha problemas
Com índices string+dtoc() ou string+dtos() ... dava CORRUPTION DETECTED.

No momento em que comecei a guardar no BD a data no formato string, usado DTOS() - ACABOU O PROBLEMA !!!! Eu posso afirmar que aquele 0,1% de corrupcao de índices está ligado a queda de energia ou então porque houve transporte de arquivos DBF sem apagar e recriar os índices. Este problema não acontecerá num MYSQl ...

Meus sistemas fazem get com 2 dígitos no ano, e fazia sentido fazer a dobradinha na virada do milênio, rs ...

Agradeço sua atenção, e o objetivo é justamente o de quebrar barreiras. Um passo de cada vez... tenho absoluta certeza que vamos desprezar muita coisa do fonte "original", mas esta transformação é interessante. Vou evoluir.

Obrigado

Manuel

[JoséQuintas]

Esquisito isso de erro em índice com data.
Na Novell 3.11 tinha um bug que se ficasse mais de 1 semana no ar, o DBF acusava um registro a mais, dava erro em APPEND e provavelmente em índice.
Mas juntando isso da Novell com o fonte usando PROCEDURE, provavelmente esse fonte vém desde antes de existir o Clipper 5.
Antes não existia FUNCTION, e nem sei se eles estavam preparados para o ano 2000, então a opção da época seria fazer algo assim.

Seguindo...
Isto é só pra reduzir os próximos posts. Separei duas partes em função.
Já formatei... como comentei... virou vício.

Esta não vai mudar. Mostra dados na tela. Então já não vou repetir nos próximos.

Código: Selecionar todos

STATIC FUNCTION TelaInicial()
   @ 07,59 SAY "CLIPPER BASICO"
   @ 03,01 SAY "PROC01 Clipper               ³"
   @ 04,01 SAY "                             ³"
   @ 05,01 SAY "PROC11 Harbour Local  DBF    ³"
   @ 06,01 SAY "PROC12 Harbour Remoto DBF    ³"
   @ 07,01 SAY "PROC13 Harbour Remoto MYSQL  ³"
   @ 08,01 SAY "                             ³"
   @ 09,01 SAY "PROC21 xHarbour Local  DBF   ³"
   @ 10,01 SAY "PROC22 xHarbour Remoto DBF   ³"
   @ 11,01 SAY "PROC23 xHarbour Remoto MYSQL ³"
   @ 12,01 SAY "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
   @ 16,01 SAY "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
   @ 17,01 SAY "- Testando os campos b sicos ³"
   @ 18,01 SAY "- C lculo de Data + Dias     ³"
   @ 19,01 SAY "- Inclus„o/Altera‡„o/Exclus„o³"
   @ 20,01 SAY "- Uso DbEdit para Consulta   ³"
   @ 21,01 SAY "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
   RETURN NIL

Esta aqui é pra abrir arquivos. O melhor nome é "AbrirArquivos()".
Alguns não sabem, mas a declaração STATIC ajuda muuuuito.
Posso ter uma AbreArquivos() em cada módulo, e uma não interfere na outra.
Isso é bom pra não ficar inventando nomes.

Se o ALIAS é igual ao nome do arquivo, não precisa (USE LOTES ALIAS LOTES).
Não lembro quando, mas já tive mensagem de erro de ALIAS EM USO por usar desse jeito.
Talvez se o arquivo já estiver aberto.
Como não interessa também área A, B, C, podemos usar SELECT 0.
E por falar nisso, faltou o CLOSE DATABASES no final do fonte principal.

Código: Selecionar todos

STATIC FUNCTION AbreArquivos()
   SELECT 0
   USE LOTES
   INDEX ON lote                                TO ilote1
   INDEX ON estado+lote+dt_entrada              TO ilote2
   INDEX ON dt_entrada+lote                     TO ilote3
   INDEX ON dt_saida+lote                       TO ilote4
   SET INDEX TO ilote1, ilote2, ilote3, ilote4
   SELECT 0
   USE estado 
   INDEX ON sigla_uf                            TO iuf1
   SET INDEX TO iuf1
   RETURN NIL

Pra isso funcionar, alterei o início do fonte, já acrescentando uma necessidade pro Harbour SetMode(25,80).
Continua funcionando no Harbour e no Clipper.

Código: Selecionar todos

PROCEDURE Main
   set date brit
   set epoch to 2001
   set delete on
   SetMode(25,80)
   clear
   TelaInicial()
   AbreArquivos()
   @ 02,01 to 02,80
   @ 23,01 to 23,80
   ...
   CLOSE DATABASES

No Clipper, agora precisa acrescentar /n na compilação, o que é default no Harbour.

Código: Selecionar todos

clipper lote01 c_lote /n
rtlink fi lote01 c_lote

No Harbour continua igual:

Código: Selecionar todos

hbmk2 lote01 c_lote

Reparei numa coisa: provavelmente este fonte foi iniciado no Clipper Summer ou antes.
Antigamente o Clipper não tinha opção de criar função, e era tudo PROCEDURE, mesmo retornando valor.
Não existia FUNCTION no fonte, só PROCEDURE.
O cliente sempre pede tudo urgente, nem sempre dá tempo de revisar fontes.
Ainda mais se o sistema for grande, com muitos fontes, e cada cliente tiver o seu.

No meu caso cheguei a um único EXE pra todos os clientes. Então compensa melhorar, sempre mexo nos mesmos fontes.

[JoséQuintas]

Uma coisa que dá pra melhorar: cores
altera, volta, altera, volta
Vamos assumir a cor default do sistema como padrão.
E o SAY aceita colocar cor.

Então dá pra reduzir isto:

Código: Selecionar todos

FUNCTION msg_1( w_msg )                  // Procedure: Mensagem Sistema SEM parada
   set color to w/n
   @ 24,01 say space(80)
   set color to gr+/n
   @ 24,03 say w_msg
   set color to w/n
   RETURN NIL

pra isto.

Código: Selecionar todos

FUNCTION Msg_1( w_Msg )
   @ 24, 01 SAY Space(80)
   @ 24, 03 SAY w_Msg COLOR GR+/N
   RETURN NIL

Ou melhor ainda.... já mexer nos nomes.
Lembrando que em função, a variável passada é local, e podemos alterar à vontade os nomes dentro da função sem precisar mexer no resto do programa.

Código: Selecionar todos

FUNCTION Msg( cTexto )
   @ 24, 01 SAY Space(80)
   @ 24, 03 SAY cTexto COLOR GR+/N
   RETURN NIL

[alxsts]

Olá!

Ou melhor ainda:

Código: Selecionar todos

FUNCTION Msg( cTexto )
      RETURN ( DispOutAt( MaxRow(), 0, PadR( "  " + Left( RTrim( cTexto ), MaxCol() - 2), MaxCol() ), "GR+/N", .F. ) )

Ou melhor ainda:

Código: Selecionar todos

FUNCTION Msg( cTexto, nRow, nCol, cColor )
      RETURN ( DispOutAt( nRow, nCol, PadR( "  " + Left( RTrim( cTexto ), MaxCol() - 2), MaxCol() ), cColor, .F. ) )

Edit: este código evita o carregamento de todo o Get System, caso o objetivo seja apenas mostrar uma mensagem na tela.

DispotAt()

P.S.
Quintas: suas mensagens ainda estão aparecendo com o horário de verão ativo.

[JoséQuintas]

Até pensei nisso, mas apesar de ser comum pra muitos, pode parecer complicado pra quem não está acostumado.
Conheci um programador Clipper no ano passado que até hoje não sabe o que é criar função, mesmo trabalhando com Clipper desde o tempo da Novell. Então estou procurando evitar mudança radical.

Sobre o horário de verão, no Windows está marcando que vai mudar o horário em outubro.
Devo desativar mesmo estando tudo ok?

Continuando:
A alteração da mensagem Sim/Não foi mais legal.

Código: Selecionar todos

FUNCTION msg_3(w_msg)                         // Procedure: Mensagem Com Retorno
   //          : SIM ou NAO
   @ 24,01 SAY space(80)
   dc = " "
   @ 24,03 SAY w_msg COLOR "GR+/N" get dc pict "!" valid dc $ "SNsn"
   read
   @ 24,01 SAY space(80)            // Limpa apos a exibicao da mensagem
   return NIL

Mudou pra isto:

Código: Selecionar todos

FUNCTION MsgSimNao( cTexto )                         // Procedure: Mensagem Com Retorno
   @ 24,01 SAY space(80)
   cResposta := " "
   @ 24,03 SAY cTexto COLOR "GR+/N" GET cResposta PICTURE "!" VALID cResposta $ "SN"
   READ
   @ 24,01 SAY space(80)            // Limpa apos a exibicao da mensagem
   RETURN cResposta == "S"

Mas... qual a diferença?

- Ao olhar o fonte, MsgSimNao() tá na cara que é sim ou não
- Se tem ! na picture, significa que a digitação vai ser em maiúscula, só precisa validar maiúscula
- As cores, igual à função anterior, não precisa mais (já tinha retirado)
- Como retorna verdadeiro ou falso, já elimina variáveis do fonte que a chamar, sem falar que exigir nome de variável igual é perigoso. Sempre deveria existir a variável DC antes de chamar a função. Não poderia mudar nenhum fonte ou a função pra um nome diferente. Poderia até usar variável por referência, pra não deixar nome de variável preso. Msg("Sim ou Nao", @dc )

No fonte que a chama, antes:

Código: Selecionar todos

Msg_2( "sim ou nao" )
IF dc = 'S" // obriga que Msg_2 use DC

Depois:

Código: Selecionar todos

IF MsgSimNao( "Sim ou Nao" )

Lembrando:
Estou usando o fonte como exemplo.
Uma forma de substituir um "não consigo compilar com Harbour" por um "estou melhorando cada vez mais meus fontes".
Aconteça o que acontecer, seu trabalho está indo em frente e cada vez melhor.
E reduzindo fontes, cada vez menos código pra ter problema, mais fácil de alterar, e menos fonte pra converter pra alguma coisa nova.

[alxsts]

Olá!

Sobre o horário de verão, no Windows está marcando que vai mudar o horário em outubro.
Devo desativar mesmo estando tudo ok?

Você deve alterar no Painel de Controle do Usuário do próprio fórum e não do Windows. É só desmarcar a opção "Horário de Verão ativado:" na aba "Preferências do Fórum".

Quanto ao código, aí vai da preferência de cada um. Prefiro usar código compacto, com os melhores recursos da linguagem. DispOuAt() já usava desde os tempos do Clipper, apesar de ser uma função não documentada.

[JoséQuintas]

Agora uma mudança radical nos GETS.
Usar o mais comum: todos os GETs de uma vez e ESC pra sair
Pra isso, vou ter que facilitar a validação de estado.
No fonte, depois do GET tá assim:

Código: Selecionar todos

            sele estado
            set order TO 1
            go top
            seek (westado)
            if eof()
               alert ( "Estado n„o encontrado" )
               loop
            else
               SET COLOR TO g+/n
               @ 12,49 SAY estado
               SET COLOR TO w/n
            endif

Vou complicar um pouco também, mas só um pouco.
Criar uma função.
Na função vai pegar a área atual: Select(), pra poder selecionar estado, e depois voltar pra que estava antes.
Usar o mesmo fonte acima.

Código: Selecionar todos

STATIC FUNCION EstadoOk( cEstado )
   LOCAL nSelect := Select(), lOk := .T.
   sele estado
   set order TO 1
   seek (westado)
   if eof()
      alert ( "Estado n„o encontrado" )
      lOk := .F.
   else
      @ 12,49 SAY estado COLOR "GR/N"
   endif
   SELECT ( nSelect )
   RETURN lOk

Isso vai permitir usar GET cEstado VALID EstadoOk( cEstado )
Com isso, não vai precisar fazer um GET de cada vez, e vai simplificar mais.

Aproveitando....
Na hora de criar funções, comece por essa parte, de retornar ao que estava antes.
Se a função precisar mudar a cor, no final volta a que estava antes.
Se a função precisar mudar área de DBF, no final volta a que estava antes.
Se mudar índice, voltar o que estava antes.
Vantagem: Não importa o que aconteça, sempre volta o que estava antes, então vai poder usar a função em qualquer outro fonte.

Tudo bem, é coisa meio básica, mas nem sempre a gente lembra de fazer isso, ou nem sempre acha que vai precisar depois.

[JoséQuintas]

Não costumo usar isso, e talvez esteja me confundindo.

Código: Selecionar todos

SET MESSAGE TO 24 CENTER
@ 2, 3 GET variavel MESSAGE "teste"
READ

Esqueci de alguma coisa? Não está aparecendo a mensagem.
Conferi no std.ch e a sintaxe parece estar correta.

[JoséQuintas]

Deixando de lado esse imprevisto, o fonte de 75 para GET se reduziram a estas linhas:

Código: Selecionar todos

      @ 12, 46 GET wEstado PICTURE "@!" VALID EstadoOk( wEstado ) MESSAGE "Informe o ESTADO, ESC abandona"
      @ 16, 36 GET wDt_Entrada          VALID Dtos( wDt_Entrada ) >= "20150101" .AND. wDt_Entrada <= Date() MESSAGE "Informe a Data de Entrada, ESC abandona"
      @ 16, 52 GET wDias PICTURE "9999" VALID wDias > 0 MESSAGE "Informe a qtde. de dias, ESC abandona"
      @ 16, 60 GET wDt_Saida WHEN ( wDt_Saida := wDt_Entrada + wDias, .F. )
      @ 20, 36 get wqtde                PICTURE "9,999.999" valid wqtde >= 0 MESSAGE "Informe a Quantidade, ESC abandona"
      @ 20, 48 get wvlr_unit            PICTURE "9,999.999" valid wvlr_unit >= 0 MESSAGE "Informe o valor unitário, ESC abandona"
      @ 20, 60 GET wVlr_Total PICTURE "9,999,999.99" WHEN ( wVlr_Total := wQtde * wVlr_Unit, .F. )
      READ
      Inkey(3)

MESSAGE já troca a mensagem embaixo
VALID já confere o conteúdo
A qualquer momento pode ser digitado ESC pra abandonar
Os cálculos já são feitos automaticamente usando WHEN ( calculo, .F. )
Os resultados já aparecem automaticamente, e WHEN .F. não deixa mexer
Só acrescentei um Inkey(3) pra permitir ver o total que foi calculado.

E o confirme?
O usuário pode passear à vontade nas informações, tem durante toda digitação pra conferir, acho que dá pra eliminar o confirme.
Senão... usamos a função MsgSimNao()

Muito fonte a menos pra mexer, e até que não complicou tanto.
Só nisso, reduziu de 75 linhas pra 9.