FiveTech Support Forums

            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

***********************************************************************************
*  [ 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: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:={|| 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