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?
// *****************************************************************************************************************************
// 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.) //************************************************************************************************************************//
but I Can't use append from
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
ukoenig wrote: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
****************************************************************************
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.
/**************************************************************************/
****************************************************************************
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
***********************************************************************************
* [ 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)
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: No registered users and 36 guests