option explicit

!INC Local Scripts.EAConstants-VBScript

'
' Example of how to utilise the search window from scripts
'
' NOTE: Requires an element to be selected in context
' 
' Related APIs
' =================================================================================
' Repository API - http://www.sparxsystems.com/enterprise_architect_user_guide/12.1/automation_and_scripting/repository3.html
' Attribute API - http://www.sparxsystems.com/enterprise_architect_user_guide/12.1/automation_and_scripting/attribute.html
' Element API - http://www.sparxsystems.com/enterprise_architect_user_guide/12.1/automation_and_scripting/element2.html
'

' The columns that will appear in the Model Search window
dim SEARCH_SPECIFICATION
SEARCH_SPECIFICATION = "<ReportViewData>" & _
							"<Fields>" & _
							"<Field name='CLASSGUID' />" & _
							"<Field name='CLASSTYPE' />" & _
							"<Field name='Name' />" & _
							"<Field name='Scope' />" & _
							"<Field name='Stereotype' />" & _
							"<Field name='Type' />" & _
							"<Field name='Note' />" & _
							"<Field name='Element' />" & _
							"</Fields>" & _
							"<Rows/>" & _
							"</ReportViewData>"

Function CreateXMLObject()
	dim xmlDOM
	
	On Error Resume Next
	set xmlDOM = CreateObject( "MSXML2.DOMDocument.4.0" )
	If Err.Number <> 0 Then
		set xmlDOM = CreateObject( "MSXML2.DOMDocument.6.0" )
	End if 
	On Error Goto 0
	
	xmlDOM.validateOnParse = false
	xmlDOM.async = "false"
	
	set CreateXMLObject = xmlDOM
end Function
							
'
' Finds all Attributes and inherited Attributes of the selected context element.
' The results are added to an XML document and passed back to the Model Search window to display 
' the results.
'
sub RunModelSearchExample()

	' Show the script output window
	Repository.EnsureOutputVisible "Script"

	Session.Output( "VBScript RUN MODEL SEARCH EXAMPLE" )
	Session.Output( "=======================================" )
	
	' Create a DOM object to represent the search tree
	dim xmlDOM
	set xmlDOM = CreateXMLObject()
	
	dim selectedObject as EA.Element
	set selectedObject = Repository.GetContextObject()
	
	if not selectedObject is nothing and selectedObject.ObjectType = otElement then
		
		Session.Output( "Working on element '" & selectedObject.Name & "' (Type=" & _
			selectedObject.Type & ", ID=" & selectedObject.ElementID & ")" )
		
		' Retrieve all attributes and inherited attributes for this object
		dim attributesCollection as EA.Collection
		set attributesCollection = selectedObject.AttributesEx
		
		' Load the search template
		if xmlDOM.loadXML( SEARCH_SPECIFICATION ) = true then
		
			dim node
			set node = xmlDOM.selectSingleNode( "//ReportViewData//Rows" )
			
			if attributesCollection.Count > 0 then
								
				dim objectIDs		
				objectIDs = ""
				
				' Get the Object IDs for all elements that declare attributes in the inheritance
				' hierarchy of the selected object
				objectIDs = GetObjectIDs( attributesCollection )
				
				if objectIDs <> "" then
				
					' Now we have the IDs of all elements in the hierarchy, get the actual elements
					' themselves
					dim elementCollection as EA.Collection
					set elementCollection = GetElementSet( objectIDs, 0 )
															
					' For each Attribute extract the information to populate our XML document, this
					' will make up the row data in the Model Search window
					dim lastID
					dim elementName
					
					lastID = selectedObject.ElementID
					elementName = selectedObject.Name
					
					dim attribute as EA.Attribute
					for each attribute in attributesCollection
						
						' If the attribute belongs to the current element (lastID) use its name,
						' otherwise get the name of the Element for the inherited attribute
						if lastID <> attribute.ParentID then
							
							elementName = GetOwningElementName( elementCollection, attribute )
							lastID = attribute.ParentID
							
						end if
						
						' Add this element to the XML tree
						AddRow xmlDOM, node, elementName, attribute
					next
					
				else
					Session.Output( "Error constructing Object ID list" )
				end if
				
			end if
		
			' Fill the Model Search window with the results
			Repository.RunModelSearch "", "", "", xmlDOM.xml
		
		else
			Session.Prompt "Failed to load search xml", promptOK
		end if
	
		Session.Output( "Done!" )
	
	else
		' No item selected in context, or the item selected was not an element
		Session.Prompt "This script requires the current context item to be an element." & _
			vbCrLf & "Please select an element and try again.", promptOK
	end if

end sub

'
' Adds an entry for the attribute object 'theAttribute' to the xml row node 'rowsNode'
'
sub AddRow( xmlDOM, rowsNode, elementName, theAttribute )

	' Cast theAttribute for intellisense
	dim attribute as EA.Attribute
	set attribute = theAttribute

	' Create a Row node
	dim row
	set row = xmlDOM.createElement( "Row" )

	' Add the Model Search row data to our DOM
	AddField xmlDOM, row, "CLASSGUID", attribute.AttributeGUID
	AddField xmlDOM, row, "CLASSTYPE", "Attribute"
	AddField xmlDOM, row, "Name", attribute.Name
	AddField xmlDOM, row, "Scope", attribute.Visibility
	AddField xmlDOM, row, "Stereotype", attribute.Stereotype
	AddField xmlDOM, row, "Type", attribute.Type
	AddField xmlDOM, row, "Note", attribute.Notes
	AddField xmlDOM, row, "Element", elementName

	' Append the newly created row node to the rows node
	rowsNode.appendChild( row )

end sub

'
' Adds an Element to our DOM called Field which makes up the Row data for the Model Search window.
' <Field name "" value ""/>
'
sub AddField( xmlDOM, row, name, value )

	dim fieldNode
	set fieldNode = xmlDOM.createElement( "Field" )
	
	' Create first attribute for the name
	dim nameAttribute
	set nameAttribute = xmlDOM.createAttribute( "name" )
	nameAttribute.value = name
	fieldNode.attributes.setNamedItem( nameAttribute )
	
	' Create second attribute for the value
	dim valueAttribute 
	set valueAttribute = xmlDOM.createAttribute( "value" )
	valueAttribute.value = value
	fieldNode.attributes.setNamedItem( valueAttribute )
	
	' Append the fieldNode
	row.appendChild( fieldNode )

end sub

'
' Returns the name of the element in 'theElementCollection' that declares the attribute 'theAttribute'
'
function GetOwningElementName( theElementCollection, theAttribute )

	dim i

	' Cast theAttribute to get intellisense
	dim currentAttribute as EA.Attribute
	set currentAttribute = theAttribute
	
	' Cast elementCollection to get intellisense
	dim elementCollection as EA.Collection
	set elementCollection = theElementCollection
	
	dim elementName
	elementName = ""
		
	' Iterate through elements in the elementCollection to find the declaring element
	for i = 0 to elementCollection.Count - 1
	
		dim element as EA.Element
		set element = elementCollection.GetAt( i )
	
		' Is this element the declaring element?
		if not element is nothing and element.ElementID = currentAttribute.ParentID then
			elementName = element.Name
			exit for
		end if
	
	next

	GetOwningElementName = elementName
	
end function

'
' Returns a unique comma seperated string of Element IDs for every Attribute and inherited Attribute of
' the selected Class in the Project Browser
'
function GetObjectIDs( attributesCollection )

	' Cast attributesCollection for intellisense
	dim theAttributesCollection as EA.Collection
	set theAttributesCollection = attributesCollection
	
	dim objectIDs
	dim lastID
	
	objectIDs = ""
	lastID = 0
	
	' Iterate through all attributes and add their parent ID to the object IDs list
	dim attribute as EA.Attribute
	for each attribute in theAttributesCollection
	
		' Only record each objectID once
		if lastID <> attribute.ParentID then
			objectIDs = objectIDs & attribute.ParentID & ","
			lastID = attribute.ParentID
		end if
	
	next
	
	' Trim the trailing comma from the signature
	dim listLength
	listLength = len( objectIDs )
	
	if listLength > 1 then
		objectIDs = left( objectIDs, listLength - 1 )
	end if
	
	GetObjectIDs = objectIDs

end function

RunModelSearchExample()