Mini Kabibi Habibi

Current Path : C:/Users/ITO/Desktop/VF9/program files/microsoft visual foxpro 9/ffc/
Upload File :
Current File : C:/Users/ITO/Desktop/VF9/program files/microsoft visual foxpro 9/ffc/setobjrf.prg

* 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