Clear Erase (Addbs(GETENV("TEMP"))+"ReferenceTracking.Txt") Set Asserts on ox = CreateObject("Sample") ox.addobject("Obj","_Custom") ox.Obj.addproperty("oParent",ox) ox.removeobject("Obj") ox = 0 ? "Release OX" ? FileToStr(Addbs(GETENV("TEMP"))+"ReferenceTracking.Txt") Clear all ? "Clear all" ? FileToStr(Addbs(GETENV("TEMP"))+"ReferenceTracking.Txt") Define class Sample as _custom lNeedsPostInit = .t. Dimension aSomeData[45] Procedure Init This.DoSomething() DoDefault() DoDefault() this.aSomeData[44] = This Endproc Procedure DoSomething Assert This.IsReady() ; Message Sys(1272,This)+" in Method "+ ; Lower(Program(Program(-1)))+"() is not ready" ? "Do something..." Endproc Enddefine *======================================================================================== * Base class *======================================================================================== Define Class _Custom as Custom lDoneInit = .F. && Init has been executed lDonePostInit = .F. && Postinit has been executed lDoneCleanup = .F. && CleanUp has been executed lDoneDestroy = .F. && Destroy has been executed lIsClassObject = .T. && Is this really an object? lReady = .F. && Object is fully initialized cID = "" && ID for reference tracking lNeedsPostInit = .F. *======================================================================================== * Initalizes the object. DoInit contains the actual initialization code. *======================================================================================== Procedure Init This.lIsClassObject = .F. This.cID = Sys(2015) StrToFile( ; Ttoc(Datetime())+[,]+This.cID+[,"INIT","]+Sys(1272,This)+["]+Chr(13)+Chr(10), ; Addbs(GETENV("TEMP"))+"ReferenceTracking.Txt", ; .T. ; ) If Program(-1) > 1 If Right(Upper(Program(Program(-1)-1)),5) == ".INIT" Debugout Sys(1272,This)+": Overrode Init?" Endif Endif Local llOK llOK = This.DoInit() Assert Vartype(m.llOK)=="L" MESSAGE "wrong data type" If not This.lNeedsPostInit This.lReady = m.llOK Endif Assert not This.lDoneInit MESSAGE "Init called twice" This.lDoneInit = .T. Assert This.IsValidReference(This) MESSAGE "THIS invalid" If not m.llOK This.Cleanup() Endif Return m.llOK *======================================================================================== * Releases an object *======================================================================================== Procedure Release Assert This.IsValidReference(This) MESSAGE "THIS invalid" This.Cleanup() Release THIS Endproc *======================================================================================== * Before you remove an object, you first need to turn it into a releasable state. *======================================================================================== Procedure RemoveObject LParameter tcName Assert This.IsReady() MESSAGE "THIS not ready" Assert Vartype(m.tcName)=="C" MESSAGE "wrong data type" Assert PemStatus(This,m.tcName,5) MESSAGE "wrong parameter" Local loReference loReference = GetPem(This,m.tcName) Assert This.IsValidReference(m.loReference) MESSAGE "loReference invalid" If PemStatus(m.loReference,"Cleanup",5) loReference.Cleanup() Endif loReference = NULL DoDefault(m.tcName) NoDefault EndProc *======================================================================================== * Initalizes all dependencies to other objects *======================================================================================== Procedure PostInit If Program(-1) > 1 If Right(Upper(Program(Program(-1)-1)),9) == ".POSTINIT" Debugout Sys(1272,This)+": Overrode Postinit?" Endif Endif Assert not This.lDonePostInit MESSAGE "PostInit called twice" Assert This.lNeedsPostInit MESSAGE "lNeedsPostInit must be .T." Local llOK llOK = This.DoPostInit() Assert Vartype(m.llOK)=="L" MESSAGE "wrong data type" This.lReady = m.llOK This.ValidateReferences() This.lDonePostInit = .T. EndProc *======================================================================================== * Cleans up an object. It's actually too late to safely release an object, because * dangling reference can't be completely avoided anymore. *======================================================================================== Procedure Destroy Assert not This.lDoneDestroy MESSAGE "Destroy called twice" Assert not Empty(This.cID) MESSAGE "missing ID" StrToFile( ; Ttoc(Datetime())+[,]+This.cID+[,"DESTROY","]+Sys(1272,This)+["]+Chr(13)+Chr(10), ; Addbs(GETENV("TEMP"))+"ReferenceTracking.Txt", ; .T. ; ) Local lcCommand, laStack[1], lnStack If VarType(Version(4))=="C" and Version(4) >= "07.00" lnStack = AStackInfo(laStack) Assert m.lnStack>1 MESSAGE "dangling reference" If m.lnStack > 1 lcCommand = Left(Upper(GetWordNum(laStack[m.lnStack-1,6],1)),4) Assert not InList(m.lcCommand,"CLEA","QUIT","CANC") MESSAGE "dangling reference" EndIf Endif If not This.lDoneCleanup Debugout Sys(1272,This)+": Release missing" This.Cleanup() Endif This.lDoneDestroy = .T. EndProc *======================================================================================== * Returns .T. if the reference points to a valid object. That's the case, when the * reference points to an object that is not a class object and hasn't been cleaned up. *======================================================================================== Function IsValidReference LParameter toReference If Vartype(m.toReference) # "O" Return .F. Endif If PemStatus(m.toReference,"lIsClassObject",5) If m.toReference.lIsClassObject Return .F. Endif Endif If PemStatus(m.toReference,"lDoneCleanup",5) If m.toReference.lDoneCleanup Return .F. Endif Endif If PemStatus(m.toReference,"lDoneDestroy",5) If m.toReference.lDoneDestroy Return .F. Endif Endif Return .T. *======================================================================================== * Validates if all object references point to valid objects. This code skips properties * with access methods. *======================================================================================== Function ValidateReferences Assert This.IsValidReference(This) MESSAGE "THIS invalid" Local laMember[1], lnMember, loReference, lnCount, lnItem lnCount = 0 For lnMember = 1 to AMembers(laMember,This) If PemStatus(This,laMember[m.lnMember]+"_Access",5) Loop Endif If not PemStatus(This,laMember[m.lnMember],4) Loop Endif If Type("Alen(This."+laMember[m.lnMember]+")") == "N" For lnItem=1 to Alen(This.&laMember[m.lnMember]) loReference = This.&laMember[m.lnMember][m.lnItem] If Vartype(m.loReference) == "O" lnCount = m.lnCount + 1 Assert This.IsValidReference(m.loReference) MESSAGE "loReference invalid" Endif Endfor loReference = NULL Else loReference = GetPem(This,laMember[m.lnMember]) If Vartype(m.loReference) == "O" lnCount = m.lnCount + 1 Assert This.IsValidReference(m.loReference) MESSAGE "loReference invalid" Endif loReference = NULL Endif Endfor Return m.lnCount *======================================================================================== * Returns .T. if the object is usable. That's the case after the initialization * completed up to the time when the object´is cleaned up. You should call this method * from each method like this: * * ASSERT This.IsReady() *======================================================================================== Function IsReady If not This.IsValidReference(This) Return .F. Endif If not This.lDoneInit Return .F. Endif If not This.lReady Return .F. Endif Local llIsReady llIsReady = This.DoIsReady() Assert Vartype(m.llIsReady)=="L" MESSAGE "wrong data type" If not m.llIsReady Return .F. Endif Return .T. *======================================================================================== * Turns the object into a releasable state. *======================================================================================== Procedure CleanUp This.lReady = .F. If This.lDoneCleanup Return Endif This.DoCleanup() Local laMember[1], lnMember, loReference For lnMember = 1 to AMembers(laMember,This,2) loReference = GetPem(This,laMember[m.lnMember]) Assert This.IsValidReference(m.loReference) MESSAGE "loReference invalid" If PemStatus(m.loReference,"Cleanup",5) loReference.Cleanup() Endif loReference = NULL Endfor This.ValidateReferences() This.DoNullify() Assert This.ValidateReferences()==0 MESSAGE "There are still references" If VarType(Version(4))=="C" and Version(4) >= "08.00" UnbindEvents(This) Endif This.lDoneCleanup = .T. EndProc *======================================================================================== * Here're the methods that you can place your code in sub classes. *======================================================================================== Procedure DoInit Endproc Procedure DoCleanup Endproc Procedure DoPostInit Endproc Procedure DoNullify Endproc Procedure DoIsReady Endproc Enddefine