6 de noviembre de 2014

Verificar si una tabla está abierta

Función modificada de ¿Cómo verificar si una tabla está abierta en exclusiva?

La modificación a esta misma función que permite saber si existe algún usuario (o varios) que tengan abierta la tabla en modo Shared. Esto me fue util cuando intentaba abrir una tabla en modo exclusivo y evitaba los errores. Para esto se agrego el parámetro lModo el cual indica el modo en que se desea abrir la tabla (0 si se desea abrir SHARED y 1 si se desea abrir como exclusivo)

***************************************************
FUNCTION _Exclusivo(tcTabla,lModo)
***************************************************
* Verifica si una tabla esta abierta en  EXCLUSIVO o SHARED 
* por otro/s usuario/s.
*
* Ej. de USO:   _Exclusivo("C:\VFP\MiTabla.DBF",0)
*
* PARAMETROS:
*    tcTabla = Ruta completa del archivo .DBF que se desea abrir 
*    lModo = Indica la manera en que se desea abrir la tabla. Valores posibles 0, 1
*                   0  (o sin parametros) Utilizar cuando se intenta 
*   abrir una tabla en modo SHARED
*   (no exclusivo) y se quiere evitar
*   que se devuelva un error si existe
*   otro usuario utiliza la en exclusivo 
*
*                  1  Utilizar cuando se intenta abrir en modo EXCLUSIVE una 
*                 Tabla y evitar el mensaje de error por que otro usuario 
*                tiene abierta la misma tabla en modo Shared o Exclusivo.
*
* RETORNO:  .T. Si se puede abrir, no se encuentra abierta por otro usuario
* .F. No se puede abrir, se encuentra abierta por otro usuario
*
* Modificada de ¿Cómo verificar si una tabla está abierta en exclusiva?
* Se agrega parametro lModo , por Tomás Cruz - 04.08.2014
***************************************************
IF VARTYPE(lModo)=='L'
lModo = 0
ENDIF 
LOCAL lnHandle, llRet
lnHandle = FOPEN(tcTabla,lModo)
IF lnHandle = -1
   llRet = .F.
ELSE
   llRet = .T.
   =FCLOSE(lnHandle)
ENDIF
RETURN llRet
ENDFUNC

Tomas Cruz

3 comentarios :

  1. Excelente aporte Tomas, muchas gracias por esta información, ahora mismo voy a implementarlo en el proceso de un sistema que requiere acceso exclusivo a las tablas. Muchas gracias.

    ResponderBorrar
  2. Recuerdo que utilicé esta función en varias oportunidades. Excelente.
    Les copio una función que hice (utilizando esta) para modificar tablas. Quizá le sirva a alguien.
    Gracias.

    *----------------------------------------------------
    * Función.......: agregarcampo
    * Descripción...: Agrega/modifica un campo en una tabla
    * Parámetros....: tabla, campo, tipo y tamaño del campo
    *-----------------------------------------------------
    Function agregarcampo( pTabla, xcampo, xtipo )

    Local xcampotabla, lnAnchoCampo, llModificaTabla,;
    lcTipoCampo, lcTablaUsada, TablaModificada

    llModificaTabla = .T.

    *Ejemplo
    * pTabla = 'Nombre de la tabla'
    * xCampo = 'Nombre del campo'
    * xtipo = tipo de campo y tamaño 'c(8)'
    * Agregarcampo( 'MiTabla', 'MiCampo', 'N(8)' )

    pTabla = Alltrim( pTabla )
    xcampotabla = 'TablaModificada.' + Alltrim(xcampo)

    lnAnchoCampo = Strtran( Strtran( xtipo, '(' ), ')' ) && quita los paréntesis
    lnAnchoCampo = Val( Substr( lnAnchoCampo, 2, Len( lnAnchoCampo ) - 1) )

    Wait Window Transform( 'Agregando/Modificando campo ' + pTabla + '.' + Alltrim( xcampo )+ ' ' + xtipo ) Nowait

    If ! File( pTabla + '.dbf' )

    Messagebox( 'No existe el archivo ' + pTabla, 16, 'Error', 2000 )
    Wait Clear
    Return .F.

    Endif

    Use ( pTabla ) Alias TablaModificada

    If ! Empty(Field(xcampo))
    * si el campo existe verifica si tiene el tamaño adecuado
    lcTipoCampo = Vartype( &xcampotabla )

    llModificaTabla = ( lcTipoCampo <> Left( xtipo,1 ) ;
    Or Iif( Inlist( lcTipoCampo,'M','L'), .F., lnAnchoCampo <> Fsize( xcampo, 'TablaModificada' ) ) )

    Endif

    lcTablaUsada = Dbf()

    Use In TablaModificada

    If ! llModificaTabla
    Wait Clear
    Return .T.
    Endif

    If _exclusivo( lcTablaUsada )

    Use (pTabla) Alias TablaModificada Exclusive

    * Verifica si tiene que agregar el campo

    If Empty( Field(xcampo) )
    Execscript( 'Alter Table "' + pTabla + '" Add Column ' + Alltrim(xcampo) + ' ' + xtipo )

    Wait Clear
    Use In TablaModificada

    Return .t.
    Endif

    If ( lcTipoCampo <> Left( xtipo,1 ) ;
    Or Iif( Inlist( lcTipoCampo,'M','L'), .F., lnAnchoCampo <> Fsize( xcampo, 'TablaModificada' ) ) )

    Execscript( 'Alter Table TablaModificada Alter Column ' + Alltrim(xcampo) + ' ' + xtipo )
    Endif

    Wait Clear
    Use In TablaModificada

    Return .t.

    Else

    Messagebox( 'Imposible agregar campo ' + xcampo + ' en la tabla ' + pTabla, 16, 'Error', 2000 )
    Wait Clear

    If Used( 'TablaModificada' )
    Use In TablaModificada
    Endif

    Return .f.
    Endif

    Endfunc

    ResponderBorrar

Los comentarios son moderados, por lo que pueden demorar varias horas para su publicación.