VETORES ou MATRIZES

[Netavin]

Caros amigos do Fórum.

Eis a rotina de inclusão. Meu agradecimento antecipado.

Abraço a todos!

Netavin

Código: Selecionar todos

/**************************************/
/* Inclusao de Toras no Estoque */
/*************************************/
Function Incl_est ()
Local SavOrd, Flag, grvmsg, colchet
Public ro_fre,ro_imp,ro_ven,ro_plac1,ro_plac2,final
Private Sinal

Set Key -4 to Con_esse  /*  Pesquisa nome de essências  */
Set Key -5 to
Setblink(.f.)
SET SCOREBOARD OFF

Sele 1
Use Cadtora Alias Cadtora
IF !NETERR()
    If !File("Placa.ntx")
        Index on Plac to Placa
    ELSE
        SET INDEX TO placa
    Endif
    If !File("esse.ntx")
        Index on esse to esse
    ELSE
        SET INDEX TO esse
    Endif
    If !File("roma.ntx")
        Index on roma to roma
    ELSE
        SET INDEX TO roma
    Endif
    If !File("i_roma.ntx")
        Index on esse + Strzero(plac,5) to i_roma
    ELSE
        SET INDEX TO i_roma
    ENDIF
ELSE
    NETMSG()
    RETURN .F.
    CLOSE DATABASE
ENDIF
Set Index to placa,esse,roma,i_roma
/*            1     2    3      4  */
Set Order to 3
DbGoTop()

Do While .t.
    Public toreiro
    SetBlink(.t.)
    SET DELE OFF
    /* Cria vari veis */
    Vend    :=Space(15)
    Tm3     :=0
    Tpg     :=0
    MARC    :=0
    VDTEN   :=DATE()            /* Data de cadastro do Romaneio    */
    VROMA   :=0                 /* N§ do romaneio                  */
    ro_imp  :=0
    ro_fre  :=Space(15)
    ro_ven  :=Space(15)
    VQTD    :=0                 /* Quantidade de toras do Romaneio */
    VVEND   :=Space(15)         /* Nome do vendedor/Toreiro        */
    VFRET   :=Space(20)         /* Nome do freteiro se houver      */ 
    Linha   :=15
    Flag    :=0
    Sinal   :=0
    colchet :="[                      ]"
    grvmsg  :=SAVESCREEN(00,00,45,79)
    vplaca1 :=SPACE(11)
    vplaca2 :=SPACE(11)
    vobse   :=SPACE(15)
    Final:=0 /* Indica o destino da tora (0-> serrada; 1-> vendida; 2-> inservível)*/
    LIN46()

    @ 06,25 CLEAR TO 06,60
    @ 46,53 Say "<F5>"

    Setcolor("W/N")
    @ 46,58 Say "Lista das Essencias"

    Setcolor("B/W,W/B")
    /* Desenha o quadro */
    DONEBEEP()

    DispBox(08,00,43,79,1,"w/bg,gb+/b")
    DispBox(43,00,45,79,1,"w/bg,gb+/b")  
    @ 09,01 Clear to 42,78
    @ 44,01 Clear to 44,78

    @ 48,03 Say PADC(" Entrada de toras no estoque ",75)
    Setcolor("N/w,B/w")
    @ 08,02 SAY colchet

    @ 08,04 SAY "Cadastro de romaneio"
    @ 10,03 Say "Data:"        Get vdten
    @ 10,21 Say "Nr romaneio:" Get vroma Pict "@ez 99999" Valid n_roma(vroma)
    @ 10,41 Say "Qtde :"       Get vqtd  Pict "99"        Valid C_QDE(vqtd) 
    @ 10,53 Say "Toreiro:"     Get vvend Pict "@!"        When sinal=0 Valid !Empty(vvend)
    @ 11,03 Say "Freteiro:"    Get vfret Pict "@!"            When sinal=0
    @ 11,35 Say "Placa:"       Get vplaca1 Pict "!!!-9999-!!" When sinal=0
    @ 11,55 Say "Placa:"       Get vplaca2 Pict "!!!-9999-!!" When sinal=0
    READ

    If lastkey()=27
        Setcursor(0)
        tone(1500,1)
        A_lerta("Operação cancelada!")
        SET DELE ON
        use
        Exit
    Endif
    Setcolor("B/W")
    @ 12,01 Say Repl("Ä",78)

    If Sinal = 1
        vvend:=cadtora->vend
        vfret:=cadtora->fret
        vplaca1:=cadtora->placa1
        vplaca2:=cadtora->placa2
    endif

    Use Cadtora Index placa

    For X = 1 to VQTD       /* Laço para cadastro         */
        VPLAC=0                /* Nr da plaqueta                 */
        VESSE=Space(16)    /* Nome da essência            */
        VDIAM=0                /* Diâmetro da tora              */
        VCOMP=0               /* Comprimento da tora        */
        VDESC=0                /* Desconto em Cm              */
        VTDES=0                /* Total do desconto em M3 */
        VTTM3=0               /* Total da tora em M3        */
        VVLM3=0                /* Valor por M3 em R$      */
        VVLPG=0                /* Valor pago na tora      */

        Set color to n
        @ 13,01 clear to 13,78
        SetColor("w/n")

        @ 13,02 Say "PLACA"
        @ 13,10 Say "ESPCIE"   
        @ 13,29 Say "DIÂM"       
        @ 13,36 Say "COMP"      
        @ 13,44 Say "DESC"   
        @ 13,51 Say "VLR/M3"
        @ 13,60 Say "TTL M3"
        @ 13,70 Say "VLR PAGO"

        Setcolor("B/W")
        @ 14,01 Say Repl(" ",78)
        SetColor("n/w,b/w")
        @ Linha,02  Get VPLAC Pict "99999" Valid Plaqueta(vplac)
        Read
        Setcursor(0)

        If Lastkey() = 27
            ERRORBEEP()
            SETCURSOR(0)
            A_lerta("Romaneio cancelado!")
            Exit
        Endif

        DbSeek(vplac)

        If Found()
            Tone(1700,1)
            If Opc:=A_lerta("Esta plaqueta já existe!",{"$Retorna","$Cancela"}) = 1
                X = X - 1
                Loop
            Else
                Exit
            Endif
        Else
            Setcolor("b/w")
            If X = VQTD
                @ 48,02 Clear to 48,78
                @ 48,18 Say " Cadastrando último item do romaneio nr "+Alltrim(STR(VROMA))
            Else
                @ 48,18 Say " Cadastrando item nr "+Alltrim(str(x))+"/"+Alltrim(STR(VQTD))+" do Romaneio nr 	 "+Alltrim(str(vroma))+" "
            Endif
      
            Setcolor("B/W,B/W")
            @ Linha,10 Get VESSE Pict "@!"          Valid Tem(vesse) When buscaesse()
            @ Linha,29 Get VDIAM Pict "9.99"        Valid Diametro(vdiam)
            @ Linha,36 Get VCOMP Pict "99.99"       Valid Valida(vcomp)
            @ Linha,44 Get VDESC Pict "9.99"        Valid Desconto(vdesc)
            @ Linha,51 Get VVLM3 Pict "@E 999.99"   Valid Verif_vlr(vvlm3)
            Read

            Setcursor(0)                      

            If Lastkey() = 27                    
                Tone(500,1)            
                A_lerta("Romaneio cancelado!")
                Exit
            Endif                                  

            /*******************8***************/
            /* >>>>   Aqui é feito o cálculo da tora  <<<< */
            /***********************************/
   
            VTDES:=(vdesc^2)*vcomp*0.7854
            VTTM3:=(((vdiam^2)*vcomp*0.7854)-(vdesc^2)*vcomp*0.7854) - 0.0001
            VVLPG:=VTTM3*VVLM3
            SetColor("B/W")
            @ Linha,60 Say Transform(vttm3, "@e 99.999")
            @ Linha,70 Say Transform(vvlpg, "@e 9,999.99")
            Setcolor("N/W,W/B")

            If vfret=Space(10)
                vfret:="O MESMO"
            Endif

            ro_imp=vroma      /* Informação para a função Impr_dig */
            ro_fre=vfret         /* Idem */
            ro_ven=vvend      /* Idem */
            ro_plac1=vplaca1
            ro_plac2=vplaca2

            do while .t.
               If travarquivo(5)
                  DbAppend()  
                  Repl PLAC WITH VPLAC,DTEN WITH VDTEN,ROMA WITH VROMA,;
                  ESSE WITH VESSE,DIAM WITH VDIAM,COMP WITH VCOMP,;
                  DESC WITH VDESC,TDES WITH VTDES,TTM3 WITH VTTM3,;
                  VEND WITH VVEND,FRET WITH VFRET,VLM3 WITH VVLM3,;
                  VLPG WITH VVLPG,PLACA1 WITH VPLACA1,;
                  PLACA2 WITH VPLACA2,FINALIDADE WITH FINAL
                  Flag++  /* Sinaliza se foi cadastrado pelo menos uma plaqueta */
               Else
                  Flag--
                  loop
               Endif

               exit
            enddo
            Tone(400,1)
            Dbunlock()
            DbCommit()
        Endif

        Linha++
        Tm3:=Tm3+vttm3
        Tpg:=Tpg+vvlpg

        Setcolor("b/w")
        @ 44,46 Say "Totais:" + Transform(Tm3,"@e 9,999.999") + " M3"
        @ 44,67 Say "R$ " + Transform(Tpg,"@e 9,999.99")
    Next

    @ 48,02 Clear to 48,78

    If Flag >= 1
        Setcursor(0)
        Tone(1600,1);Tone(1600,2);Tone(1600,3)
        A_lerta("Fim do Romaneio "+Alltrim(STR(VROMA)),,"w/g")
        Tone(1700,1)

        If Opc:=A_lerta("Deseja Imprimir?",{"Sim","Nao"},"w/bg")=1
            Setcursor(0)
            Impr_ro2()
            Tone(1700,1)
            Setcursor(0)

            If A_lerta("Mais Romaneios?",{"Sim","Nao"}) = 1
                Set Index TO roma
                REINDEX
                Loop
            Else
                USE
                RESTSCREEN(00,00,45,79,grvmsg)
                Exit
            Endif
        Else
            Tone(1700,1)
            Setcursor(0)

            If A_lerta("Mais Romaneios?",{"Sim","Nao"}, "w/bg") = 1
                USE cadtora INDEX roma
                REINDEX
                Loop
            Else
                USE
                RESTSCREEN(00,00,45,79,grvmsg)
                Exit
            Endif
        Endif
    Endif
Enddo

SET DELE ON
DbCloseAll()
Return NIL


/*****************************************/
/* Imprime o Romaneio depois de digitado */
Function Impr_ro2()

LOCAL L, PG, VARI, QTD, ROMAN, VEND, t_med
LOCAL VTOTAL    :=000000.00
LOCAL VSUBTOTAL :=000000.00
LOCAL TOTALR    :=000000.00
LOCAL SUBTTLR   :=000000.00
Public toreiro

Set Index to esse, placa, roma
Reindex
OrdSetFocus(1)

roman=ro_imp
vend=ro_ven
Toreiro=ro_ven
vfret=ro_fre
Qtd:=0
VLP:=0
L := 0
PG :=1
vari:=esse

Set Filter to roman=roma
abre_imp()

Do While !eof()
    If L = 0
        ? PADC("ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ",80)
        ? PADC("ROMANEIO DE ENTRADA DE TORAS",80)
        ? Padc("Em "+ dtoc(DATE())+" …s "+ Left(time(),5),80)
        ? PADC("ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ",80)
        ? "  P g.: " + Strzero(PG,3)
        ?
        ? "  N§ romaneio :"+STRZERO(vroma,5)+Space(05)+"Toreiro: "+Alltrim(RO_ven)+Space(10)+"Freteiro: "+Alltrim(ro_fre)
        IF !EMPTY(ro_plac1).OR.!EMPTY(ro_plac2)
           ? "  Ve¡culo placa(s): "+ro_plac1+" / "+ro_plac2
        ENDIF
        ?
        ? "  ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
        ? "  Placa   Essˆncia          Comp   Diƒm   T.desc   Ttl M3    Vlr M3    Ttl R$"
        ? "  ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
        L:=10
    Endif

    If roma # roman
        Skip
    Endif

    IF ALLTRIM(VARI) # ALLTRIM(ESSE)

        If vsubtotal > 0
            ? "  Subtotal: " + TRANSFORM(VSUBTOTAL,"@e 9,999.999")+" M3                          Subtotal em R$ ...." + Transform(Subttlr, "@e 9,999.99")
            VTOTAL+=VSUBTOTAL
            VSUBTOTAL:=000000.00
            VARI:=ESSE
            TOTALR+=SUBTTLR
            SUBTTLR:=000000.00
        Else
            vtotal+=vsubtotal
            vsubtotal:=000000.00
            vari:=esse
            totalr+=subttlr
            subttlr:=000000.00
        Endif

    Endif

    IF ALLTRIM(VARI)=ALLTRIM(ESSE)
        ? Space(01),PLAC,Space(1),ESSE,TRANSFORM(COMP,"@e 9.99"),;
        Space(1),TRANSFORM(DIAM,"@e 9.99"),Space(1),;
        TRANSFORM(TDES,"@e 9.999"),Space(2),TRANSFORM(TTM3,"@e 9.999"),;
        SPACE(03),TRANSFORM(VLM3,"@e 999.99"),SPACE(02),TRANSFORM(VLPG,"@e 999.99")
        VSUBTOTAL+=TTM3
        subttlr+=vlpg
    Endif

    DbSkip()
    L++
    Qtd++

    IF EOF()
        ? "  Subtotal: " + TRANSFORM(VSUBTOTAL,"@e 9,999.999")+" M3                          Subtotal em R$ ...." + Transform(Subttlr, "@e 9,999.99")
        VTOTAL+=VSUBTOTAL
        Totalr+=Subttlr
        VARI:=ESSE
    Endif

    If L >= 40
        L = 0
        Pg++
        Eject
    Endif

Enddo

? "  ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
? "  Total: "+Alltrim(transform(vtotal,"@E 9,999.999")) + " M3  / " + Alltrim(STR(QTD))+" tora(s)  / " + " Valor pago: R$ " + Alltrim(Transform(Totalr, "@e 9,999.99"))
? "  ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
// Cálculo da média . . .
t_med = vtotal/qtd
? "  Média p/tora ..: " + Alltrim(transform(t_med,"@E 99.999")) + " M3"

? "[COMPRIME]"
? Space(3)+"System Wood v3.7 - by LM"
? "[NORMAL]"

fech_imp()

RUN USBPRINT C:\TEMP\RELA.TXT /SEL /DEL

Return NIL

[asimoes]

Pessoal,

Outro dia precisei montar um dbf a partir de uma estrutura de vetor que era muito mais complexa que esta, fiz uma estrutura mais simples, a ideia é pegar os elementos
numéricos que tem tamanho variável dentro do conjunto.

Código: Selecionar todos

FUNCTION MAIN
   CLS
   aArq:={}
   
   AADD(aArq,{"A",{"1","2","3"}})
   AADD(aArq,{"B",{"1","2"}})
   AADD(aArq,{"C",{"1","2","3","4"}})
   
   nLenTotal:=len(aArq)

   FOR nLenIni:=1 TO nLenTotal
      nLen:=len(aArq[nLenIni,2])
      ? aArq[nLenIni,1] //Mostra o primeiro elemento
      FOR A:=1 TO nLen
         ?? aArq[nLenIni,2,A]
      NEXT
      INKEY(0)
   NEXT
RETURN Nil

[microvolution]

Olá pessoal, me desculpem demorar 4 anos pra responder. Primeiro que nunca recebi no meu email alguma resposta, e, em segundo, o amigo Eolo Ventura, me ajudou através de emails/msn (na época).
Inclusive ele tá meio sumido...
Bom, só descobri hoje, pois estava postando dúvidas sobre migração de clipper/harbour HMG e cliquei lá no top onde tem a lupa e aí sim vi ali minhas perguntas/respostas.
No mais, agradeço a todos!
Mas, não consegui migrar até hoje para harbour/xharbour.
Abraços!

[microvolution]

Pessoal bom dia!
Tenho outra dúvida a respeito de vetores/matrizes.
fiz o seguinte:

Código: Selecionar todos

...
MATRIZ_N :=  {;
                     {'CDFORNECE'           ,'N',  4,  0},;
                     {'NU_NF'               ,'N',  9,  0},; // no original "NU_NF,06" era este o valor 17/2/16w
                     {'CDPRODUTO'           ,'N', 13,  0},;
                     {'DT_COMPRA'           ,'D',  8,  0},;
                     {'QT_COMPRA'           ,'N',  7,  3},;
                     {'VR_UNITAR'           ,'N',  9,  2}}

MATRIZ_A :=  {;
                     {'CDFORNECE'           ,'N',  4,  0},;
                     {'NU_NF'               ,'N',  6,  0},;
                     {'CDPRODUTO'           ,'N', 13,  0},;
                     {'DT_COMPRA'           ,'D',  8,  0},;
                     {'QT_COMPRA'           ,'N',  7,  3},;
                     {'VR_UNITAR'           ,'N',  9,  2}}

lATUL := .t.
stru_antiga := dbstruct()
stru_nova := MATRIZ
for n_stru = 1 to lent(stru_antiga)
   if stru_antiga [n_stru] == stru_nova[n_stru]
       lATUL := .f.
   endif
next

Observem que a MATRIZ_N só tem um elemento diferente da MATRZ_A que é este:

Código: Selecionar todos

                     {'NU_NF'               ,'N',  6,  0},;

Então, no lugar e usar o DBU para alterar manualmente o arquivo (isso já faço) no qual posso esquecer algum item e fica muito lento e cansativo a alteração, ainda sujeita a erros, e, o cliente tem ficar esperando (atendimento aos seus clientes) até terminar o processo e pressionar F4 para salvar a nova ESTRUTURA no DBU.
Juntando diversas ideias, cheguei no exemplo acima e não funcionou como devia.
Bom os srs. poderiam pensar da seguinte forma:
* tá fácil é só comparar a MATRIZ_A com a MATRIZ_N que tá resolvido... também pensei o mesmo, foi por isso que criei as matrizes contendo as alterações necessárias no banco de dados dbfntx... mas, toda vez que o usuário rodar o aplicativo, será feita uma alteração, e, não é isso o correto.
* por isso que peguei o stru_antiga e se o arquivo ainda possuir campos errados, aí sim deverá ser corrigido.
Agora se o usuário executar novamente o stru_antiga já não será mais antigo...
Como não sou bom em matriz/vetor (confesso meu pecado), não consigo uma forma de usar o LEN() para verificar linha a linha...
se fosse a MATRIZ_A x MATRIZ_N até acho que conseguiria fazer da seguinte forma (é o que penso):

Código: Selecionar todos

for n = len(MATRIZ_N)
   if MATRIZ_A[n,3] == MATRIZ_N [n,3]
      lATUL := .f.
   endif
next

Mas, comparar um db_struct() com uma matriz não tenho a ideia certa!

E, agora, quem poderá me defender?

[asimoes]

Use os recursos que o harbour oferece por exemplo FOR.EACH.IN.NEXT
Procure no fórum tem vários exemplos

Ex.:

Código: Selecionar todos

LOCAL oElemento, aVetor

aVetor:={}

aAdd(aVetor, "1")
aAdd(aVetor, "2")
aAdd(aVetor, "3")

FOR EACH oElemento IN aVetor
   ? oElemento
NEXT

aVetor:={}

aAdd(aVetor, {"1", "2"})
aAdd(aVetor, {"3", "4"})
aAdd(aVetor, {"5", "6"})

FOR EACH oElemento IN aVetor
   ? oElemento[1], oElemento[2]
NEXT

[microvolution]

? oElemento

pois então, esse troço é muito novo pra mim e muito complexo ainda...
pelo que vi seu e também noutros é muito estranho a syntax...
por exemplo o oElemento, não tem nada, como vai imprimir e o quê?

[asimoes]

Microvolution veja:

Código: Selecionar todos

FOR EACH
Iterates elements of data types that can be seen as a collection. 
Syntax
FOR EACH <element> IN <array>|<object>|<string>
   <statements>
   [LOOP]
   <statements>
   [EXIT]
NEXT

Arguments
<element> 
The name of a variable that gets assigned a new value on each iteration. 
IN <array> 
This is a value of data type Array. The FOR EACH loop iterates all array elements in the first dimension and assigns their values to <element>. 
IN <object> 
This is a value of data type Object. The FOR EACH loop iterates all instance variables of the object and assigns their values to <element>. 
IN <string> 
This is a value of data type Character string. The FOR EACH loop iterates all individual characters of the string and assigns them to <element>. 
LOOP 
The LOOP statement unconditionally branches to the FOR EACH statement, i.e. to the begin of the loop, where the next value is assigned to <element>. 
EXIT 
The EXIT statement unconditionally terminates the FOR EACH loop and branches to the statement following NEXT. Description
The FOR EACH statement forms a control structure that executes a block of statements for a data type containing multiple elements. This can be data of type Array, Object or Character string. The loop iterates all elements contained in the data and assigns the value of the next element to <element> on each iteration. 
FOR EACH is similar to the regular FOR loop. But it completes considerably faster than a FOR loop, since there is no explicit loop counter. In contrast, FOR EACH uses an implicit loop counter whose value can be queried using the function HB_EnumIndex(). Other than this, LOOP and EXIT statements within the loop are treated the same as in a FOR loop. 
When FOR EACH statements are nested, each loop maintains its own counter, i.e. HB_EnumIndex() retrieves the counter of the loop that is currently executed. When the FOR EACH loop is finished, its loop counter is set to 0. 

// The example demonstrates the FOR EACH statement using two
// nested loops. The outer loop iterates an array while the
// inner loop iterates character strings.

   PROCEDURE Main()
      LOCAL aArray := { "Hello", "World" }
      LOCAL cString, cChar

      FOR EACH cString IN aArray
         ? "----- Outer loop -----"
         ? HB_EnumIndex(), cString

         ? "----- Inner loop -----"
         FOR EACH cChar IN cSTring
            ? HB_EnumIndex(), cChar
         NEXT
      NEXT

      ? "-------- End ---------"
      ? HB_EnumIndex()
   RETURN

/* Output of example:
   ----- Outer loop -----
         1 Hello
   ----- Inner loop -----
            1 H
            2 e
            3 l
            4 l
            5 o
   ----- Outer loop -----
            2 World
   ----- Inner loop -----
            1 W
            2 o
            3 r
            4 l
            5 d
   -------- End ---------
            0

[alxsts]

Olá!

FOR EACH ... NEXT é um bloco de iteração (repetição), cujos comandos colocados no interior do bloco são aplicados a cada elemento do vetor ou string. A cada passagem ele move automaticamente o valor corrente do vetor para a variável declarada, no caso oElemento. Para saber qual a posição do elemento atual em processamento pela iteração, pode-se usar a função HB_EnumIndex()

[JoséQuintas]

1) ERRADO: Porque 2 arrays no fonte

2) ERRADO: Esse array é uma lista de campos, ok, mas cada campo é uma lista de informações.

3) ERRADO: Atualizar toda hora? lógico. Tem que comparar com a estrutura do arquivo, e não com algo que tem no fonte.

Vamos tentar, criar durante o post, qualquer coisa ajusta..

1. Precisa da estrutura atual

Código: Selecionar todos

USE arquivo
oDbfStru := dbStruct()
USE

2. Precisa da estrutura nova

Código: Selecionar todos

oNovaStru :=  {; 
{'CDFORNECE'           ,'N',  4,  0},; 
{'NU_NF'               ,'N',  9,  0},; 
{'CDPRODUTO'           ,'N', 13,  0},; 
{'DT_COMPRA'           ,'D',  8,  0},; 
{'QT_COMPRA'           ,'N',  7,  3},; 
{'VR_UNITAR'           ,'N',  9,  2}} 

3. Fase 1: Comparar as duas
Se a quantidade de campos é diferente, já precisa atualizar, e nem precisa testar os campos

Código: Selecionar todos

lModifica := .F.
IF Len( oDbfStru ) != Len( oNovaStru )
   lModifica := .T.
ENDIF

4. Fase 2: Se passou no teste de quantidade, compara cada campo.

É uma lista de campos, que contém uma lista de informações, uma lista dentro da outra.
Só vai modificar se houver alguma coisa diferente.

Código: Selecionar todos

lModifica := .F.
FOR nCampo = 1 TO Len( oDbfStru ) // cada campo
   FOR nInformacao = 1 TO 4 // cada informação de cada campo
      IF oDbfStru[ nCampo, nInformacao ] != oNovaStru[ nCampo, nInformacao ] // compara um com o outro
         lModifica := .T.
      ENDIF
   NEXT
NEXT

Acho que nem dá pra sair muito disso, qualquer coisa diferente só vai complicar.
No meu caso eu complico... rs.... Mesmo que os campos estejam fora de ordem, se estiver tudo ok, a estrutura não é atualizada.

Nota: Lembrando que o segundo teste é só se o primeiro retornar falso, senão pode dar erro de quantidade de campos.

[JoséQuintas]

Juntando tudo.

Código: Selecionar todos

USE arquivo
oDbfStru := dbStruct()
USE

oNovaStru :=  {; 
{'CDFORNECE'           ,'N',  4,  0},; 
{'NU_NF'               ,'N',  9,  0},; 
{'CDPRODUTO'           ,'N', 13,  0},; 
{'DT_COMPRA'           ,'D',  8,  0},; 
{'QT_COMPRA'           ,'N',  7,  3},; 
{'VR_UNITAR'           ,'N',  9,  2}} 

lModifica := .F.
IF Len( oDbfStru ) != Len( oNovaStru )
   lModifica := .T.
ENDIF
FOR nCampo = 1 TO Len( oDbfStru ) 
   IF lModifica // vai modificar, encerra o teste, já evita erro de tamanho aqui
      EXIT
   ENDIF
   FOR nInformacao = 1 TO 4 
      IF oDbfStru[ nCampo, nInformacao ] != oNovaStru[ nCampo, nInformacao ] 
         lModifica := .T.
         EXIT // vai modificar, encerra o teste
      ENDIF
   NEXT
NEXT

[JoséQuintas]

E finalmente, pra não encher os fontes de rotinas:

Código: Selecionar todos

oNovaStru :=  {; 
{'CDFORNECE'           ,'N',  4,  0},; 
{'NU_NF'               ,'N',  9,  0},; 
{'CDPRODUTO'           ,'N', 13,  0},; 
{'DT_COMPRA'           ,'D',  8,  0},; 
{'QT_COMPRA'           ,'N',  7,  3},; 
{'VR_UNITAR'           ,'N',  9,  2}} 

AtualizaEstrutura( "arquivo", oNovaStru )
RETURN


FUNCTION AtualizaEstrutura( cNomeDbf, oNovaStru )

LOCAL oDbfStru, nCampo, nInformacao

USE ( cNomeDbf ) ALIAS TEMP
oDbfStru := dbStruct()
USE

lModifica := .F.
IF Len( oDbfStru ) != Len( oNovaStru )
   lModifica := .T.
ENDIF
FOR nCampo = 1 TO Len( oDbfStru ) 
   IF lModifica // vai modificar, encerra o teste, já evita erro de tamanho aqui
      EXIT
   ENDIF
   FOR nInformacao = 1 TO 4 
      IF oDbfStru[ nCampo, nInformacao ] != oNovaStru[ nCampo, nInformacao ] 
         lModifica := .T.
         EXIT // vai modificar, encerra o teste
      ENDIF
   NEXT
NEXT
IF .NOT. lModifica
   RETURN NIL
ENDIF
dbCreate( "temporário", oNovaStru )
USE temporário ALIAS TEMP
APPEND FROM ( cNomeDbf )
COPY TO ( cNomeDbf )
USE
fErase( "temporário.dbf" )
RETURN NIL

Antes de colocar em produção:
- backup?
- se dois usuários estiverem rodando versões diferentes?
- arquivo em uso?
- Será que usa DBT/FPT e vai precisar apagar?
- Será que não é melhor apagar NTX/CDX?
- Será que tem espaço em disco?
- Será que o campo numérico poderá ser menor, e estourar a capacidade?
- Será que não tem campo que é numérico que virou caractere ou vice-versa?
- Será que esse nome temporário vai dar certo se dois usuários entram no sistema ao mesmo tempo?
- Está preparado pra acabar com todo banco de dados do cliente?

[asimoes]

Quintas,

Legal o seu exemplo, acho que só faltou uma proteção, com begin sequence ou try catch

[JoséQuintas]

NÃÃÃÃÃÃÃO

Se tiver que dar erro, tem mais é que mostrar e abortar o programa.
Só assim vai dar tempo de salvar os dados.

O que precisa é adicionar rotinas de checagem de arquivo exclusivo, etc.

[asimoes]

Desculpe, mas não concordo com a sua lógica.
Enfim, cada um faz o que quer.

[JoséQuintas]

Um exemplo simples:

A atualização altera um campo de numérico para caractere.
Isso faz dar erro e abortar o programa.

E com Try/catch?
Vai em frente, e os dados serão perdidos?