CLEAR all RELEASE all SET asserts on LOCAL o o = CREATEOBJECT("msxml.domdocument") o.loadXML('') MESSAGEBOX(o.xml) FOR EACH oNode IN o.DocumentElement.ChildNodes MESSAGEBOX("This doesn't execute") ENDFOR o = CREATEOBJECT("collection") o.AddItem("My Own ClAsa", "myclass", "myclass.prg") o.AddItem("MSXMLDOM", "msxml.domdocument") o.AddItem("MY chEcKbox", "checkbox") LOCAL i i = 0 FOR each oItem IN o.Items i = i + 1 IF PEMSTATUS(oItem,"Name",5) MESSAGEBOX("Item " + ALLTRIM(STR(i)) + " " + oItem.Name) ELSE MESSAGEBOX("COM object") ENDIF ENDFOR FOR i = 1 TO o.Length IF PEMSTATUS(o.Items(i),"Name",5) MESSAGEBOX("Item " + ALLTRIM(STR(i)) + " " + o.Items(i).Name) ELSE MESSAGEBOX("COM object") ENDIF ENDFOR o.CaseSensitive = .T. LOCAL lcName lcName = IIF(NOT ISNULL(o.Items("my checCKBOX")),; o.Items("my checCKBOX").Name,"Object is NULL") MESSAGEBOX("access a memeber with case sensitivity on with wrong case" ; + CHR(13) + "Name = " + lcName) lcName = IIF(NOT ISNULL(o.Items("MY chEcKbox")),; o.Items("MY chEcKbox").Name,"Object is NULL") MESSAGEBOX("access a memeber with case sensitivity on with correct case" ; + CHR(13) + "Name = " + lcName) MESSAGEBOX("remove item with wrong case with case sensitive on") o.RemoveItem("my cheCKBOX") MESSAGEBOX("o.Length="+ALLTRIM(STR(o.Length))) MESSAGEBOX("remove item with correct case with case sensitive on") o.RemoveItem("MY chEcKbox") MESSAGEBOX("o.Length="+ALLTRIM(STR(o.Length))) MESSAGEBOX("RemoveAll items") o.RemoveAll MESSAGEBOX("o.Length="+ALLTRIM(STR(o.Length))) * VFP 7 Collection Object ************************************ DEFINE Class Collection AS SESSION Length = 0 CaseSensitive = .F. DIMENSION Items[1] Items[1] = NULL DIMENSION ItemNames[1] ItemNames[1] = NULL ************************************ FUNCTION Length_Access AS INTEGER LOCAL lnLength IF ISNULL(This.Items[1]) lnLength = 0 ELSE lnLength = ALEN(This.Items) ENDIF RETURN lnLength ENDFUNC ************************************ FUNCTION AddItem(ObjectName AS CHARACTER,; ClassName AS CHARACTER, LibraryName AS CHARACTER) AS VOID LOCAL lnLength lnLength = This.Length + 1 DIMENSION This.Items[lnLength], This.ItemNames[lnLength] This.ItemNames[lnLength] = ObjectName IF VARTYPE(LibraryName) = "C" This.Items[lnLength] = NEWOBJECT(ClassName, LibraryName) ELSE This.Items[lnLength] = CREATEOBJECT(ClassName) ENDIF ENDFUNC ************************************ FUNCTION Items_Access(vMember AS Variant) AS OBJECT LOCAL lnLength, loObject IF ISNULL(This.Items[1]) && Cant use This.Length here RETURN NULL ELSE lnLength = ALEN(This.Items) ENDIF DO CASE CASE VARTYPE(vMember) = "C" LOCAL lnIndex IF NOT This.CaseSensitive lnIndex = ASCAN(This.ItemNames, vMember,1,0,1,03) ELSE lnIndex = ASCAN(This.ItemNames,vMember,1,0,1) ENDIF IF lnIndex > 0 RETURN This.Items(lnIndex) ELSE RETURN NULL ENDIF CASE VARTYPE(vMember) = "N" IF NOT vMember > lnLength OR vMember = 0 && VFP collections not zero based RETURN This.Items(vMember) ELSE RETURN NULL ENDIF OTHERWISE RETURN NULL ENDCASE ENDFUNC ************************************ FUNCTION RemoveItem(vMember AS Variant) AS VOID LOCAL lnLength lnLength = This.Length IF NOT lnLength = 0 DO CASE CASE VARTYPE(vMember) = "C" LOCAL lnIndex IF NOT This.CaseSensitive lnIndex = ASCAN(This.ItemNames, vMember,1,0,1,03) ELSE lnIndex = ASCAN(This.ItemNames,vMember,1,0,1) ENDIF IF lnIndex > 0 ADEL(This.Items,lnIndex) ADEL(This.ItemNames,lnIndex) DIMENSION This.Items[lnLength-1] DIMENSION This.ItemNames[lnLength-1] ENDIF CASE VARTYPE(vMember) = "N" IF NOT vMember > lnLength OR vMember = 0 ADEL(This.Items,vMember) ADEL(This.ItemNames,vMember) DIMENSION This.Items[lnLength-1] DIMENSION This.ItemNames[lnLength-1] ENDIF ENDCASE ENDIF ENDFUNC ************************************ FUNCTION RemoveAll AS VOID DIMENSION This.Items[1], This.ItemNames[1] This.Items(1) = NULL This.ItemNames[1] = NULL ENDFUNC ************************************ FUNCTION ERROR(nError AS INTEGER, cMethod AS INTEGER, nLine AS INTEGER) AS VOID * Return type to be modified as needed LOCAL lcError, lcLine lcError = ALLTRIM(STR(nError)) lcLine = ALLTRIM(STR(nLine)) ASSERT .F. MESSAGE "Error No " + lcError + ", " ; + "Line No " + lcLine + ", Method " + cMethod + CHR(13) + MESSAGE(0) ENDFUNC ************************************ FUNCTION Destroy AS VOID DIMENSION This.Items[1] This.Items = NULL ENDFUNC ************************************ * FUNCTION This_Access(cMember AS VARIANT) AS VARIANT * Is this method supposed to fire on properties and method names? * When the property Length is queried the cMember parameter is filled * with "length" * IF PARAMETERS() = 1 AND NOT PEMSTATUS(This, cMember, 5) * RETURN This.Items * ENDIF * RETURN This * ENDFUNC ************************************ ENDDEFINE