Import initial din SVN ROAAUTO/Trunk @HEAD

2026-04-11 17:11:32 +03:00
commit 656d98697f
1856 changed files with 163525 additions and 0 deletions
--- a/COMUN/programe/setobjrf.prg
+++ b/COMUN/programe/setobjrf.prg
@@ -0,0 +1,119 @@
+* 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