***********************************************************************************
* [ 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) + ", NO EXISTE y es necesario que al finalizar se contacte con su Asesor de Sistemas..." )
return(.F.)
elseif file( cRutaLogica + cBaseDatos + ".DBF") .and. len( aNewStruct ) <> 0
MsgInfo("No se proceso el archivo: " + upper(cRutaLogica) + upper(cBaseDatos) + ", YA EXISTE y 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
? cOrigen, cDestino
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)