How to add a field to a DBF?

[sambomb]

Hi, I need to add/change a field from a DBF, but I can't use append from

I saw that some RDD functions like CreateFields() and AddField() could help me, but I can't discover how to use them...

Any tips?

[ukservice]

Hi,

Try this code.

Please, keep (c). Thank you.

Code: Select all  Expand view

// *****************************************************************************************************************************
// Estas funciones fueron hechas y mantenidas por:
// L.I. Luis Fernando Rubio Rubio
// Ing. Rafael Morfin Nieto
// La distribucion de estas funciones son FreeWare, con la unica condicion que si hacen alguna modificacion que optimize
// su funcionamiento reenviar una copia a frubio@servicrece.com o pipu@tutopia.com
// Cualquier comentario a los mismos correos...
// *****************************************************************************************************************************
// Luis Fernando Rubio Rubio frubio@servicrece.com
// SERVICRECE S.A. DE C.V.
// Departamento de Desarrollo
// Area de Comercio Exterior
// Guadalajara, Jalisco, México
// *****************************************************************************************************************************
// el uso de la funcion es la siguiente
//
//  MODIFYSTRUCT('c:','tempo','tempo',{{'FECHAPAGO' ,'D',008,0},; // PED->FECHA PAGO
//                                         {'CVDOC'    ,'C',002,0},; // PED->CVDOC
//                                         {'TLC'      ,'C',015,0}},.F.) // T.L.C. EN BLANCO
//
// al hacer esto, busca los campos y si los encuentra los compara y si hay alguna diferencia los modifica, caso contrario que no
// los encuentre los da de alta..
// *****************************************************************************************************************************

//**************************************************************************************************************************************//
// Function ModifyStruct()
//              Donde pRutaLogica es el directorio a donde esta la base de datos
//              Donde pAlias es el ALIAS como se conocera la base de datos
//              Donde pBaseDatos es el nombre de la base de datos a modificar
//              Donde pNomCampo es el nombre del campo nuevo
//              Donde pTipo es el tipo del campo (Numerico,Caracter,Date,Memo)
//              Donde pTama es el tamaño del campo nuevo
//              Donde pDeci es el numero de decimales que tendra el campo (si se requiriera)
//
// Función para hacer la modificación de las estructuras de bases de datos
// Ultimas modificaciónes:30 de Mayo de 2000   Luis Fernando Rubio Rubio
//                        06 de Junio de 2000  Luis Fernando Rubio Rubio
//                        08 de Julio de 2000  Luis Fernando Rubio Rubio - Si existe el campo lo compara y si algo cambio lo reemplaza
//                        21 de Julio de 2000  Luis Fernando Rubio Rubio
//****************************************************************************************************************************//
FUNCTION ModifyStruct(pcRutaLogica, pcAlias, pcBaseDatos, pacampos, plModifica)  //**********************************************************//

  MEMVAR cceser,cceimp,ccerec,ccefac,ccecom,ccetra,ccecot,cceman,ccecad

  LOCAL cArcResp  := ArchivoProvisional_Modstruct('.DBF',pcRutaLogica,0,LEFT(pcBaseDatos,4)) // Se crea un archivo de respaldo Consecutivo 06/06/2000
  LOCAL cArcResp2 := cFileNoExt(cArcResp)

  DEFAULT plModifica := .T.



  IF FILE(pcRutaLogica+pcBaseDatos+'.DBF')
     // modificamos
     IF plModifica
        MsgCopia(pcRutaLogica + pcBaseDatos+'.DBF',cArcResp) // Modificado el 14.10.2000 LFRR
        IF File(pcRutaLogica + pcBaseDatos+'.DBT')
           MsgCopia(pcRutaLogica + pcBaseDatos+'.DBT',pcRutaLogica+cArcResp2+'.DBT')
        ENDIF

        CopiaEstructura_Modstruct(cArcResp,pcRutaLogica+pcBaseDatos,pacampos)

        USE (pcRutaLogica+pcBaseDatos) ALIAS pcAlias
        APPEND FROM (cArcResp)
        CLOSE pcAlias
     ENDIF
     // fin de modificar
  ELSE
     // No existe la Base de Datos
     IF MSGYESNO('La base de datos '+pcRutaLogica+pcBaseDatos+'.DBF'+' no existe'+CRLF+CRLF+'¿Desea Crearla?','Base de Datos no Encontrada')
        DBCREATE(pcRutaLogica+pcBaseDatos+'.DBF',pacampos)
     ELSE
        MSGSTOP('El sistema NO funcionara si no existe esta base de datos...'+CRLF+'El sistema se cerrará....','El programa no puede continuar')
        CLOSE ALL
        QUIT
     ENDIF
  ENDIF



  // Borramos el archivo temporal
  IF FERASE(cArcResp) == -1
     MsgStop("ERROR: Error al borrar el archivo "+cArcResp, " E R R O R ")
  ENDIF



RETURN(NIL) //***************************************************************************************************************//

//****************************************************************************************************************************//
// Esta funcion crea el un nombre de archivo consecutivo..
// modo de uso:
//ArcProv('.DBF',pcRutaLogica,0,LEFT(pcBaseDatos,3))
//****************************************************************************************************************************//

STATIC FUNCTION ArchivoProvisional_Modstruct(pcExtension,pcRuta,pIncrementar,pcPrefijo)   //Devuelve el nombre de un archivo provisional
    LOCAL i := 0,;
          m := 0,;
          cRuta := '',;
          cNombre := '',;
          nInc := 0

    IF pcount()>=3  //Se dio el parametro pIncrementar
       nInc := pIncrementar
    ENDIF

    IF pcPrefijo = Nil
        pcPrefijo :='TMP'
    ENDIF

    IF pcount()=1
       IF !empty(gete("TMP"))
          cRuta=gete("TMP")
       ELSEIF !empty(gete("TEMP"))
          cRuta=gete("TEMP")
       ENDIF

       IF !empty(cRuta)
          IF subst(cRuta,len(cRuta),1)!="\"
             cRuta+=''
          ENDIF
       ENDIF
    ELSE
       cRuta := pcRuta
    ENDIF

    FOR i := 1 to 99999
        cNombre := cRuta+;
                   pcPrefijo+;
                   strzero(i+nInc,5)+;
                   pcExtension
        IF !file(cNombre)
           m := fcreate(cNombre,0)
           fclose(m)
           RETURN cNombre
        ENDIF
    NEXT
RETURN('') //*****************************************************************************************************************//

//****************************************************************************************************************************//
// Esta funcion depende de MSGCOPIA()
// el objetivo de esta funcion es la copia a nivel byte por byte para evitar una posible corrupcion de los DBF's
//****************************************************************************************************************************//
FUNCTION Respaldo_Modstruct(oMeter, oText, oDlg, lEnd, pOrigen, pDestino)  //***********************************************************//
  LOCAL fOrigen, fDestino
  LOCAL nBuffer    := 8192        // Tamaño del Buffer en Bytes
  LOCAL cBuffer := SPACE(nBuffer)
  LOCAL Tamano := fsize(pOrigen), nLeido := 0, nEscrito := 0, nCopiados := 0

  oMeter:nTotal = Tamano

  fOrigen = fOpen(pOrigen)
  IF ferror() != 0
    MsgStop('No se Pudo Abrir el archivo '+pOrigen,'ERROR de Apertura')
    lEnd := .t.
    RETURN(NIL)
  ENDIF

  fDestino = fCreate(pDestino)
  IF ferror() != 0
    MsgStop('No se Pudo crear el archivo '+pDestino,'ERROR de Creación')
    lEnd := .t.
    RETURN(NIL)
  ENDIF

  DO While nCopiados < Tamano

    nLeido = fRead(fOrigen, @cBuffer, nBuffer)

    IF ferror() != 0
       MsgStop('No se Pudo leer el archivo '+pOrigen,'ERROR de Lectura')
       lEnd := .t.
       fclose(fOrigen)
       fclose(fDestino)
       RETURN(NIL)
    ENDIF

    nEscrito = fwrite(fDestino, cBuffer, nLeido)

    IF ferror() != 0
       MsgStop('No se Pudo escribir en el archivo '+pDestino,'ERROR de Escritura')
       lEnd := .t.
       fclose(fOrigen)
       fclose(fDestino)
       RETURN(NIL)
    ENDIF

    nCopiados+=nLeido // Incrementa la cantidad de Bytes copiados hasta el momento...
    oMeter:Set( nCopiados )
    SysRefresh()

  EndDo
   lEnd = .t.
   fclose(fOrigen)
   fclose(fDestino)
RETURN(NIL) //****************************************************************************************************************//

// Funcion que hace la el respaldo de los archivos a modificar
// y hace uso de la funcion respaldo
FUNCTION MsgCopia(pOrigen,pDestino)  //***************************************************************************************//
  MsgMeter({|oMeter,oText,oDlg,lEnd| Respaldo_Modstruct(oMeter, oText, oDlg, @lEnd, pOrigen, pDestino)},'Copiando: '+pDestino,'Copiando: '+pOrigen)
RETURN(.t.)  //***************************************************************************************************************//

 //****************************************************************************************************************************//
 // Ultima Modificacion de esta Funcion:
 // ---  08.07.2000 LFRR   Ahora compara si existe el campo y su estructura si es igual asi lo deja y si no lo modifica  LRRR RMN
 // Esta funcion depende de Modifystruct()
//****************************************************************************************************************************//

Function CopiaEstructura_Modstruct(pcOrigen,pcDestino,paCamposAdicionales) //**************************************************************//
  MEMVAR cceser,cceimp,ccerec,ccefac,ccecom,ccetra,ccecot,cceman,ccecad,ccedoc
  LOCAL aEstructura:={}, I:=0

  USE (pcOrigen) ALIAS CopiaEstructura New
  IF NetErr()
     MsgStop('ERROR: Error al abrir: '+pcOrigen,'ERROR NetErr()')
     RETURN(NIL)
  ENDIF

  aEstructura = DBStruct()

  FOR i = 1 To Len(paCamposAdicionales)   //Campos Adicionales
    //Verificar que no exista lo que se quiere agregar
    SELECT CopiaEstructura
    IF !ExisteCampo(paCamposAdicionales[i,DBS_NAME])
       MsgAlert('Agregando campo: '+paCamposAdicionales[i,DBS_NAME],'Agregando campos a: '+pcDestino+'.DBF')
       AADD (aEstructura,{paCamposAdicionales[i,DBS_NAME],paCamposAdicionales[i,DBS_TYPE],paCamposAdicionales[i,DBS_LEN],paCamposAdicionales[i,DBS_DEC]})
     ELSE
        // En esta version se modifica para bien esta función en lugar de Checar si existe y brincar, ahora compara estructuras y si son
        // Diferentes las modifica y si no asi las deja y continua con el proceso
        // Ultima Modificacion : 08.07.2000  LFRR -- MRMN

        IF aEstructura[FIELDPOS(paCamposAdicionales[i,DBS_NAME]),DBS_TYPE] != paCamposAdicionales[i,DBS_TYPE] .or.;
           aEstructura[FIELDPOS(paCamposAdicionales[i,DBS_NAME]),DBS_LEN]  != paCamposAdicionales[i,DBS_LEN]  .or.;
           aEstructura[FIELDPOS(paCamposAdicionales[i,DBS_NAME]),DBS_DEC]  != paCamposAdicionales[i,DBS_DEC]

          aEstructura[FIELDPOS(paCamposAdicionales[i,DBS_NAME]),DBS_TYPE] := paCamposAdicionales[i,DBS_TYPE]
          aEstructura[FIELDPOS(paCamposAdicionales[i,DBS_NAME]),DBS_LEN]  := paCamposAdicionales[i,DBS_LEN]
          aEstructura[FIELDPOS(paCamposAdicionales[i,DBS_NAME]),DBS_DEC]  := paCamposAdicionales[i,DBS_DEC]

          //MsgStop('El campo: '+'[ '+paCamposAdicionales[i,DBS_NAME]+' ]'+' en '+pcDestino+'.DBF, ya existe en la base de datos, y SI se modifico sus propiedades','Campo Modificado...')
       ELSE
          //MsgStop('El campo: '+'[ '+paCamposAdicionales[i,DBS_NAME]+' ]'+' en '+pcDestino+'.DBF, ya existe en la base de datos, y NO se modifican sus propiedades','Campo no modificado...')
       ENDIF
    ENDIF
    sysrefresh()
  NEXT

  SELECT copiaestructura
  CLOSE  copiaestructura
  //Efectuar la copia
  DBCREATE(pcDestino,aEstructura)
 RETURN(NIL)//**************************************************************************************************************************//

//****************************************************************************************************************************//
// Funcion para Determinar si existe el campo en el area indicada , Rafael Morf¡n  1998 */
 //****************************************************************************************************************************//
STATIC FUNCTION ExisteCampo(pCampo) //****************************************************************************************//
  // Variables LOCALes
  LOCAL i:=0
  // Cuerpo de la Funcion
  FOR i = 1 To fCount()
     IF UPPER(FieldName(i))== UPPER(pCampo)
        RETURN(.t.)
     ENDIF
  NEXT
RETURN(.f.) //************************************************************************************************************************//

[sambomb]

Thx for reply, but I Can't use append from.

[James Bott]

but I Can't use append from

Please explain why you can't.

James

[ukservice]

Mr Sambomb,

Yes I understand what you want. Just in the fly add a new field to an existing DBF (a.e. AddField( "newfield", "C", 100), but I don´t think there is a function for that.

You may ask at Harbour forums.

I send the most likely approach. Sorry.

[reinaldocrespo]

Now days I let the ADS server take care of those type of operations by simply executing the Alter table SQL command. Before I used ADS, I remember doing something -sort of- like this:

Code: Select all  Expand view

     While !(cAlias)->( eof() ) .and. !isCancel
         if !(calias)->( deleted() )
             temp->( dbappend() )
             aeval( aStruc, { |e,n| iif( ( i:=(calias)->( fieldPos( temp->( fieldname( n ) ) ) ) ) > 0, ;
                             temp->( fieldPut( n, (calias)->( fieldget( i ) ) ) ), ) } )
             oMeter:Set( (calias)->( recno() ) ) ; oMeter:refresh()
         endif
         (calias)->( dbskip() )
     end

 

Here you create the new table with the new structure and all fields with same names would be copied from the original table to the new. Anyway, the code above gives you an idea on how to do it.

Hope that helps,


Reinaldo.

[Bayron]

I think that it is not possible to Add a field to a database on the fly without losing the data in it;

However, on small databases what is done is creating a new database from structure, add the field on the fly and then copy the registers to the new database...

Taking this under consideration, It may be a good practice for us leaving some extra unused fields, in case of future expansion of the database... that only if fields can be renamed without losing data. Maybe Mr. Rao can give us a explanation from his vast experience....

[James Bott]

In order to add a field, the header of the DBF has to be made longer and you cannot do this without copying the entire file to a new file.

You could change a fieldname without copying the entire file, since you are just overwriting and existing fieldname. You would have to use fopen() and fwrite() to do this. This is a little tricky since there is an end-of-fieldname marker and the end of the fieldname which must be moved too. Of course, the DBF cannot be in use while this is done.

So, in order to make any structure changes to a DBF you are going to have to have exclusive use of the file. And since you must have exclusive use, then I don't see why you can't use APPEND FROM.

Regards,
James

[ukoenig]

Copy Fields from DBF 1 to DBF 2 without use of APPEND FROM

viewtopic.php?f=3&t=20625&p=109363&hilit=fieldput#p109363

Best Regards
Uwe

[James Bott]

Uwe,

You can do this but it is much slower than APPEND FROM. I remember it being like 10 times slower.

James

[sambomb]

Copy Fields from DBF 1 to DBF 2 without use of APPEND FROM

viewtopic.php?f=3&t=20625&p=109363&hilit=fieldput#p109363

Best Regards
Uwe

Uwe, I need to replace fields with the same name but different types.. there is my actual function:

Code: Select all  Expand view

****************************************************************************
Function ModStruct( aMods, poMeter, poText )
****************************************************************************
* Modificar a estrutura de uma tabela
* Parâmetros: aMods
*             {cTipoMod,;//"DROP" para remover e "MOD" para modificar/adicionar
*              aStruct ,;//Matriz com a estrutura nova para o campo
*              bEval}    //Bloco a ser validado ao repassar o campo
* Retorno:
* Autor: Samir Abreu
* 4/12/2010 - 11:55:43
****************************************************************************
Local i := 0,  nScan := 0, cNomeDbf := "", cTipoMod := "",;
      cTimeIni := Time(), aLog := {}, bCode
Local cInitTime := Time(), cNewTime := "", nReg := 0
Local nSecPassado := 0, nCalcReg := 0, nSec := 0


Private  aStruct := DbStruct(), aOldStruct := DbStruct(), aValues := {},;
         aEvals := {}, nCOntador := 1, aAux := {}, cAlias := Alias()
Private  P_aMods := {}

   Default poMeter := oMeter, poText := oText

   //-- Verificar modificações necessárias
   poText:SetText( "Verificando modificações necessárias" )

   poMeter:nTotal := Len(aMods)

   For i := 1 to Len(aMods)

      poMeter:Set( i )

      cTipoMod := aMods[i,1]

      If Empty(cTipoMod)
         cTipoMod := ""
      end

      //-- Pesquisar o nome do campo na estrutura
      nScan := aScan(aStruct, {|x| x[1] == aMods[i,2,1]} )

      //-- Verificar o tipo de modificação a ser feita
      if cTipoMod = "MOD"        //-- Adição/Modificação do campo

         //-- Verificar se é adição
         If nScan = 0

            //-- Adicionar a estrutura de referência
            aAdd(aStruct,aMods[i,2])

         //-- Modificação
         else

            //-- Modificar a estrutura de referência
            aStruct[nScan] := aMods[i,2]

         end

      //-- Remoção de campo
      elseif cTipoMod = "DROP"   //-- Remoção do campo

         //-- Se o campo existe, remove da estrutura de referência
         If nScan > 0

            aDel(aStruct,nScan)
            aSize(aStruct,Len(aStruct)-1)

         end

      end

   end

   //-- Criar tabela temporária com o formato correto
   poText:SetText( "Criando arquivo temporário" )

   while .T.

      cNomeDbf := "T"+strtran(Time(),":")             //-- Nome para o arq. temporario

      if !file(cNomeDbf+".DBF")
         DbCreate(pDir + cNomeDbf+".DBF",aStruct)     //-- Cria o temp. com a nova estrut.
         exit
      end

      Msg("Tentando criar temp " + cNomeDbf + ".DBF .")

   end

   DbCreate(pDir+cNomeDbf,aStruct)

   //-- Abrir a tabela temporária
   If !Net_Use(cNomeDbf,,"E")

      Msg("Erro ao abrir o arquivo temporário")

      Return .T.

   end

   //-- Realizar validações e verificar repasses necessários
   poText:SetText( "Verificando validações/repasses necessários" )

   poMeter:nTotal := Len(aOldStruct)

   //-- Rodar a estrutura antiga verificando os campos a serem repassados
   For i := 1 to Len(aOldStruct)

      poMeter:Set( i )

      //-- Pesquisar na lista da nova estrutura o nome do campo da tabela antiga
      nScan := aScan(aStruct,{|X| x[1] == aOldStruct[i,1]  })

      //-- Verificar se o campo foi removido
      If nScan > 0

         //-- Verificar se os campos são compativeis
         If (aStruct[nScan,2] == aOldStruct[i,2]   .And.;
             aStruct[nScan,3] >= aOldStruct[i,3]   .And.;
             aStruct[nScan,4] >= aOldStruct[i,4])

            //-- Adicionar na lista de validações e gravar os valores
            //-- atuais das variáveis na matriz auxiliar
            aAdd(aEvals, {|| RepInfo( ) } )
            aAdd(aAux,   { nScan,i, cAlias } )

         else

            //-- Caso seja uma redução de caracter executa uma validação
            //-- automática para pegar apenas os caracteres a esquerda
            If (aStruct[nScan,2] =  "C" .And. aOldStruct[i,2]  = "C")

               //-- Adicionar na lista de validações e gravar os valores
               //-- atuais das variáveis na matriz auxiliar
               aAdd(aEvals, {|| RepInfo( .T. ) } )
               aAdd(aAux,   { nScan,i, cAlias } )

            end

         end

      end

   End

   //-- Zerar variáveis para não gerar valores errados
   nScan := 0
   i     := 0

   //-- Verificar validações passadas por parâmetro
   For i := 1 to Len(aMods)

      //-- Verificar se foi passado o parâmetro de validação
      If Len(aMods[i]) >= 3

         //-- Verificar preenchimentoe do parâmetro
         If !Empty(aMods[i,3])

            //-- Verificar se é um bloco válido
            If ValType(aMods[i,3]) = "B"

               //aAdd(aEvals, aMods[i,3])

               aAdd(aEvals, {|| RepInfo( .F.,.T. ) } )
               aAdd(aAux,   { nScan,i, cAlias } )

            //-- Verificar se é um bloco a ser criado
            elseIf ValType( &(aMods[i,3]) ) = "B"

               aAdd(aEvals, &(aMods[i,3]) )

            //-- Caso não seja passa como valor fixo
            else

               //-- Adicionar na lista de validações e gravar os valores
               //-- atuais das variáveis na matriz auxiliar
               aAdd(aEvals, {|| RepInfo( .F.,.T. ) } )
               aAdd(aAux,   { nScan,i, cAlias } )

            end

         end

      end

   end

   //-- Gravar o parâmetro em uma váriavel private para dar visibilidade
   P_aMods := aMods

   //-- Repassar as informações para a tabela auxiliar
   Select(cAlias)

   #IFDEF __ADSACTIVE__
      ActiveDialog():SetText( "Efetuando repasses da tabela "+cAlias )
   #ENDIF

   //-- Rodar toda a tabela original
   Count to poMeter:nTotal

   DbGoTop()

   cInitTime := Time()

   While !Eof()

      nReg := RecNo()

      poMeter:Set( nReg )

      //-- Adicionar um registro na tabela auxiliar
      Select(cNomeDbf)

      AddRec()

      //-- Iniciar o contador para ser usado no repasse
      nContador := 1

      //-- Roda todos os repasses necessários
      For i := 1 to Len(aEvals)

         //-- Verificar se é um bloco de código válido
         If ValType( aEvals[i] ) = "B"
            bCode :=  aEvals[i]
         //-- Verificar se é um bloco de código a ser verificado
         elseif ValType( &( aEvals[i] ) ) = "B"
            bCode :=  &( aEvals[i] )
         end

         //-- Se for a ultima validação
         If i = Len(aEvals)
         
            //-- Liberar a função de gravar MD5
            lTravaMD5 := .F.

            //-- Validar o bloco de código
            Eval( bCode )

            //-- Desabilitar a função de gravar o MD5
            lTravaMD5 := .T.
           
         else

            //-- Validar o bloco de código
            Eval( bCode )
         
         end

      end

      //-- Realizar a verificação a cada 5 segundos
      If nSec != Secs(Time())

         //-- Gravar o novo tempo
         nSec := Secs(Time())

         If Mod(nSec,5) = 0

            //-- Calcular o tempo restante
            nSecPassado := Secs( ElapTime( cInitTime, Time( ) ) )

            nCalcReg    := (poMeter:nTotal / nReg )
            nCalcReg    := ( nSecPassado * nCalcReg ) - nSecPassado
            nCalcReg    := Round( nCalcReg, 0 )

            If nCalcReg = 0
               nCalcReg++
            end

            cNewTime := TString( nCalcReg )

            //-- Exibir a mensagem com o tempo e número de registros
            poText:SetText("Previsão: " + cNewTime +;
                           "   |   Registro: "+UT( nReg ) + " de " +Ut( poMeter:nTotal ) )

         end

      end

      //-- Ir para o próximo registro da tabela original
      Select(cAlias)
      DbSkip()

   end

   DbCommitAll()
   
   lTravaMD5 := .F.

   //-- Fechar a tabela original e temporária para fazer a troca
   Select(cAlias)

   DbCloseArea()

   Select(cNomeDbf)

   DbCloseArea()

   //-- Apagar a original
   fErase(pDir+cAlias+".DBF")

   //-- Renomear a auxiliar para o nome da original
   fRename(pDir+cNomeDbf+".DBF", pDir+cAlias+".DBF")

   If !Net_Use(cAlias)

      Msg("Erro ao abrir o arquivo repassado")

      Return .F.

   end

   #IFDEF __ADSACTIVE__
      ActiveDialog():SetText( "Efetuando repasses da tabela "+cAlias )
   #ENDIF

   //-- Gravar log de tempo
   #IFDEF __TRADE__

   If File("C:\Tempo.txt")

      CreateTxt("C:\Tempo.txt", MemoRead("C:\Tempo.txt")+CRLF+;
                "Data=" + Dtoc( Date() ) +;
                " |Alias=" + cAlias +" | Ini="+cTimeIni+;
                " | Fim=" + Time( ) +" | Tot="+ElapTime(cTimeIni,Time()))

   else

      CreateTxt("C:\Tempo.txt",;
                "Data=" + Dtoc( Date() ) +;
                " |Alias=" + cAlias + " | Ini="+cTimeIni+;
                " | Fim=" + Time( ) + " | Tot="+ElapTime( cTimeIni, Time( ) ) )

   end

   #ENDIF

Return .T.
/**************************************************************************/
 

There is a sample of how I call this function

Code: Select all  Expand view

****************************************************************************
static procedure StruPedidos(oMeter,oText,plRede)
****************************************************************************
local cAlias := Alias(), aFields := {}, lRepassar:= .f.

   barra("Aguarde, verificando a estrutura do " + cAlias +" ...")

   if fieldpos("LOTE") = 0 .Or. FieldInfo("LOTE",3) != 20
      aAdd(aFields,{"MOD",{"LOTE","C",20,0}})
   End
   if fieldpos("FILIAL") = 0
      aAdd(aFields,{"MOD",{"FILIAL","C",03,0}})
   End
   if fieldpos("COMISSAO") = 0
      aAdd(aFields,{"MOD",{"COMISSAO","N",06,2}})
   End
   if fieldpos("CONTEXP") <= 0
      aAdd(aFields,{"MOD",{"CONTEXP","N",06,0},1})
   end
   if fieldpos("DATAEXP") > 0
      aAdd(aFields,{"DROP",{"DATAEXP"}})
   End
   if fieldpos("Q_BAIXA") <= 0
      aAdd(aFields,{"MOD",{"Q_BAIXA","N",9,3}})
   end
   if fieldpos("DEVOLVIDO") <= 0
      aAdd(aFields,{"MOD",{"DEVOLVIDO","N",9,3}})
   end
   if FieldInfo("DEVOLVIDO",3) != 9 .or. FieldInfo("DEVOLVIDO",4) != 3
      aAdd(aFields,{"MOD",{"DEVOLVIDO","N",9,3}})
   end
   if fieldinfo("DESCO",3) = 5
      aAdd(aFields,{"MOD",{"DESCO","N",6,2}})
   endif
   if fieldpos("PARC") <= 0
      aAdd(aFields,{"MOD",{"PARC","C",4,0}})
   end
   if fieldpos("COMI_PARC") <= 0
      aAdd(aFields,{"MOD",{"COMI_PARC","D",8,0}})
   end
   if fieldpos("PARCEIRO") > 0
      aAdd(aFields,{"DROP",{"PARCEIRO"}})
   End
   if fieldpos("PARCECOMI") > 0
      aAdd(aFields,{"DROP",{"PARCECOMI"}})
   End
   if fieldpos("BXAESTOQ") <= 0
      aAdd(aFields,{"MOD",{"BXAESTOQ","C",1,0}})
   end
   if fieldpos("MOTPERCON") <= 0
      aAdd(aFields,{"MOD",{"MOTPERCON","C",3,0}})
   end
   if fieldpos("NRSERIEFAB") <= 0
      aAdd(aFields,{"MOD",{"NRSERIEFAB","C",20,0}})
   End
   if fieldpos("ALIQUOTA") <= 0
      aAdd(aFields,{"MOD",{"ALIQUOTA","C",4,0}})
   end
   if fieldpos("UN") <= 0
      aAdd(aFields,{"MOD",{"UN","C",2,0}})
   end
   if fieldpos("NR_LOCAL") <= 0
      aAdd(aFields,{"MOD",{"NR_LOCAL","N",6,0}})
   end
   if fieldpos("ATUSERV") <= 0
      aAdd(aFields,{"MOD",{"ATUSERV","C",1,0}})
   end
   if fieldpos("DECVRPRO") <= 0
      aAdd(aFields,{"MOD",{"DECVRPRO","N",1,0}})
   end
   if fieldpos("SERVICOPRO") <= 0
      aAdd(aFields,{"MOD",{"SERVICOPRO","C",1,0}})
   end
   if fieldpos("PRLIQUIDO") <= 0
      aAdd(aFields,{"MOD",{"PRLIQUIDO","N",12,2}})
   end
   if fieldpos("ALIQ_IND") <= 0
      aAdd(aFields,{"MOD",{"ALIQ_IND","C",2,0}})
   end
   if fieldpos("CCF") > 0
      aAdd(aFields,{"DROP",{"CCF"}})
   End
   if fieldpos("COO") <= 0
      aAdd(aFields,{"MOD",{"COO","N",6,0}})
   end
   if fieldpos("ACRESCIMO") <= 0
      aAdd(aFields,{"MOD",{"ACRESCIMO","N",6,2}})
   end
   if fieldpos("SEQUENCIA") > 0 .Or. fieldpos("SEQCUPOM") > 0
      if fieldpos("SEQCUPOM") > 0
         aAdd(aFields,{"DROP",{"SEQCUPOM"}})
         aAdd(aFields,{"MOD",{"SEQCUPFIS","N",3,0},{||PEDIDOS->SEQCUPOM}})
      elseif fieldpos("SEQUENCIA") > 0
         aAdd(aFields,{"DROP",{"SEQUENCIA"}})
         aAdd(aFields,{"MOD",{"SEQCUPFIS","N",3,0},{||PEDIDOS->SEQUENCIA}})
      end
   End
   if fieldpos("SEQCUPFIS") <= 0
      aAdd(aFields,{"MOD",{"SEQCUPFIS","N",3,0}})
   End
   if fieldpos("PRCUSTO") <= 0
      aAdd(aFields,{"MOD",{"PRCUSTO","N",12,2}})
   end
   if fieldpos("APLIPROMO") <= 0
      aAdd(aFields,{"MOD",{"APLIPROMO","C",01,0}})
   end
   if fieldpos("SERVICO") <= 0
      aAdd(aFields,{"MOD",{"SERVICO","C",06,0}})
   end
   if fieldpos("TAXA") <= 0
      aAdd(aFields,{"MOD",{"TAXA","N",06,3}})
   end
   if fieldpos("SINAL") <= 0
      aAdd(aFields,{"MOD",{"SINAL","N",12,2}})
   end
   if fieldpos("APLIATAC") <= 0
      aAdd(aFields,{"MOD",{"APLIATAC","C",01,0}})
   end
   if fieldpos("ENTSTATUS") <= 0
      aAdd(aFields,{"MOD",{"ENTSTATUS","C",10,0},{||"IGNORADO"}})
   end
   if fieldpos("CODENTREGA") <= 0
      aAdd(aFields,{"MOD",{"CODENTREGA","C",06,0},{||"000000"}})
   end
   if fieldpos("QTDENTREGA") <= 0
      aAdd(aFields,{"MOD",{"QTDENTREGA","N",09,3}})
   end
   if fieldpos("ENTREGUES") <= 0
      aAdd(aFields,{"MOD",{"ENTREGUES","N",09,3}})
   end
   if FieldInfo("CLIENTE",3) == 4
      aAdd(aFields,{"MOD",{"CLIENTE","C",05,0},{||SZero(CLIENTE,5) }})
   end
   if fieldpos("RESERVA") <= 0
      aAdd(aFields,{"MOD",{"RESERVA","N",10,3}})
   end
   if fieldpos("DESCOFIM") <= 0
      aAdd(aFields,{"MOD",{"DESCOFIM","C",01,0}})
   end
   if fieldpos(CAMPOMD5) <= 0
      aAdd(aFields,{"MOD",{CAMPOMD5,"C",32,0},"{||GeraMd5Reg()}"})
   end
   if fieldpos("CONTMOVECF") <= 0          
      aAdd(aFields,{"MOD",{"CONTMOVECF","C",10,0}})  //-- Contador do movimento ecf
   endif
   if fieldpos("NRSERIE") = 0              
      aAdd(aFields,{"MOD",{"NRSERIE","C",20,0}})
   endif
   if fieldpos("IAT") = 0                  
      aAdd(aFields,{"MOD",{"IAT","C",1,0}})
   endif
   if fieldpos("MFADIC") = 0                
      aAdd(aFields,{"MOD",{"MFADIC","C",1,0}})
   endif
   if fieldpos("ECFMODELO") = 0            
      aAdd(aFields,{"MOD",{"ECFMODELO","C",20,0}})
   endif
   if fieldpos("ECFNRUSU") = 0              
      aAdd(aFields,{"MOD",{"ECFNRUSU","N",2,0}})
   endif
   if Len(aFields) > 0
      ModStruct( aFields, oMeter, oText )
   end

   barra()

return nil
 

[derpipu]

Hi, my name is Luis Fernando Rubio Rubio, i'm from Tequila, Jalisco, México

i'm a Function ModifyStruct() creator, in fact i have a new version with more capabilites, if anybody wants this new version, please contact at e-mail: rubio.luisfernando@gmail.com

regards

LF

[Daniel Garcia-Gil]

Luis

Hello, can you post a link to download. ? Thank you

Hola, puedes colocar un link de descarga.? Gracias

[sambomb]

Luis Fernando, puedes colocar un link de descarga?

[derpipu]

Hello everybody, here is a full code of modstruct.prg
Hola a todos, este es el codigo completo de mi funcion modstruc.prg

regards
saludos

Code: Select all  Expand view

***********************************************************************************
*  [ Funciones para hacer modificaciones en estructuras de DBF... ]               *
*  1.- Function MsgCopia(cOrigen,cDestino)                                        *
*  2.- Function Respaldo(oMeter, oText, oDlg, lend, cOrigen, cDestino)            *
*  3.- Function ModifyStruct(cRutaLogica,cBaseDatos,aCambios,aNewStruct,lMensaje) *
*  4.- function ReemplazaCampos(cDBF,cCAMPO,xVALUE,cCondicion,lMENSAJE)           *
*  5.- Function CopiaEstructura(cOrigen,cDestino,aCambios)                        *
*  6.- Function ExisteCampo(cCampo)                                               *
*  7.- Function CambiaNombre(cDBF,nField,cNewName)                                *
*                                                                                 *
* Ultimas modificaciónes: 21 de Julio   de 2000  Luis Fernando Rubio Rubio        *
*                         24 de Febrero de 2003  Bingen Ugaldebere                *
***********************************************************************************

#INCLUDE "FIVEWIN.CH"
#include "DBSTRUCT.CH" // Cabeceras de referencia de estructuras de Bases de DATOS
#include "FILEIO.CH"   // Cabeceras de manejo de archivos a bajo nivel

/********************************************************************************************
 Función para hacer la modificación de las estructuras de bases de datos
 Function ModifyStruct(cRutaLogica,cBaseDatos,aCambios,aNewStruct,lMensaje)
          Donde cRutaLogica es el directorio a donde esta la base de datos
          Donde cBaseDatos es el nombre de la base de datos a modificar
          Donde aCambios es un Array de modificaciones con multiples array 1 por campo a modificar
              Donde cTipoMod es el tipo de modificación + - * (OPCIONAL si no se indica es +)
                    +(Añadir o cambiar campo) -(Eliminar campo) o *(Cambiar nombre de campo)
              Donde cNomCampo es el nombre del campo nuevo
              Donde cTipo es el tipo del campo (Numerico,Caracter,Date,Memo)
              Donde nTama es el tamaño del campo nuevo
              Donde nDeci es el numero de decimales que tendra el campo (si se requiriera)
              Donde xValue es el valor a reemplazar en el campo para todo el archivo
              Donde cCondicion es una expresion de tipo caracter que incluye una condición
                    a evaluar antes de hacer el reemplazo anterior
          Donde aNewStruct es una estructura nueva completa a crear y es compatible
                con aCambios puediendo usarse uno otro o los dos a la vez
          Donde lMensaje es si se quiere mensaje mientras se efectua el proceso
********************************************************************************************/

Function ModifyStruct( cRutaLogica, cBaseDatos, aCambios, aNewStruct, plMensaje )
  Local cArcResp := "", oData := nil
  Local aEstructura := {}, lCopiado := .F.
  LOCAL nHandle, cByte := Space(1)

  DEFAULT cRutaLogica := cFilePath( GetModuleFileName( GetInstance())),;
          cBaseDatos := cFileNoExt(cBaseDatos),;
          aCambios:=ARRAY(0),;
          aNewStruct:=ARRAY(0),;
          plMensaje:=.T.


  if len( aCambios ) = 0 .and. len( aNewStruct ) = 0
   MsgStop("Los parámetros de cambios en la estructura son incorrectos","Modificación de estructura", "Error de Estructura..."); return( .F. )
  elseif ! file( cRutaLogica + cBaseDatos + ".DBF") .and. len( aNewStruct ) = 0
    MsgInfo("No se proceso el archivo: " + upper(cRutaLogica) + upper(cBaseDatos) + ".DBF, es necesario que al finalizar se contacte con su Asesor de Sistemas..." )
    return(.F.)
  endif

  cRutaLogica := STRTRAN( cRutaLogica + "\", "\\", "\" )  //cRutaLogica SIEMPRE TERMINARÁ EN \

*  oApp:oSay:settext('Modificando: ' + UPPER(cRutaLogica+cBaseDatos)+ '...')

  //Buscar el DBF y su DBT/FPT para si existen, hacer copia de seguridad
  if File( cRutaLogica + cBaseDatos + ".DBF")

     //Si no la hay crear carpeta de BACKUP
     if ! lIsDir( cRutaLogica+"BACKUP" )
        lMkDir( cRutaLogica+"BACKUP" )
     endif

     // Se crea un archivo de respaldo Consecutivo
     cArcResp  := ArcProv( '.DBF', cRutaLogica+"BACKUP\", 0, LEFT( cBaseDatos, 3 ) )
     MsgCopia(cRutaLogica+cBaseDatos+'.DBF', cArcResp)

     lCopiado:=.T.

     //Comprobar existencia de archivos de campos memo NTX/CDX y hacer copia de seguridad
     if File( cRutaLogica + cBaseDatos + '.DBT' )
        MsgCopia( cRutaLogica + cBaseDatos + '.DBT', STRTRAN( cArcResp, ".DBF", ".DBT" ) )
     endif

     if File(cRutaLogica+cBaseDatos+'.FPT')
        MsgCopia(cRutaLogica+cBaseDatos+'.FPT',STRTRAN(cArcResp,".DBF",".FPT"))
     endif
  endif

  //Procesar aCambios que es la tabla que lleva la informacion de los cambios a efectuar
  CURSORWAIT()

  if len( aNewStruct ) > 0  //Nueva estructura completa
   Dbcreate( cRutaLogica + cBaseDatos, aNewStruct )
  endif

  if len( aCambios ) > 0   //Modificaciones sobre la estructura actual
   for nITEM :=1 TO len( aCambios )
    if ! aCambios[ nITEM, 1 ]$"+-*"
     asize( aCambios[ nITEM ], len( aCambios[ nITEM ] ) + 1 )
     AINS( aCambios[ nITEM], 1 )
     aCambios[ nITEM, 1 ] := "+"
    endif
   next

   if ! CopiaEstructura( cArcResp, cRutaLogica+cBaseDatos, aCambios )
    Return .F.
   endif
  endif

  //Abre archivo modificado y carga en el los datos de la copia de seguridad
  if ! net_use(cBaseDatos,,,cRutaLogica) // 14/05/2007 01:44p. LFRR
  *DBUSEAREA(.T.,,cRutaLogica+cBaseDatos,,.T.)
  *if NETERR()  //Error de apertura
   *MsgStop("Problema al abrir el archivo: "+cRutaLogica+cBaseDatos,"Modificación de estructura")
   Return .F.
  endif
  DATABASE oData


  /*if lCopiado
   if plMensaje
    *WAITON( "Realizando cambios en la estructura de " + cRutaLogica+cBaseDatos )
    MsgWait( "Realizando cambios en la estructura de " + cRutaLogica+cBaseDatos,"", 0 )
   Else
    CURSORWAIT()
   endif

   Append From (cArcResp)

   if plMensaje
    *WAITOFF()
   endif
  endif*/

  if lCopiado
    if plMensaje
      MsgWait( "Realizando cambios en la estructura de " + cRutaLogica+cBaseDatos,"", 0 )
    endif
    Append From (cArcResp)
  endif

  oData:CLOSE()

  //Cargar estructura nueva
  aEstructura = DBStruct()

  //Modificar nombres de campos de la estructura Bingen
  for nItem = 1 To len(aCambios)
    if aCambios[nItem,1]="*"
      for nCampo:=1 TO len(aEstructura)
        if aEstructura[nCampo,DBS_NAME] == UPPER(aCambios[nItem,DBS_NAME+1])
          CAMBIANOMBRE( cRutaLogica+cBaseDatos, nCampo, UPPER(aCambios[nItem,DBS_NAME+2]) )
          EXIT
        endif
      next
    endif
  next

  if len(aCambios)>0   //Modificacion de contenidos de campos
    for nITEM:=1 TO len(aCambios)
      if len(aCambios[nITEM])>5
        ReemplazaCampos( cRutaLogica + cBaseDatos, upper( aCambios[ nItem, DBS_NAME + 1 ] ) , aCambios[ nItem, 6 ], if( len( aCambios[nITEM])=7,aCambios[nItem,7],".T."))
      endif
    next
  endif

  CURSORARROW()

Return .T.


// ---  08.07.2000 LFRR   Ahora compara si existe el campo y su estructura si es igual asi lo deja y si no lo modifica  LRRR RMN
Function CopiaEstructura( cOrigen, cDestino, aCambios )
  Local aEstructura:={}, nITEM:=0, oORIGEN

  //Abre archivo modificado y carga en el los datos de la copia de seguridad
  if ! net_use( cFileNoPath(cOrigen),,,cFilePath(cOrigen) )
//  DBUSEAREA(.T.,,cORIGEN,,.T.)
//  if NETERR()  //Error de apertura
   Return .F.
  endif

  DATABASE oORIGEN

  *if NetErr()
  *  MsgStop("Problema al abrir el archivo de origen: "+cOrigen,"Modificación de estructura")
  *  Return .F.
  *endif

  //Cargar estructura antigua
  aEstructura = DBStruct()

  //Añadir campos Adicionales
  for nItem = 1 To len(aCambios)
    do case
      /*agregar campos adicionales o modificarlos, ya se en su nombre, */
      case aCambios[nItem,1]="+" //Añadir campos Adicionales o modificarlos
        if ! ExisteCampo( aCambios[nItem,DBS_NAME+1] )  //Si no existe agregar a la estructura
          aAdd( aEstructura, { aCambios[nItem,DBS_NAME+1], aCambios[nItem,DBS_TYPE+1], aCambios[nItem,DBS_LEN+1], aCambios[nItem,DBS_DEC+1] } )
        else                                   //Si existe modificarlo
          if aEstructura[ fieldpos( aCambios[ nItem, DBS_NAME + 1 ] ), DBS_TYPE ] != aCambios[ nItem, DBS_TYPE + 1 ] .or.;
             aEstructura[ fieldpos( aCambios[ nItem, DBS_NAME + 1 ] ), DBS_LEN ]  != aCambios[ nItem, DBS_LEN  + 1 ] .or.;
             aEstructura[ fieldpos( aCambios[ nItem, DBS_NAME + 1 ] ), DBS_DEC ]  != aCambios[ nItem, DBS_DEC  + 1 ]

             aEstructura[ fieldpos( aCambios[ nItem, DBS_NAME + 1 ] ), DBS_TYPE ] := aCambios[ nItem, DBS_TYPE + 1 ]
             aEstructura[ fieldpos( aCambios[ nItem, DBS_NAME + 1 ] ), DBS_LEN ]  := aCambios[ nItem, DBS_LEN  + 1 ]
             aEstructura[ fieldpos( aCambios[ nItem, DBS_NAME + 1 ] ), DBS_DEC ]  := aCambios[ nItem, DBS_DEC  + 1 ]
          endif
        endif

      case aCambios[nItem,1]="-" //Eliminar campos de la estructura Bingen
        for nCampo :=1 to len( aEstructura )
          if aEstructura[nCampo,DBS_NAME] == UPPER(aCambios[nItem,DBS_NAME+1])
            adel(aEstructura,Ncampo)
            asize(aEstructura,len(aEstructura)-1)
            EXIT
          endif
        next
    endcase
  next

  oORIGEN:CLOSE()

  //Crear archivo de destino con nueva estructura
  Dbcreate(cDestino,aEstructura)
Return .T.

// Reemplaza los campos del area especificada
Function ReemplazaCampos( cDBF, cCAMPO, xVALUE, cCondicion, plMensaje )
  local oData
  default cCondicion := ".T.", plMensaje := .T.

  if ! net_use( cDbf )
    *DBUSEAREA(.T.,,cDBF,,.T.)
  *if NETERR()  //Error de apertura
  * MsgStop("Imposible abrir archivo: "+cRutaLogica+cBaseDatos+" en modo exclusivo.","Error de Reemplazo de campos")
   Return .F.
  endif
  DATABASE oData
  oData:bEOF:={|| NIL }

  for nITEM = 1 To oData:fCount()
    if Upper( oData:FieldName( nITEM ) )== Upper( cCAMPO )
       if VALTYPE( oData:FIELDGET( nITEM ) ) == VALTYPE(xVALUE)
         if plMensaje
            *WAITON("Reemplazando campo "+cCampo+" en "+cDBF)
            MsgWait("Reemplazando campo "+cCampo+" en "+cDBF,"",0)
         endif

         DO WHILE ! oData:EOF()
          if &cCONDICION
           oData:FIELDPUT(nITEM,xVALUE)
           oData:SAVE()
          endif
          oData:SKIP()
         ENDDO
         if plMensaje
            *WAITOFF()
         endif
       ELSE
         MSGSTOP("Imposible modificar campo "+oData:FieldName( nITEM )+;
                 "con "+cVALTOCHAR(xValue)+" Tipo de dato incorrecto ","Error de Reemplazo de campos")
       endif
    endif
  next

  oData:CLOSE()

return(nil)

//Cambia el nombre del campo nº nField por el nuevo nombre cNewName
STATIC Function CAMBIANOMBRE( cDBF, nField, cNewName )
LOCAL nHandle,nPos    := ( nField * 32  )
 CURSORWAIT()
 if ( nHandle := fopen( cDBF+".DBF", FO_READWRITE ) ) <> - 1
    fseek( nHandle, nPos, FS_SET )
    fwrite( nHandle, padr( cNewName, 10 ) + chr( 0 ), 11 )
    fclose( nHandle )
    Return .T.
 endif
 CURSORARROW()
Return .F.

//****************************************************************************************************************************//
// Esta funcion crea un nombre de archivo consecutivo..
// modo de uso:
// ArcProv('.DBF',pcRutaLogica,0,LEFT(pcBaseDatos,3))
//****************************************************************************************************************************//

STATIC FUNCTION ArcProv(pcExtension,pcRuta,pIncrementar,pcPrefijo)   //Devuelve el nombre de un archivo provisional
    LOCAL i := 0,;
          m := 0,;
          cRuta := '',;
          cNombre := '',;
          nInc := 0

    if pcount()>=3  //Se dio el parametro pIncrementar
       nInc := pIncrementar
    endif

    if pcPrefijo = Nil
        pcPrefijo :='TMP'
    endif

    if pcount()=1
       if !empty(gete("TMP"))
          cRuta=gete("TMP")
       ELSEif !empty(gete("TEMP"))
          cRuta=gete("TEMP")
       endif

       if !empty(cRuta)
          if subst(cRuta,len(cRuta),1)!="\"
             cRuta+=''
          endif
       endif
    ELSE
       cRuta := pcRuta
    endif

    for i := 1 to 99999
        cNombre := cRuta+;
                   pcPrefijo+;
                   strzero(i+nInc,5)+;
                   pcExtension
        if !file(cNombre)
           m := fcreate(cNombre,0)
           fclose(m)
           RETURN cNombre
        endif
    next
RETURN('')



//----------------------------------------------------------------------------//
*******************************************************************
*  MENSAJE CON ESPERA PERMANENTE HASTA QUE SE EJECUTE  WAITOFF()  *
*******************************************************************

FUNCTION WAITON( cTEXT, cTitle)

     LOCAL nWidth
     LOCAL   bAction  := { || .t. }
     private ODLGWAIT := nil

     DEFAULT cTitle := "Espere un momento..."

   /*
      if VALTYPE( oDLGWAIT ) <> 'U'
         RETURN NIL
      endif
   */

     if cTEXT == NIL
          DEFINE DIALOG oDLGWAIT ;
               FROM 0,0 TO 3, len( cTitle ) + 4 ;
               STYLE nOr( DS_MODALFRAME, WS_POPUP )
     ELSE
          DEFINE DIALOG oDLGWAIT ;
               FROM 0,0 TO 4, Max( len( cTEXT ), len( cTitle ) ) + 4 ;
               TITLE cTitle ;
               STYLE DS_MODALFRAME
     endif

**   oDLGWAIT:bStart := { || .t. }
     oDLGWAIT:cMsg   := cTEXT

     nWidth := oDLGWAIT:nRight - oDLGWAIT:nLeft

     oDlgWait:lHelpIcon:=.F.

     ACTIVATE DIALOG oDLGWAIT CENTER ;
          ON PAINT oDLGWAIT:Say( 1, 0, xPadC( oDLGWAIT:cMsg, nWidth ) ) NOWAIT

     SYSREFRESH()
     CURSORWAIT()

RETURN NIL

FUNCTION WAITOFF()   // PARA CERRAR EL WAITON()

   if valtype(oDLGWAIT) <> 'U'  /* waiton has to be called first! */
      oDLGWAIT:end()
      oDLGWAIT := NIL
   endif
   oWND:SETFOCUS()
   SYSREFRESH()
   CURSORARROW()
RETURN NIL
//----------------------------------------------------------------------------//

// COPIA DE ARCHIVOS
Function MsgCopia( cOrigen, cDestino )
//   MsgProgress( { | oMeter, oText, oDlg, lEnd | Respaldo( oMeter, oText, oDlg, @lEnd, cOrigen, cDestino ) }, "Copiando a: " + cDestino, "Respaldando: " + cOrigen )
   MsgMeter( { | oMeter, oText, oDlg, lEnd | Respaldo( oMeter, oText, oDlg, @lEnd, cOrigen, cDestino ) }, "Copiando a: " + cDestino, "Respaldando: " + cOrigen )

Return(.t.)

// FUNCION QUE HACE LA ACCION DE COPIA DE ARCHIVOS
Function Respaldo(oMeter, oText, oDlg, lEnd, cOrigen, cDestino)
  Local forigen, fDestino
  Local nBuffer    := 8192        // Tamaño del Buffer en Bytes
  Local cBuffer := SPACE(nBuffer)
  Local Tamano := fsize(cOrigen), nLeido := 0, nEscrito := 0, nCopiados := 0

  oMeter:nTotal = Tamano

  forigen = fOpen(cOrigen)
  if fError() != 0
    MsgStop('No se Pudo Abrir el archivo '+cOrigen,'Error de Apertura')
    lEnd := .t.
    Return(Nil)
  endif

  fDestino = fCreate(cDestino)
  if fError() != 0
    MsgStop('No se Pudo crear el archivo '+cDestino,'Error de Creación')
    lEnd := .t.
    Return(Nil)
  endif

  DO While nCopiados < Tamano
    CURSORWAIT()
    nLeido = fRead(forigen, @cBuffer, nBuffer)

    if fError() != 0
      MsgStop('No se Pudo leer el archivo '+cOrigen,'Error de Lectura')
      lEnd := .t.
      fclose(forigen)
      fclose(fDestino)
      Return(Nil)
    endif

    nEscrito = fwrite(fDestino, cBuffer, nLeido)

    if fError() != 0
      MsgStop('No se Pudo escribir en el archivo '+cDestino,'Error de Escritura')
      lEnd := .t.
      fclose(forigen)
      fclose(fDestino)
      Return(Nil)
    endif

    nCopiados+=nLeido // Incrementa la cantidad de Bytes copiados hasta el momento...
    oMeter:Set( nCopiados )
    oMETER:Refresh()

  EndDo
  lEnd = .t.
  fclose(forigen)
  fclose(fDestino)

  CURSORARROW()
Return(Nil)