Mini Kabibi Habibi
* SetObjRf.PRG - Set Object Referece.
*
* Copyright (c) 1997 Microsoft Corp.
* 1 Microsoft Way
* Redmond, WA 98052
*
* Description:
* Set an object reference to a specified property based on a specified class.
* Return new instance of specified class if name is an empty string.
LPARAMETERS toObject,tcName,tvClass,tvClassLibrary
LOCAL lcName,lcClass,lcClassLibrary,oObject,lnCount
LOCAL lnObjectRefIndex,lnObjectRefCount,oExistingObject
IF TYPE("toObject")#"O" OR ISNULL(toObject)
RETURN .NULL.
ENDIF
lcName=IIF(TYPE("tcName")=="C",ALLTRIM(tcName),LOWER(SYS(2015)))
oExistingObject=.NULL.
oObject=.NULL.
lcClassLibrary=""
DO CASE
CASE TYPE("tvClass")=="O"
oObject=tvClass
lcClass=LOWER(oObject.Class)
lcClassLibrary=LOWER(oObject.ClassLibrary)
IF NOT ISNULL(oExistingObject) AND LOWER(oExistingObject.Class)==lcClass AND ;
LOWER(oExistingObject.ClassLibrary)==lcClassLibrary
toObject.vResult=oExistingObject
RETURN toObject.vResult
ENDIF
CASE EMPTY(tvClass)
oObject=toObject
lcClass=LOWER(oObject.Class)
lcClassLibrary=LOWER(oObject.ClassLibrary)
IF NOT ISNULL(oExistingObject) AND LOWER(oExistingObject.Class)==lcClass AND ;
LOWER(oExistingObject.ClassLibrary)==lcClassLibrary
toObject.vResult=oExistingObject
RETURN toObject.vResult
ENDIF
OTHERWISE
lcClass=LOWER(ALLTRIM(tvClass))
DO CASE
CASE TYPE("tvClassLibrary")=="O"
lcClassLibrary=LOWER(tvClassLibrary.ClassLibrary)
CASE TYPE("tvClassLibrary")=="C"
IF EMPTY(tvClassLibrary)
lcClassLibrary=LOWER(toObject.ClassLibrary)
ELSE
lcClassLibrary=LOWER(ALLTRIM(tvClassLibrary))
IF EMPTY(JUSTEXT(lcClassLibrary))
lcClassLibrary=LOWER(FORCEEXT(lcClassLibrary,"vcx"))
ENDIF
llClassLib=(JUSTEXT(lcClassLibrary)=="vcx")
IF NOT "\"$lcClassLibrary
lcClassLibrary=LOWER(FORCEPATH(lcClassLibrary,JUSTPATH(toObject.ClassLibrary)))
IF NOT FILE(lcClassLibrary) AND VERSION(2)#0
lcClassLibrary=LOWER(FORCEPATH(lcClassLibrary,HOME()+"ffc\"))
IF NOT FILE(lcClassLibrary)
lcClassLibrary=LOWER(FULLPATH(JUSTFNAME(lcClassLibrary)))
ENDIF
ENDIF
ENDIF
IF NOT FILE(lcClassLibrary)
toObject.vResult=.NULL.
RETURN toObject.vResult
ENDIF
ENDIF
OTHERWISE
lcClassLibrary=""
ENDCASE
IF NOT ISNULL(oExistingObject) AND LOWER(oExistingObject.Class)==lcClass AND ;
LOWER(oExistingObject.ClassLibrary)==lcClassLibrary
toObject.vResult=oExistingObject
RETURN toObject.vResult
ENDIF
oObject=NEWOBJECT(lcClass,lcClassLibrary)
IF TYPE("oObject")#"O" OR ISNULL(oObject)
toObject.vResult=.NULL.
RETURN toObject.vResult
ENDIF
ENDCASE
DO CASE
CASE EMPTY(lcName)
toObject.vResult=oObject
RETURN toObject.vResult
OTHERWISE
IF NOT toObject.AddProperty(lcName,oObject)
oObject=.NULL.
ENDIF
ENDCASE
IF ISNULL(oObject)
toObject.vResult=.NULL.
RETURN toObject.vResult
ENDIF
IF PEMSTATUS(oObject,"oHost",5)
oObject.oHost=toObject.oHost
ELSE
oObject.AddProperty("oHost",toObject.oHost)
ENDIF
IF EMPTY(lcClassLibrary)
lcClassLibrary=LOWER(oObject.ClassLibrary)
ENDIF
lnObjectRefCount=toObject.nObjectRefCount
lnObjectRefIndex=lnObjectRefCount+1
FOR lnCount = 1 TO lnObjectRefCount
IF toObject.aObjectRefs[lnCount,1]==LOWER(lcName)
lnObjectRefIndex=lnCount
EXIT
ENDIF
ENDFOR
IF lnObjectRefIndex>lnObjectRefCount
DIMENSION toObject.aObjectRefs[lnObjectRefIndex,3]
ENDIF
toObject.aObjectRefs[lnObjectRefIndex,1]=LOWER(lcName)
toObject.aObjectRefs[lnObjectRefIndex,2]=lcClass
toObject.aObjectRefs[lnObjectRefIndex,3]=lcClassLibrary
toObject.vResult=oObject
RETURN toObject.vResult