www.FiveTechSoft.com
by rolando » Wed Jul 03, 2013 2:19 pm
by derpipu » Wed Jul 03, 2013 2:49 pm
by karinha » Wed Jul 03, 2013 7:31 pm
CLOSE EMAILENV
USE EMAILENV NEW EXCLUSIVE ALIAS EMAILENV
cAlias := ALIAS()
lExiste := .F.
FOR nConta := 1 TO (cAlias)->(fCount())
IF (cAlias)->(FieldName(nConta)) = "HORAENVIO" // Nuevo campo ejiste?
lExiste := .T.
EXIT
ENDIF
NEXT
//-> Nao existe o campo, HORAENVIO vai criar
IF .NOT. lExiste
MsgNoYes ( "USUARIO ADVERTENCIA: " + CRLF +;
+ CRLF +;
"LA CREACIÓN DEL PROGRAMA necesidad detectada " + CRLF +;
"CAMPO DE LA FECHA DE ENVÍO DEL CORREO ELECTRÓNICO PARA " + CRLF +;
"CLIENTE NECESITA AUTORIZACION PARA CREAR " + CRLF +;
"EL CAMPO EN LA BASE DE DATOS DE EMAILS. " + CRLF +;
+ CRLF +;
"Para crear el campo, ningún otro usuario " + CRLF +;
"PUEDEN UTILIZAR EL PROGRAMA. " + CRLF +;
"Comprobar y confirmar la operación. " + CRLF +;
+ CRLF +;
"Elija una de las siguientes opciones: " + CRLF +;
+ CRLF +;
"[Si] -> Crear nuevo campo " + CRLF +;
"[No] -> no crear nuevo campo " ;
"Crear nuevo campo en la base de datos ...") =. F.
RETURN (. F.)
DBCLOSEAREA()
USE EMAILENV NEW EXCLUSIVE ALIAS EMAILENV
COPY TO EMAILCOP.DBF // HACER UNA COPIA ANTES
DBCLOSEAREA()
DbCreate( "EMAILENV.DBF", { { "CODC", "N", 10, 00 }, ;
{ "CONTATO", "C", 100, 00 }, ;
{ "DATAENVIO", "D", 08, 00 }, ;
{ "HORAENVIO", "C", 08, 00 } } ) // NUEVO CAMPO
DBCLOSEAREA()
USE EMAILENV NEW EXCLUSIVE ALIAS EMAILENV
APPEND FROM EMAILCOP.DBF
MsgMeter( { | oMeter, oText, oDlg, lEnd | ;
INDEXAR_EMAIL( oMeter, oText, oDlg, @lEnd ) },;
"Indexando Emails, Espere..." )
DBCLOSEAREA()
ENDIF
by rolando » Wed Jul 03, 2013 11:58 pm
by acuellar » Thu Jul 04, 2013 12:35 pm
by Antonio Linares » Thu Jul 04, 2013 2:34 pm
by derpipu » Thu Jul 04, 2013 6:00 pm
***********************************************************************************
* [ 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)
//Determinar si existe el campo en el area indicada, Rafael Morf¡n 1998
function ExisteCampo( pCampo)
local i:=0, mArea:=0, lExiste := .F.
for i=1 to fcount()
if upper(fieldname(i)) == upper(pCampo)
lExiste := .T.
endif
next
return(lExiste)
// *********************************************************************************************
// Fecha de Inicio del Proyecto: 17/01/2006 01:28p.
// Programador: Luis Fernando Rubio Rubio
// Empresa:
// Lenguaje de Desarrollo:
// Comentarios:
// *********************************************************************************************
#include "fivewin.ch"
#INCLUDE "fileio.ch"
function net_use( pcBaseDatos, plExclusivo, pcAlias, pcRuta, plOkDbf, plMensaje )
Local lContinuar := .F.
local oError
local cTabla := iif( valtype( pcRuta )$"U", ".\", pcRuta ) + pcBaseDatos
local nInicio := seconds()
local cAlias := iif( empty(pcAlias), cFileNoExt(pcBaseDatos), pcAlias )
default plExclusivo := .F., pcRuta := "", plOkDbf := .F., plMensaje := .T.//, pcAlias := cAlias //, pcBaseDatos := cFileNoExt(pcBaseDatos)
//? pcBaseDatos, pcAlias, pcRuta
if plOkDbf
if ! lOkDbf( pcRuta + pcBaseDatos )
return(lContinuar)
endif
endif
// ? pcRuta, pcBaseDatos, pcAlias, plExclusivo
// DBUSEAREA( .T., , pcRuta + pcBaseDatos, pcAlias, plExclusivo, .T.)
if plExclusivo
if empty(pcAlias)
use (pcRuta + pcBaseDatos) exclusive new
else
use (pcRuta + pcBaseDatos) alias (pcAlias) exclusive new
endif
else
if empty(pcAlias)
//use (pcRuta + pcBaseDatos) shared new
dbUseArea( .T., /*"DBFCDX"*/, pcRuta + pcBaseDatos, pcAlias, .T., .F. )
else
//use (pcRuta + pcBaseDatos) alias (pcAlias) shared new
dbUseArea( .T., /*"DBFCDX"*/, pcRuta + pcBaseDatos, pcAlias, .T., .F. )
endif
// use (cTabla) alias (cAlias) shared new
// DBUSEAREA(.T.,,cTabla,,.T.)
endif
if ! netErr()
lContinuar := .T.
(cAlias)->(ordSetFocus(1))
else
if plMensaje
MsgStop("La base de datos: " + Upper(pcBaseDatos) + ".DBF, no puede ser procesada" + CRLF +;
"llame a su asesor de Informatica..." , oApp:cEmpresa)
endif
endif
return(lContinuar)
FUNCTION DbProtect(cDbf,nAction)
LOCAL nHandle:=0
LOCAL cBuffer:=Space(32)
nHandle:=FOpen(cDbf,FO_READWRITE+FO_SHARED)
DEFAULT nAction:=1
IF nHandle!=-1
IF FRead(nHandle,@cBuffer,32)==32
IF nAction==0 // Proteger
IF SubStr(cBuffer,1,1)<>Chr(26)
cBuffer:=Chr(26)+SubStr(cBuffer,1,31)
ENDIF
ELSE // Desproteger
IF SubStr(cBuffer,1,1)==Chr(26)
cBuffer:=SubStr(cBuffer,2,31)+ Chr(0)
ENDIF
ENDIF
FSeek(nHandle,0)
FWrite(nHandle,cBuffer,32)
ENDIF
FClose(nHandle)
ENDIF
RETURN (FError())
FUNCTION lProtect(cDbf)
LOCAL nHandle :=0
LOCAL cBuffer :=Space(32)
LOCAL lRet :=.F.
IF (nHandle:=FOpen(cDbf,FO_READWRITE+FO_SHARED))!=-1
IF FRead(nHandle,@cBuffer,32)==32
lRet:=IF(SubStr(cBuffer,1,1)==Chr(26),.T.,.F.)
ENDIF
FClose(nHandle)
ELSE
MsgInfo("No puede abrirse la tabla "+cDbf,"Verifique!")
ENDIF
RETURN (lRet)
FUNCTION lOkDbf( cNameExt, cPath )
LOCAL lReturn := .T.
LOCAL nHnd, cBytes, nNumRecs, nHdrSize, nRecSize, nFileSize, nRecs
LOCAL cError, cErrorLog
default cPath := ".\"
// Abrimos en exclusiva. Si no es posible, alguien lo esta usando (NO dañado)
IF (nHnd := FOpen(cPath + '' + cNameExt, FO_READWRITE + FO_EXCLUSIVE)) > 0
FSeek(nHnd,4,FS_SET)
// Numero registros segun tabla
cBytes := '0000'
FRead(nHnd,@cBytes,4)
nNumRecs := Bin2L(cBytes)
// Tamaño Header
cBytes := '00'
FRead(nHnd,@cBytes,2)
nHdrSize := Bin2I(cBytes)
// Tamaño Registro
cBytes := '00'
FRead(nHnd,@cBytes,2)
nRecSize := Bin2I(cBytes)
// Tamaño Tabla
nFileSize := FSeek(nHnd,0,FS_END)
// Numero de registros real
nRecs := (nFileSize - nHdrSize) / nRecSize
// Si el archivo se manipulo con dBase, Fox ... tiene 1 byte mas
IF nRecs != Round(nRecs,0)
nRecs := (nFileSize - nHdrSize - 1) / nRecSize
ENDIF
// Si los registros segun la tabla y los calculados no coinciden
IF nRecs != nNumRecs
cError := "Número de registros incorrecto en Base de Datos " + cNameExt
cErrorLog := cError + " en" + CRLF + Trim(cPath) + ' :' + CRLF + CRLF +;
" Registros iniciales " + strzero(nNumRecs,7) + CRLF +;
" Registros detectados " + strzero(nRecs,7) + CRLF + CRLF +;
"Asegúrese de guardar la última copia de seguridad y" + CRLF +;
"realice una copia suplementaria ANTES DE corregir el" + CRLF +;
"problema."
IF MsgNoYes( cErrorLog + CRLF + CRLF +;
"¿ Desea corregir el problema ?", "Error de apertura")
FSeek(nHnd,4,FS_SET)
FWrite(nHnd,L2Bin(Round(nRecs,0)),4)
MsgInfo('El problema ha sido corregido.' + CRLF + CRLF +;
'Antes de continuar el uso normal del programa' + CRLF +;
'debe realizarse una "Indexación de ficheros".','Aviso Importante')
ENDIF
ENDIF
FClose(nHnd)
ENDIF
RETURN lReturn
by rolando » Thu Jul 04, 2013 10:38 pm
Return to FiveWin para Harbour/xHarbour
Users browsing this forum: No registered users and 121 guests