Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Dangled references
Message
De
10/02/2008 09:14:19
 
 
Information générale
Forum:
Visual FoxPro
Catégorie:
Codage, syntaxe et commandes
Versions des environnements
Visual FoxPro:
VFP 9 SP2
OS:
Vista
Network:
Windows XP
Database:
Visual FoxPro
Divers
Thread ID:
01291130
Message ID:
01291165
Vues:
20
Robin --

Here are the methods I've changed.

I note (form your later message) that objref ran for you without error, so maybe you don't need these anyway. My changes merely got around the errors encountered, and provide a slightly different display, more to my liking.

Jim
*-- FindReferences - recursive method to find the object references
Procedure findreferences
	Lparameters pcName, roObject

	If ( ! IsObject( roObject ) )
		Return
	Endif

	Local i, N, laMembers[1], lcName, lcNameArray, lcIndex
	Local lbUserfDefined, j, lnLimit
	Local lcParent, lcObject, lcReference

	N = Amembers( laMembers, roObject )
	For i = 1 To N
		lcName = laMembers[i]

		If ( Inlist( lcName, "PARENT", "ACTIVEFORM", "ACTIVECONTROL", "APPLICATION", "ACTIVEPROJECT") )
			* these object refs don't count
			Loop
		Endif

		If ( Inlist( lcName, "SELTEXT", "_MEMBERDATA"))
			* these seem to fail ...
			Loop
		Endif

		If ( Inlist( lcName, "CONTROLS", "OBJECTS", "FORMS", "PAGES", "COLUMNS", "PROJECTS" ) )
			* these collections will be iterated through in the next loop
			Loop
		Endif

		If ( Inlist( lcName, "FORMCOUNT", "READONLY" ) )
			* VFP bug causes these to be seen as an array
			Loop
		Endif

		* ignore VFP Baseclass properties
		* modified because Pemstatus sometimes fails
		lbUserfDefined = .F.
		Try
			lbUserfDefined = Pemstatus( roObject, lcName, 4 )
		Catch

		Endtry

		If ( ! lbUserfDefined  )
			Loop
		Endif

		*
		lcName = "roObject." + lcName
		lcIndex = "[1]"
		lcNameArray = lcName + lcIndex
		If ( Type( lcNameArray ) != "U" )
			* it's an array property
			j = 1
			Do While ( Type( lcNameArray ) != "U" ) And j <= 1000

				If ( IsObject( Evaluate( lcNameArray ) ) )
					*  This.AddReference( pcName + This.PartialName( roObject ) + "." + laMembers[i] + lcIndex + ;
					" => " + FullName( Evaluate( lcNameArray ) ) )
					lcParent = pcName + This.PartialName( roObject )
					lcObject = "." + laMembers[i] + lcIndex
					lcReference = "." + laMembers[i] + lcIndex + " ==> " + FullName( Evaluate( lcNameArray))

					This.AddReference( lcParent, lcObject, lcReference)
				Endif
				j = j + 1
				lcIndex = "[" + Alltrim( Str( j ) ) + "]"
				lcNameArray = lcName + lcIndex
			Enddo
		Else
			* it's a non array property
			If ( IsObject( Evaluate( lcName ) ) )
				* This.AddReference( pcName + This.PartialName( roObject ) + "." + laMembers[i] + ;
				" => " + FullName( Evaluate( lcName ) ) )
				lcParent = pcName + This.PartialName( roObject )
				lcObject = "." + laMembers[i]
				lcReference = "." + laMembers[i] + " => " + FullName( Evaluate( lcName ) )

				This.AddReference( lcParent, lcObject, lcReference)
			Endif
		Endif
	Endfor

	N = Amembers( laMembers, roObject, 2 )
	For i = 1 To N
		This.findreferences( pcName + "." + laMembers[i], Evaluate( "roObject." + laMembers[i] ) )
	Endfor
Endproc


*-- AddReference - add a found object reference
Procedure AddReference
	Lparameters lcParent, lcObject, lcReference

	* add this reference to the array

	This.mnobjectreferences = This.mnobjectreferences + 1
	Dimension This.maobjectreferences[this.mnObjectReferences,4]

	This.maobjectreferences[this.mnObjectReferences, 1] = lcParent
	This.maobjectreferences[this.mnObjectReferences, 2] = lcObject
	This.maobjectreferences[this.mnObjectReferences, 3] = lcReference
Endproc


*-- FindObjectReferences - look through all sources of objects
Procedure findobjectreferences
	Dimension This.maobjectreferences[1,4]

	Local i, loObject

	This.mnobjectreferences = 0

	This.SetStatus( "_screen" )
	This.findreferences( "_screen", _Screen )

	This.SetStatus( "_screen.Forms" )
	For i = 1 To _Screen.FormCount
		This.SetStatus( "Form: " + _Screen.Forms(i).Caption )
		This.findreferences( "_screen.Forms[" + Alltrim( Str( i ) ) + "]", _Screen.Forms[i] )
	Endfor

	lcVersion = Version()
	i = At( ' ', lcVersion, 2 )
	lcVersion = Substr( lcVersion, i+1, 2 )
	If ( lcVersion > "03" )
		This.SetStatus( "_vfp" )
		This.findreferences( "_vfp", _vfp )

		This.SetStatus( "_vfp.Objects" )
		* this is included but doesn't actually work *s*
		* there is a bug using amembers() on the reference in both VFP5 and VFP6
		* if it ever gets fixed this will work and the CheckMemvars() can be removed

		i = 1
		Do While ( Type( "_vfp.Objects[i]" ) != "U" )
			This.findreferences( "_vfp.Objects[" + Alltrim( Str( i ) ) + "]", _vfp.Objects[i] )
			i = i + 1
		Enddo
	Endif

	This.SetStatus( "Memory variables" )
	This.checkmemvars()

	If ( This.mnobjectreferences > 0 )
		This.SetStatus( "" )
		This.Refresh()
	Else
		This.SetStatus( "No object references found" )
	Endif

	Return
Endproc



Procedure cmdfind.Click
	This.Parent.findobjectreferences()

	Select Objref
	Zap

	If ( Thisform.mnobjectreferences > 0 )
		Local i, j

		Create Cursor Objref ( cLine c(240) )

		Create Cursor Objects (Obj c(40))
		For i = 1 To Thisform.mnobjectreferences
			Insert Into Objects Values( Thisform.maobjectreferences[i, 2] )
		Endfor

		Select Obj, Sum(1) As Count From Objects Into Cursor Counts Readwrite Group By 1
		Scan
			Insert Into Objref Values( thorn( Counts.Count) + Space(6) + Counts.Obj)
		Endscan

		Insert Into Objref Values( [])

		For i = 1 To Thisform.mnobjectreferences
			Insert Into Objref Values( Thisform.maobjectreferences[i, 1] )
			Insert Into Objref Values( Space(12) + Thisform.maobjectreferences[i, 3] )
		Endfor

	Endif

	Select Objref
	Goto Top

	With This.Parent.grdobjref
		.ColumnCount = -1
		.RecordSource = "objref"
		.Column1.Width = .Column1.Width * 1.1 && make it a little wider
		*   with .Column1.Text1
		*      .SpecialEffect = 1
		*      .Margin = 1
		*   endwith
		If ( .Column1.Width > .Width )
			This.Parent.Width = This.Parent.Width + ( .Column1.Width - .Width + 10 )
		Endif
		.SetFocus() && so row marker shows
	Endwith
Endproc
>Jim,
>
>Thx for the heads up, I would apreciate a copy of the modified code.
>
>Robin
>
>
>
>>Robin --
>>
>>I posted a similar question about a week ago.
>>
>>What helped me was the tool 'objref', mentioned in some of the responders to your question. This tool is used when you have your app running and one or more forms open -- it tells you all object references you'll need to clean up before you can close the form.
>>
>>Since I began using this, I have had considerable (but not 100%) success in eliminating C5 errors.
>>
>>Note, however, that I had to make a few modifications to the code (as referenced in the download from Sergey). Among other issues, it was able to create an infinite loop.
>>
>>If you're interested in my modifications (which include a somewhat modified display), I can supply them.
>>
>>Jim
>>
>>
>>
>>
>>>Hi
>>>
>>>I have a "dangled" reference on one of my forms. There is a lot of code using mappoint, and it is going to take some time to find the problem.
>>>
>>>When I try & close down my program after running my form, Visual Foxpro is unable to shutdown.
>>>
>>>Is there a way of showing any references left behind in a list?
>>>
>>>Any help extremley appreciated
Jim Nelson
Newbury Park, CA
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform