¿Cómo verificar si una tabla está abierta en exclusiva? (II)

Algunos comandos (ZAP, PACK) requieren que el acceso al DBF sea de forma exclusiva, para tal motivo debe de revisarse si no existe algún otro cliente usando la tabla en cuestión (por lo que la función IsExclusive no nos es útil).

A continuación un par de métodos más utilizando otras técnicas basadas en la captura de error:

*--------------------------------------------------
FUNCTION _Exclusivo(tcTable, tlCloseTable)
  *--------------------------------------------------
  * Verifica (y usa) una tabla con acceso EXCLUSIVO
  * Check (and use) a table with EXCLUSIVE access
  * USO:
  *   ++ Revisa y usa una tabla, dejandola abierta
  *   ++ Check and use a table leaving it open
  *      _Exclusivo("C:\VFP\MiTabla.DBF")
  *      _Exclusivo("C:\VFP\MiTabla.DBF",.F.)
  *   ++ Revisa y usa una tabla en EXCLUSIVO, cierra la tabla después de eso.
  *   ++ Check if can open the table in EXCLUSIVE and close the table
  *   _Exclusivo("C:\VFP\MiTabla.DBF",.T.)
  * PARAMETRO/PARAMETERS:
  *   tcTable = Ruta completa del archivo .DBF
  *             Full path to the DBF File
  *   tlCloseTable = Indica si cerrará la tabla al finalizar el chequeo 
  *                  (default .F., no cierra la tabla)
  *                  Indicates if the checked table will be closed after 
  *                  the checking (default .F., leave open the table).
  * RETORNO/RETURNS: .T. si se puede abrir en exclusivo. 
  *                  If can open on exclusive access returns .T.
  * Developer: Esparta Palma (esparta @ gmail.com) http://www.PortalFox.com
  *--------------------------------------------------
  LOCAL llRetValue
  llRetValue = .T.
  *** Check If we are using VFP8 or newer version .
  *** Revisamos si tenemos VFP8 o posterior.
  #DEFINE isVFP8 (VERSION(5) >= 800)

  #IF NOT isVFP8
  *** If we dont have TRY..CATCH blocks use ON ERROR
  *** Si no tenemos bloques TRY...CATCH, usamos ON ERROR
    ON ERROR llRetValue = .F.
   *** Add FoxTools Library, to use the Function Juststem
   *** Agregamos la libreria FoxTools.fll para poder hacer uso de la función JustStem
    IF NOT ("FOXTOOLS.FLL" $ SET("LIBRARY"))
       SET LIBRARY TO (HOME(1)+"FoxTools.fll")
   ENDIF

  #ELSE
    *** We can use TRY...CATCH, let's use it
    *** Podemos usar TRY...CATCH, usémoslo
    TRY
    #ENDIF
    USE (tcTable) IN 0 EXCLUSIVE
    IF (llRetValue) AND (tlCloseTable)
      USE IN SELECT(JUSTSTEM(tcTable))
    ENDIF
    #IF isVFP8
    CATCH TO oError
      llRetValue = .F.
      MESSAGEBOX("Error al intentar usar en exclusivo:"+oError.MESSAGE)
    ENDTRY
  #ELSE
    ON ERROR
  #ENDIF
  RETURN llRetValue
ENDFUNC

La función arriba implementada utiliza condiciones de preprocesador para poderla utilizar transparentemente en cualquier versión de Visual FoxPro, si puede utilizar las técnicas de manejo de errores estructurados (TRY/CATCH) lo hará, de otro modo utilizará el truco de mandar una bandera en cuanto suceda un errror (con el problema de que se perderá su antigua configuración de ON ERROR.

Espero les sea de utilidad.

Espartaco Palma Martínez