PROCEDURE compactar()
**********************
TRY
LOCAL lcFolder,lcListTables,i,;
lcMessage,;
lcTable,;
loObj as Object,;
loEx as Exception
lcMessage = ""
lcfolder = "\\server\myApp\Folder_data"
lcListTables = "Clientes,Proveedores,Productos,"
FOR i = 1 TO GETWORDCOUNT(m.lcListTables,",")
lcTable = GETWORDNUM(m.lclistTables,m.i,",")
loObj = Try_to_pack(ADDBS(m.lcFolder) + m.lcTable
IF VARTYPE(loObj) = "O"
* Reporte
lcMessage = m.lcMessage ;
+"Tabla = "+m.lcTable ;
+"Pack = "+TRANSFORM(loObj.DoPack) ;
+IIF(loObj.Warning,"Warning","") ;
+IIF(EMPTY(loObj.Message),"",loObj.Message) ;
+CHR(13)+CHR(10)
ENDIF
NEXT
CATCH TO loex
loex.UserValue=PROGRAM()
* ShowError(loex)
FINALLY
loObj = null
ENDTRY
ENDPROC
*******************************
PROCEDURE Try_To_Pack
*******************************
LPARAMETERS tc_path_table
TRY
LOCAL lReopen,;
lShared,;
lcCursor,;
lDoPack,;
loResp as Object,;
loPack as Exception,;
loErrGen as Exception
loResp = NEWOBJECT("Empty")
ADDPROPERTY(loResp,"DoPack",.f.)
ADDPROPERTY(loResp,"Message","")
ADDPROPERTY(loREsp,"Warning",.F.)
lcCursor = JUSTSTEM(m.tc_Path_table)
* Si la tabla está abierta, se debe cerrar
IF USED(m.lcCursor)
lReOpen = .t.
lShared = IIF(ISEXCLUSIVE(m.lcCursor),.F.,.T.)
USE IN SELECT(m.lcCursor)
ENDIF
* Si la tabla está en uso por otro usuario
* No se podrá abrir en Exclusive y dará un error
* El error no se debe mostrar (o si)
TRY
IF !USED(lcCursor)
USE (lcFullTabla) IN 0 EXCLUSIVE
SELECT (lcCursor)
PACK
USE
loResp.dopack = .t.
loREsp.Message = m.lcCursor + " » Tabla Compactada." + CHR(13)
ENDIF
CATCH TO loPack
loResp.Message=m.lcCursor + " » Tabla en Uso por otro Usuario" + CHR(13)
ENDTRY
IF m.lReopen
IF m.lShared
USE (m.tc_path_table) IN 0 SHARED
ELSE
USE (m.tc_path_table) IN 0 EXCLUSIVE
ENDIF
ENDIF
CATCH TO loErrGen
loErrgen.UserValue=PROGRAM()
loResp.Message = loResp.Message ;
+"Error en "+PROGRAM()+CHR(13)
* ShowError(loErrGen)
FINALLY
IF m.lReopen AND !USED(m.lcCursor)
loResp.Warning = .t.
loResp.Message = loREsp.Message ;
+ m.lcCursor ;
+ " no puedo abrirse en modo "+IIF(m.lShared,"compartido","exclusivo")
ENDIF
ENDTRY
RETURN loResp
ENDPROC