Hi,

a little late but i thought that it maybe helpful to someone in the future.

Here's the code i've written a few weeks ago to find the cause of dangling datasessions, which was caused by dangling object references.

The code can monitor object creation by hooking the native VFP functions Newobject and Createobject and monitor object destruction by binding to the objects Destroy event.

The whole code is completly transparent, no codechanges to existing classes are required.

Christian

&& place this in your global application header file
#DEFINE _MONITOROBJECTS
#IFDEF _MONITOROBJECTS
	#DEFINE NewObject NewObjectMonitored
	#DEFINE CreateObject CreateObjectMonitored
#ENDIF

&& place this in a prg and "SET PROCEDURE" to this prg
&& before any CREATEOBJECT/NEWOBJECT calls are made in your app

#IFDEF _MONITOROBJECTS

FUNCTION NewObjectMonitored
	Lparameters lcClass, lvParam1, lvParam2, lvParam3, lvParam4, lvParam5, lvParam6, lvParam7, lvParam8, ;
		lvParam9, lvParam10, lvParam11, lvParam12, lvParam13, lvParam14, lvParam15, lvParam16, lvParam17, lvParam18, lvParam19, ;
		lvParam20, lvParam21, lvParam22, lvParam23, lvParam24, lvParam25
		
	LOCAL loObject, loMonitor, lnPCount, lcCommand, xj, lnSession
	m.lnPCount = PCOUNT() - 1
	m.lnSession = SET('Datasession')
	m.loMonitor = GetObjectMonitor()
	
	m.lcCommand = 'NewObject(m.lcClass' && NewObject inside '' does not get replaced by the preprocessor
	FOR m.xj = 1 TO m.lnPCount
		m.lcCommand = m.lcCommand + IIF(m.xj > 2, ',@m.lvParam', ',m.lvParam') + ALLTRIM(STR(m.xj))
	ENDFOR
	m.lcCommand = m.lcCommand + ')'
	m.loObject = EVALUATE(m.lcCommand)

	m.loMonitor.MonitorObject(m.loObject, m.lnSession, m.lcClass, 'New')

	RETURN m.loObject
ENDFUNC

FUNCTION CreateObjectMonitored
	Lparameters lcClass, lvParam1, lvParam2, lvParam3, lvParam4, lvParam5, lvParam6, lvParam7, lvParam8, ;
		lvParam9, lvParam10, lvParam11, lvParam12, lvParam13, lvParam14, lvParam15, lvParam16, lvParam17, lvParam18, lvParam19, ;
		lvParam20, lvParam21, lvParam22, lvParam23, lvParam24, lvParam25

	LOCAL loObject, loMonitor, lnPCount, lcCommand, xj, lnSession
	m.lnPCount = PCOUNT() - 1
	m.lnSession = SET('Datasession')
	m.loMonitor = GetObjectMonitor()
	
	m.lcCommand = 'CreateObject(m.lcClass' && CreateObject inside '' does not get replaced by the preprocessor
	FOR m.xj = 1 TO m.lnPCount
		m.lcCommand = m.lcCommand + ',@m.lvParam' + ALLTRIM(STR(m.xj))
	ENDFOR
	m.lcCommand = m.lcCommand + ')'
	m.loObject = EVALUATE(m.lcCommand)
	
	m.loMonitor.MonitorObject(m.loObject, m.lnSession, m.lcClass, 'Create')

	RETURN m.loObject
ENDFUNC

&& Factory Method to get the active monitoring object (very simple singleton pattern implementation)
FUNCTION GetObjectMonitor
	IF !PEMSTATUS(_SCREEN, 'oObjectMonitor',5) OR VARTYPE(_SCREEN.oObjectMonitor) != 'O'
		_SCREEN.AddObject('oObjectMonitor','cObjectMonitor')
	ENDIF
	RETURN _SCREEN.oObjectMonitor
ENDFUNC

DEFINE CLASS cObjectMonitor AS Custom

	cLogFile	= ''
	cExcludeClasses = 'oParameter,Empty' && list of classes to ignore
	DIMENSION aExcludeClasses[1]
	cExcludeDatasessions = '1,3' && list of datasession to ignore
	DIMENSION aExcludeDataSessions[1]
	
	FUNCTION Init
		THIS.cLogFile = ADDBS(JUSTPATH(_VFP.FullName)) + 'debuglog.txt'
		ALINES(THIS.aExcludeClasses, THIS.cExcludeClasses, 1, ',')
		ALINES(THIS.aExcludeDataSessions, THIS.cExcludeDatasessions, 1, ',')
		LOCAL xj
		FOR m.xj = 1 TO ALEN(THIS.aExcludeDataSessions)
			THIS.aExcludeDataSessions[m.xj] = IIF(VARTYPE(THIS.aExcludeDataSessions[m.xj])='C',VAL(THIS.aExcludeDataSessions[m.xj]),0)
		ENDFOR
	ENDFUNC

	FUNCTION MonitorObject
		LPARAMETERS loObject, lnSession, lcClass, lcFunc

		IF ASCAN(THIS.aExcludeClasses,m.lcClass, 1, -1, 1, 1+2+4+8) > 0 OR ;
			ASCAN(THIS.aExcludeDataSessions, m.lnSession, 1, -1, 1, 8) > 0
			RETURN
		ENDIF
		
		LOCAL lcDebug		
		m.lcDebug = PADR(m.lcFunc + 'Object',14,' ') + ' Datasession: ' + PADL(ALLTRIM(STR(m.lnSession)),2,' ') + ' ' +  + ' Class: ' + ALLTRIM(m.lcClass)

		IF VARTYPE(m.loObject) = 'O'
			TRY
				IF PEMSTATUS(m.loObject, 'Destroy', 5)	
					BINDEVENT(m.loObject, 'Destroy', THIS, 'LogDestroy')
				ENDIF
			CATCH
			ENDTRY

			TRY			
				IF PEMSTATUS(m.loObject, 'Baseclass', 5)
					m.lcDebug = m.lcDebug + '::' + m.loObject.Baseclass
				ENDIF
			CATCH
			ENDTRY
		ENDIF

		ADDPROPERTY(m.loObject,'nDebugDatasession',m.lnSession)

		THIS.DebugLog(m.lcDebug)
	ENDFUNC

	&& logs the destroy of a monitored object
	FUNCTION LogDestroy
		LOCAL laObj[1]
		AEVENTS(m.laObj,0)
		IF VARTYPE(m.laObj[1]) = 'O'
			THIS.DebugLog(PADR(m.laObj[1].Class + '::Destroy ',50,' ') + 'Datasession: ' + ALLTRIM(STR(m.laObj[1].nDebugDatasession)))
		ENDIF
	ENDFUNC

	&& log all currently tracked objects 
	FUNCTION LogActiveObjects
		LOCAL laObj[1], lnCount, xj, lcDebug, loObj
		m.lnCount = AEVENTS(m.laObj,THIS)
		THIS.DebugLog(REPLICATE('*',100))
		THIS.DebugLog('Currently tracked Objects: ' + ALLTRIM(STR(m.lnCount)))
		FOR m.xj = 1 TO m.lnCount
			m.loObj = m.laObj[m.xj,2]
			IF VARTYPE(m.loObj) = 'O'
				lcDebug = PADR(m.loObj.Class,50,' ')
				IF PEMSTATUS(m.loObj, 'nDebugDataSession',5)
					m.lcDebug = m.lcDebug + ' Datasession: ' + ALLTRIM(STR(m.loObj.nDebugDatasession))
				ENDIF
				THIS.DebugLog(m.lcDebug)
			ENDIF
		ENDFOR
		THIS.DebugLog(REPLICATE('*',100))
	ENDFUNC
	
	FUNCTION DebugLog
		Lparameters lcDebugExpr
		STRTOFILE(m.lcDebugExpr + CRLF, THIS.cLogFile, 1)
	ENDFUNC

ENDDEFINE

#ENDIF