' Copyright 2008 ESRI
'
' All rights reserved under the copyright laws of the United States
' and applicable international laws, treaties, and conventions.
'
' You may freely redistribute and use this sample code, with or
' without modification, provided you include the original copyright
' notice and use restrictions.
'
' See use restrictions at <your ArcGIS install location>/developerkit/userestrictions.txt.
'
Option Explicit
Private mApplication As esriFramework.IApplication
Private mXMLDocumentSource As MSXML2.DOMDocument
Private mXMLDocumentTarget As MSXML2.DOMDocument
Private Const MODULE_NAME As String = "frmDomainImportValidator.frm"
Private Enum enumDomainCompare
enumDCRemoved = -1
enumDCIdentical = 0
enumDCNew = 1
enumDCModified = 2
enumDCModifiedInvalid = 3
enumDCIncompatiable = 4
End Enum
Public Sub Init(ByRef pApplication As esriFramework.IApplication)
On Error GoTo ErrorHandler
'-----------------------
' Set Modular Variables
'-----------------------
Set mApplication = pApplication
'-----------
' Load Form
'-----------
Load Me
'--------------
' Display Form
'--------------
Me.Show vbModeless
'
Exit Sub
ErrorHandler:
Call HandleError(False, "Init " & MODULE_NAME & " (" & CStr(Erl) & ")", Err.Number, Err.Source, Err.Description)
End Sub
Private Sub Form_Load()
On Error GoTo ErrorHandler
'
Dim pColumnHeader As ColumnHeader
'------
' Form
'------
Me.CAPTION = App.FileDescription
'------------
' Status Bar
'------------
Me.StatusBar1.Style = sbrSimple
'----------------------------
' ListBox 1 - Source Domains
'----------------------------
Me.ListView1.View = lvwReport
Me.ListView1.Checkboxes = True
Me.ListView1.Sorted = True
Me.ListView1.LabelEdit = lvwManual
Me.ListView1.GridLines = False
Set pColumnHeader = Me.ListView1.ColumnHeaders.Add(, , "Source Domains", CSng(0.9 * Me.ListView1.Width))
'-------------------------------------------------
' ListBox 2 - Source and Target Domain Properties
'-------------------------------------------------
Me.ListView2.View = lvwReport
Me.ListView2.Checkboxes = False
Me.ListView2.LabelEdit = lvwManual
Me.ListView2.GridLines = True
Set pColumnHeader = Me.ListView2.ColumnHeaders.Add(, , "Domain Property", CSng(0.95 * Me.ListView2.Width / 3))
Set pColumnHeader = Me.ListView2.ColumnHeaders.Add(, , "Source", CSng(0.95 * Me.ListView2.Width / 3))
Set pColumnHeader = Me.ListView2.ColumnHeaders.Add(, , "Target", CSng(0.95 * Me.ListView2.Width / 3))
'----------------------------------------------
' ListBox 3 - Source and Target Domain Members
'----------------------------------------------
Me.ListView3.View = lvwReport
Me.ListView3.Checkboxes = False
Me.ListView3.LabelEdit = lvwManual
Me.ListView3.GridLines = True
Set pColumnHeader = Me.ListView3.ColumnHeaders.Add(, , "Source Value", CSng(0.95 * Me.ListView3.Width / 4))
Set pColumnHeader = Me.ListView3.ColumnHeaders.Add(, , "Source Name", CSng(0.95 * Me.ListView3.Width / 4))
Set pColumnHeader = Me.ListView3.ColumnHeaders.Add(, , "Target Value", CSng(0.95 * Me.ListView3.Width / 4))
Set pColumnHeader = Me.ListView3.ColumnHeaders.Add(, , "Target Name", CSng(0.95 * Me.ListView3.Width / 4))
'-------------------------
' Selection OptionButtons
'-------------------------
Me.optSelection1.Value = True
'----------------
' Action Buttons
'----------------
Me.cmdLoadSource.Enabled = True
Me.cmdLoad.Enabled = False
'-------------------------
' Disable Selection Frame
'-------------------------
Call EnableFrame(Me.fmeSelection, False)
'----------------------------------------------
' TreeView 1 - Source Associated ObjectClasses
'----------------------------------------------
Me.TreeView1.Style = MSComctlLib.tvwTreelinesPlusMinusPictureText
Me.TreeView1.Indentation = 300
'----------------------------------------------
' TreeView 2 - Target Associated ObjectClasses
'----------------------------------------------
Me.TreeView2.Style = MSComctlLib.tvwTreelinesPlusMinusPictureText
Me.TreeView2.Indentation = 300
'-------------------
' Load PictureBoxes
'-------------------
Me.Picture1.Picture = Me.ImageList1.ListImages.Item(1).Picture
Me.Picture2.Picture = Me.ImageList1.ListImages.Item(2).Picture
Me.Picture3.Picture = Me.ImageList1.ListImages.Item(3).Picture
Me.Picture4.Picture = Me.ImageList1.ListImages.Item(4).Picture
Me.Picture5.Picture = Me.ImageList1.ListImages.Item(5).Picture
'
Exit Sub
ErrorHandler:
Call HandleError(True, "Form_Load " & MODULE_NAME & " (" & CStr(Erl) & ")", Err.Number, Err.Source, Err.Description)
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error GoTo ErrorHandler
'-------------------------
' Clear ListView Controls
'-------------------------
Me.ListView1.ListItems.Clear
Me.ListView2.ListItems.Clear
Me.ListView3.ListItems.Clear
'-------------------------
' Clear TreeView Controls
'-------------------------
Me.TreeView1.Nodes.Clear
Me.TreeView2.Nodes.Clear
'-------------------------
' Clear Modular Variables
'-------------------------
Set mApplication = Nothing
'
Exit Sub
ErrorHandler:
Call HandleError(True, "Form_Unload " & MODULE_NAME & " (" & CStr(Erl) & ")", Err.Number, Err.Source, Err.Description)
End Sub
Private Sub cmdClose_Click()
On Error GoTo ErrorHandler
'
Unload Me
'
Exit Sub
ErrorHandler:
Call HandleError(True, "cmdClose_Click " & MODULE_NAME & " (" & CStr(Erl) & ")", Err.Number, Err.Source, Err.Description)
End Sub
Private Sub cmdLoadSource_Click()
On Error GoTo ErrorHandler
'-------------------------
' Get Source XML Document
'-------------------------
Dim pListItems As ListItems
Dim pListItem As ListItem
Dim pIndexSource As Long
'
Dim pXMLDocumentSourceTemp As MSXML2.DOMDocument
'
Dim pXMLDOMNodeDomainList As MSXML2.IXMLDOMNodeList
Dim pXMLDOMNodeDomain As MSXML2.IXMLDOMNode
Dim pIndexDomain As Long
'
Dim pXMLDOMNodeGeodatabaseDesignerSource As MSXML2.IXMLDOMNode
Dim pXMLDOMNodeGeodatabaseDesignerTarget As MSXML2.IXMLDOMNode
'
Dim pXMLDOMNodeDomainTemp As MSXML2.IXMLDOMNode
Dim pXMLDOMNodeDomainSource As MSXML2.IXMLDOMNode
Dim pXMLDOMNodeDomainTarget As MSXML2.IXMLDOMNode
'
Set mXMLDocumentSource = Nothing
Set mXMLDocumentTarget = Nothing
'
Set pXMLDocumentSourceTemp = modCommon.GetXMLDocument
If pXMLDocumentSourceTemp Is Nothing Then
Exit Sub
Else
Set mXMLDocumentSource = pXMLDocumentSourceTemp
Set pXMLDocumentSourceTemp = Nothing
End If
'------------------------------------------------------------
' Examine each source domain against the every target domain
' Get Domain NodeLists from both the Source and Target
'------------------------------------------------------------
Set pXMLDOMNodeGeodatabaseDesignerSource = mXMLDocumentSource.getElementsByTagName("geodatabaseDesigner").nextNode
Set pXMLDOMNodeDomainList = pXMLDOMNodeGeodatabaseDesignerSource.selectNodes("domain")
'
Set pListItems = Me.ListView1.ListItems
pListItems.Clear
'
Call UpdateStatusBar("Loading Source Domains...")
For pIndexDomain = 0 To pXMLDOMNodeDomainList.length - 1 Step 1
Set pXMLDOMNodeDomain = pXMLDOMNodeDomainList(pIndexDomain)
Set pListItem = pListItems.Add(, , pXMLDOMNodeDomain.Attributes.getNamedItem("name").Text)
Next pIndexDomain
'------------------------------------------------------------------
' Load domains from the currently selected geodatabase into memory
'-----------------------------------------------------------------
Set mXMLDocumentTarget = modImportExport.ExportDomain(mApplication)
If mXMLDocumentTarget Is Nothing Then
MsgBox "Problem encountered whilst exporting Domains from target geodatabase", vbExclamation, App.FileDescription
Exit Sub
End If
Set pXMLDOMNodeGeodatabaseDesignerTarget = mXMLDocumentTarget.getElementsByTagName("geodatabaseDesigner").nextNode
'--------------------
' Get Workspace Type
'--------------------
Dim pEsriWorkspaceTypeTarget As esriGeoDatabase.esriWorkspaceType
Dim pXMLDOMNodeGeodatabase As MSXML2.IXMLDOMNode
Set pXMLDOMNodeGeodatabase = pXMLDOMNodeGeodatabaseDesignerTarget.selectNodes("metadata/geodatabase").nextNode
pEsriWorkspaceTypeTarget = CLng(pXMLDOMNodeGeodatabase.Attributes.getNamedItem("esriWorkspaceType").Text)
'------------------------------------------------------------
' Loop for each source domain (get domain name from ListBox)
'------------------------------------------------------------
Set pListItems = Me.ListView1.ListItems
For pIndexSource = 1 To pListItems.Count Step 1
Set pListItem = pListItems.Item(pIndexSource)
'------------------------
' Get Source Domain Node
'------------------------
Set pXMLDOMNodeDomainSource = pXMLDOMNodeGeodatabaseDesignerSource.selectNodes("domain[@name='" & pListItem.Text & "']").nextNode
'------------------------
' Get Target Domain Node
'------------------------
Set pXMLDOMNodeDomainTarget = pXMLDOMNodeGeodatabaseDesignerTarget.selectNodes("domain[@name='" & pListItem.Text & "']").nextNode
If pXMLDOMNodeDomainTarget Is Nothing Then
'--------------------------------------
' Domain is NEW. Change colour to BLUE
'--------------------------------------
pListItem.SmallIcon = 1
Else
'--------------------------------
' Domain already exists. Analyze
'--------------------------------
Call UpdateStatusBar("Comparing Source and Target Domain: " & pListItem.Text)
'
Select Case CompareDomainNodes(pXMLDOMNodeDomainSource, pXMLDOMNodeDomainTarget, pEsriWorkspaceTypeTarget)
Case enumDCNew
pListItem.SmallIcon = 1
pListItem.Ghosted = False
Case enumDCModified
pListItem.SmallIcon = 2
pListItem.Ghosted = False
Case enumDCModifiedInvalid
pListItem.SmallIcon = 3
pListItem.Ghosted = False
Case enumDCIdentical
pListItem.SmallIcon = 4
pListItem.Ghosted = True
Case enumDCIncompatiable
pListItem.SmallIcon = 5
pListItem.Ghosted = True
End Select
End If
Next pIndexSource
'----------------------------------------
' Select the first entry in the ListView
'----------------------------------------
If Me.ListView1.ListItems.Count > 0 Then
Set pListItem = Me.ListView1.ListItems.Item(1)
Set Me.ListView1.SelectedItem = pListItem
Call UpdateDomainPropertiesListView
End If
'------------------------
' Enable Selection Frame
'------------------------
Call EnableFrame(Me.fmeSelection, True)
'-----------------------------------------------------
' Change the Load Button Caption to Reload Source XML
'-----------------------------------------------------
Me.cmdLoadSource.CAPTION = "Re-Load Source XML"
'-----------------
' Clear StatusBar
'-----------------
Call UpdateStatusBar("")
'
Exit Sub
ErrorHandler:
Call HandleError(True, "cmdLoadSource_Click " & MODULE_NAME & " (" & CStr(Erl) & ")", Err.Number, Err.Source, Err.Description)
End Sub
Private Function CompareDomainNodes(ByRef pXMLDOMNodeDomain1 As MSXML2.IXMLDOMNode, _
ByRef pXMLDOMNodeDomain2 As MSXML2.IXMLDOMNode, _
ByRef pEsriWorkspaceTypeTarget As esriGeoDatabase.esriWorkspaceType) As enumDomainCompare
On Error GoTo ErrorHandler
'
Dim pXMLDOMNodeMemberList1 As MSXML2.IXMLDOMNodeList
Dim pXMLDOMNodeMemberList2 As MSXML2.IXMLDOMNodeList
Dim pXMLDOMNodeMember1 As MSXML2.IXMLDOMNode
Dim pXMLDOMNodeMember2 As MSXML2.IXMLDOMNode
'
Dim pIndexMember As Long
Dim pMemberValue As String
'-------------------
' Get Members Nodes
'-------------------
Set pXMLDOMNodeMemberList1 = pXMLDOMNodeDomain1.selectNodes("member")
Set pXMLDOMNodeMemberList2 = pXMLDOMNodeDomain2.selectNodes("member")
'------------------
' Set Default Flag
'------------------
CompareDomainNodes = enumDCIdentical
'------------------------
' Look for modifications
'------------------------
If pXMLDOMNodeDomain1.Attributes.getNamedItem("esriDomainType").Text <> _
pXMLDOMNodeDomain2.Attributes.getNamedItem("esriDomainType").Text Then
'-----------------------
' Different Domain Type
'-----------------------
CompareDomainNodes = enumDCIncompatiable
Exit Function
End If
If pXMLDOMNodeDomain1.Attributes.getNamedItem("esriFieldType").Text <> _
pXMLDOMNodeDomain2.Attributes.getNamedItem("esriFieldType").Text Then
'----------------------
' Different Field Type
'----------------------
CompareDomainNodes = enumDCIncompatiable
Exit Function
End If
Select Case CLng(pXMLDOMNodeDomain1.Attributes.getNamedItem("esriDomainType").Text)
Case esriGeoDatabase.esriDomainType.esriDTCodedValue
'------------------------------------------------------
' Check if no Target Members are missing (values only)
'------------------------------------------------------
For pIndexMember = 0 To pXMLDOMNodeMemberList2.length - 1 Step 1
Set pXMLDOMNodeMember2 = pXMLDOMNodeMemberList2.Item(pIndexMember)
pMemberValue = pXMLDOMNodeMember2.Attributes.getNamedItem("value").Text
If pXMLDOMNodeDomain1.selectNodes("member[@value='" & pMemberValue & "']").length = 0 Then
'-------------------------------------------------
' Target Values are MISSING in the Source Domain
'------------------------------------------------
CompareDomainNodes = enumDCModifiedInvalid
Exit Function
End If
Next pIndexMember
'--------------------
' Check Descriptions
'--------------------
For pIndexMember = 0 To pXMLDOMNodeMemberList2.length - 1 Step 1
Set pXMLDOMNodeMember2 = pXMLDOMNodeMemberList2.Item(pIndexMember)
pMemberValue = pXMLDOMNodeMember2.Attributes.getNamedItem("value").Text
Set pXMLDOMNodeMember1 = pXMLDOMNodeDomain1.selectNodes("member[@value='" & pMemberValue & "']").nextNode
If UCase(pXMLDOMNodeMember1.Attributes.getNamedItem("name").Text) <> _
UCase(pXMLDOMNodeMember2.Attributes.getNamedItem("name").Text) Then
'---------------------------------------
' Source and Target descriptions differ
'---------------------------------------
CompareDomainNodes = enumDCModified
Exit Function
End If
Next pIndexMember
'--------------------
' Additional Members
'--------------------
If pXMLDOMNodeMemberList1.length > pXMLDOMNodeMemberList2.length Then
CompareDomainNodes = enumDCModified
Exit Function
End If
Case esriGeoDatabase.esriDomainType.esriDTRange
'-----------------------------------------------------------
' Check if the new range is not smaller than the old domain
'-----------------------------------------------------------
Set pXMLDOMNodeMember1 = pXMLDOMNodeMemberList1.nextNode
Set pXMLDOMNodeMember2 = pXMLDOMNodeMemberList2.nextNode
If CDbl(pXMLDOMNodeMember1.Attributes.getNamedItem("minValue").Text) > _
CDbl(pXMLDOMNodeMember2.Attributes.getNamedItem("minValue").Text) Then
CompareDomainNodes = enumDCModifiedInvalid
Exit Function
End If
If CDbl(pXMLDOMNodeMember1.Attributes.getNamedItem("maxValue").Text) < _
CDbl(pXMLDOMNodeMember2.Attributes.getNamedItem("maxValue").Text) Then
CompareDomainNodes = enumDCModifiedInvalid
Exit Function
End If
If CDbl(pXMLDOMNodeMember1.Attributes.getNamedItem("minValue").Text) < _
CDbl(pXMLDOMNodeMember2.Attributes.getNamedItem("minValue").Text) Then
CompareDomainNodes = enumDCModified
Exit Function
End If
If CDbl(pXMLDOMNodeMember1.Attributes.getNamedItem("maxValue").Text) > _
CDbl(pXMLDOMNodeMember2.Attributes.getNamedItem("maxValue").Text) Then
CompareDomainNodes = enumDCModified
Exit Function
End If
Case Else
'
End Select
'
If pXMLDOMNodeDomain1.Attributes.getNamedItem("description").Text <> _
pXMLDOMNodeDomain2.Attributes.getNamedItem("description").Text Then
'-----------------------
' Different Description
'-----------------------
CompareDomainNodes = enumDCModified
Exit Function
End If
If pEsriWorkspaceTypeTarget = esriRemoteDatabaseWorkspace Then
If pXMLDOMNodeDomain1.Attributes.getNamedItem("owner").Text <> "" Then
If pXMLDOMNodeDomain1.Attributes.getNamedItem("owner").Text <> _
pXMLDOMNodeDomain2.Attributes.getNamedItem("owner").Text Then
'-----------------------
' Different Owner
'-----------------------
CompareDomainNodes = enumDCModified
Exit Function
End If
End If
End If
If pXMLDOMNodeDomain1.Attributes.getNamedItem("esriSplitPolicyType").Text <> _
pXMLDOMNodeDomain2.Attributes.getNamedItem("esriSplitPolicyType").Text Then
'------------------------
' Different Split Policy
'------------------------
CompareDomainNodes = enumDCModified
Exit Function
End If
If pXMLDOMNodeDomain1.Attributes.getNamedItem("esriMergePolicyType").Text <> _
pXMLDOMNodeDomain2.Attributes.getNamedItem("esriMergePolicyType").Text Then
'------------------------
' Different Merge Policy
'------------------------
CompareDomainNodes = enumDCModified
Exit Function
End If
'
Exit Function
ErrorHandler:
Call HandleError(False, "CompareDomainNodes " & MODULE_NAME & " (" & CStr(Erl) & ")", Err.Number, Err.Source, Err.Description)
End Function
Private Sub ListView1_Click()
On Error GoTo ErrorHandler
'
Call UpdateDomainPropertiesListView
'
Exit Sub
ErrorHandler:
Call HandleError(True, "ListView1_Click " & MODULE_NAME & " (" & CStr(Erl) & ")", Err.Number, Err.Source, Err.Description)
End Sub
Private Sub ListView1_ItemCheck(ByVal Item As MSComctlLib.ListItem)
On Error GoTo ErrorHandler
'
If Item.Checked Then
If Item.Ghosted Then
Item.Checked = False
Select Case Item.SmallIcon
Case 4
MsgBox "This Domain already exists in the Target Geodatabase", vbExclamation, App.FileDescription
Case 5
MsgBox "This Domain is incompatiable with the corresponding domain in the Target Geodatabase", vbExclamation, App.FileDescription
Case Else
MsgBox "This Domain cannot be imported", vbExclamation, App.FileDescription
End Select
Else
Me.cmdLoad.Enabled = True
End If
Else
Call UpdateLoadButton
End If
'
Exit Sub
ErrorHandler:
Call HandleError(True, "ListView1_ItemCheck " & MODULE_NAME & " (" & CStr(Erl) & ")", Err.Number, Err.Source, Err.Description)
End Sub
Private Sub UpdateLoadButton()
On Error GoTo ErrorHandler
'
Dim pIndex As Long
'
For pIndex = 1 To Me.ListView1.ListItems.Count Step 1
If Me.ListView1.ListItems.Item(pIndex).Checked Then
Me.cmdLoad.Enabled = True
Exit Sub
End If
Next pIndex
'
Me.cmdLoad.Enabled = False
'
Exit Sub
ErrorHandler:
Call HandleError(False, "UpdateLoadButton " & MODULE_NAME & " (" & CStr(Erl) & ")", Err.Number, Err.Source, Err.Description)
End Sub
Private Sub ListView1_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo ErrorHandler
'
Call UpdateDomainPropertiesListView
'
Exit Sub
ErrorHandler:
Call HandleError(True, "ListView1_KeyDown " & MODULE_NAME & " (" & CStr(Erl) & ")", Err.Number, Err.Source, Err.Description)
End Sub
Private Sub UpdateDomainPropertiesListView()
On Error GoTo ErrorHandler
'============================================================
' <domain name="" description="" owner="" esriDomainType="" esriFieldType="" esriMergePolicyType="" esriSplitPolicyType="">
' <!-- Coded Domain -->
' <member name="" value="" />
' <!-- Range Domain -->
' <member minValue="" maxValue="" />
' <objectClass database="" owner="" table="">
' <subtype name="">
' <field name=""/>
' </subtype>
' </objectClass>
' </domain>
'============================================================
Dim pXMLDOMNodeDomainList1 As MSXML2.IXMLDOMNodeList
Dim pXMLDOMNodeDomainList2 As MSXML2.IXMLDOMNodeList
Dim pXMLDOMNodeDomain1 As MSXML2.IXMLDOMNode
Dim pXMLDOMNodeDomain2 As MSXML2.IXMLDOMNode
Dim pXMLDOMNodeMemberList1 As MSXML2.IXMLDOMNodeList
Dim pXMLDOMNodeMemberList2 As MSXML2.IXMLDOMNodeList
Dim pXMLDOMNodeMember1 As MSXML2.IXMLDOMNode
Dim pXMLDOMNodeMember2 As MSXML2.IXMLDOMNode
Dim pXMLDOMNodeObjectClassList1 As MSXML2.IXMLDOMNodeList
Dim pXMLDOMNodeObjectClassList2 As MSXML2.IXMLDOMNodeList
'
Dim pListItems As ListItems
Dim pListItem As ListItem
'
Dim pDomainName As String
Dim pIndex As Long
'------------------------------
' Exit if not items in ListBox
'------------------------------
If Me.ListView1.ListItems.Count = 0 Then
Exit Sub
End If
'---------------------------------------------------------
' Back out if nothing selected in Source Domains ListView
'---------------------------------------------------------
If Me.ListView1.SelectedItem.Index < 1 Then
Exit Sub
End If
'-----------------------------
' Get Name of Selected Domain
'-----------------------------
pDomainName = Me.ListView1.SelectedItem.Text
Set pXMLDOMNodeDomainList1 = mXMLDocumentSource.selectNodes("geodatabaseDesigner/domain[@name='" & pDomainName & "']")
Set pXMLDOMNodeDomainList2 = mXMLDocumentTarget.selectNodes("geodatabaseDesigner/domain[@name='" & pDomainName & "']")
'--------------------------------------------
' Get Domain Node from Source and Target XML
'--------------------------------------------
If pXMLDOMNodeDomainList1.length = 0 Then
'-------------------------------------
' Cannot Find Source Domain! - ERROR!
'-------------------------------------
MsgBox "Cannot find domain [" & pDomainName & "] in Source XML Document", vbExclamation, App.FileDescription
Exit Sub
Else
Set pXMLDOMNodeDomain1 = pXMLDOMNodeDomainList1.nextNode
End If
If pXMLDOMNodeDomainList2.length = 0 Then
'------------------------------------------------
' Cannot Find Target Domian - It is a NEW Domain
'------------------------------------------------
Else
Set pXMLDOMNodeDomain2 = pXMLDOMNodeDomainList2.nextNode
End If
'----------------------------------------
' Populate ListView2 - Domain Properties
'----------------------------------------
Set pListItems = ListView2.ListItems
pListItems.Clear
Call AddDomainProperties(pListItems, pXMLDOMNodeDomain1, pXMLDOMNodeDomain2, "Name", "name")
Call AddDomainProperties(pListItems, pXMLDOMNodeDomain1, pXMLDOMNodeDomain2, "Description", "description")
Call AddDomainProperties(pListItems, pXMLDOMNodeDomain1, pXMLDOMNodeDomain2, "Owner", "owner")
Call AddDomainProperties(pListItems, pXMLDOMNodeDomain1, pXMLDOMNodeDomain2, "Domain Type", "esriDomainType", Split(ENUMERATOR_DOMAINTYPE, ","))
Call AddDomainProperties(pListItems, pXMLDOMNodeDomain1, pXMLDOMNodeDomain2, "Field Type", "esriFieldType", Split(ENUMERATOR_FIELDTYPE, ","))
Call AddDomainProperties(pListItems, pXMLDOMNodeDomain1, pXMLDOMNodeDomain2, "Merge Policy Type", "esriMergePolicyType", Split(ENUMERATOR_MERGEPOLICY, ","))
Call AddDomainProperties(pListItems, pXMLDOMNodeDomain1, pXMLDOMNodeDomain2, "Split Policy Type", "esriSplitPolicyType", Split(ENUMERATOR_SPLITPOLICY, ","))
'------------------------------------
' Populate ListView - Domain Members
'------------------------------------
Set pListItems = Me.ListView3.ListItems
pListItems.Clear
'
Set pXMLDOMNodeMemberList1 = pXMLDOMNodeDomain1.selectNodes("member")
Select Case CLng(pXMLDOMNodeDomain1.Attributes.getNamedItem("esriDomainType").Text)
Case esriGeoDatabase.esriDomainType.esriDTCodedValue
'------------------------------------------
' List CodedValue Domain Members in SOURCE
'------------------------------------------
For pIndex = 0 To pXMLDOMNodeMemberList1.length - 1 Step 1
Set pXMLDOMNodeMember1 = pXMLDOMNodeMemberList1.Item(pIndex)
Set pListItem = pListItems.Add(, , pXMLDOMNodeMember1.Attributes.getNamedItem("value").Text)
pListItem.SubItems(1) = pXMLDOMNodeMember1.Attributes.getNamedItem("name").Text
Next pIndex
Case esriGeoDatabase.esriDomainType.esriDTRange
'-------------------------------------
' List Range Domain Members in TARGET
'-------------------------------------
Set pXMLDOMNodeMember1 = pXMLDOMNodeMemberList1.nextNode
Set pListItem = pListItems.Add(, , pXMLDOMNodeMember1.Attributes.getNamedItem("minValue").Text)
pListItem.SubItems(1) = "minValue"
Set pListItem = pListItems.Add(, , pXMLDOMNodeMember1.Attributes.getNamedItem("maxValue").Text)
pListItem.SubItems(1) = "maxValue"
Case esriGeoDatabase.esriDomainType.esriDTString
'-------------------------
' <<< Not Implemented >>>
'-------------------------
End Select
'
If Not (pXMLDOMNodeDomain2 Is Nothing) Then
Set pXMLDOMNodeMemberList2 = pXMLDOMNodeDomain2.selectNodes("member")
Select Case CLng(pXMLDOMNodeDomain2.Attributes.getNamedItem("esriDomainType").Text)
Case esriGeoDatabase.esriDomainType.esriDTCodedValue
'------------------------------------------
' List CodedValue Domain Members in SOURCE
'------------------------------------------
For pIndex = 0 To pXMLDOMNodeMemberList2.length - 1 Step 1
Set pXMLDOMNodeMember2 = pXMLDOMNodeMemberList2.Item(pIndex)
If CLng(pIndex + 1) > pListItems.Count Then
Set pListItem = pListItems.Add(, , "")
Else
Set pListItem = pListItems.Item(CLng(pIndex + 1))
End If
pListItem.SubItems(2) = pXMLDOMNodeMember2.Attributes.getNamedItem("value").Text
pListItem.SubItems(3) = pXMLDOMNodeMember2.Attributes.getNamedItem("name").Text
Next pIndex
Case esriGeoDatabase.esriDomainType.esriDTRange
'-------------------------------------
' List Range Domain Members in TARGET
'-------------------------------------
Set pXMLDOMNodeMember2 = pXMLDOMNodeMemberList2.nextNode
'
Select Case pListItems.Count
Case 0
Set pListItem = pListItems.Add(, , "")
Set pListItem = pListItems.Add(, , "")
Case 1
Set pListItem = pListItems.Add(, , "")
Case Else
'
End Select
'
Set pListItem = pListItems.Item(1)
pListItem.SubItems(2) = "minValue"
pListItem.SubItems(3) = pXMLDOMNodeMember2.Attributes.getNamedItem("minValue").Text
Set pListItem = pListItems.Item(2)
pListItem.SubItems(2) = "maxValue"
pListItem.SubItems(3) = pXMLDOMNodeMember2.Attributes.getNamedItem("maxValue").Text
Case esriGeoDatabase.esriDomainType.esriDTString
'-------------------------
' <<< Not Implemented >>>
'-------------------------
End Select
End If
'-----------------------------------
' Add all dependancies to TreeViews
'-----------------------------------
Set pXMLDOMNodeObjectClassList1 = pXMLDOMNodeDomain1.selectNodes("objectClass")
Call AddDomainAssociations(pXMLDOMNodeObjectClassList1, Me.TreeView1, "Source")
If Not (pXMLDOMNodeDomain2 Is Nothing) Then
Set pXMLDOMNodeObjectClassList2 = pXMLDOMNodeDomain2.selectNodes("objectClass")
Call AddDomainAssociations(pXMLDOMNodeObjectClassList2, Me.TreeView2, "Target")
End If
'
Exit Sub
ErrorHandler:
Call HandleError(False, "UpdateDomainPropertiesListView " & MODULE_NAME & " (" & CStr(Erl) & ")", Err.Number, Err.Source, Err.Description)
End Sub
Private Sub AddDomainAssociations(ByRef pObjectClassNodeList As MSXML2.IXMLDOMNodeList, _
ByRef pTreeView As MSComctlLib.TreeView, _
ByRef pTitle As String)
On Error GoTo ErrorHandler
'
Dim pSubtypeNodeList As MSXML2.IXMLDOMNodeList
Dim pFieldNodeList As MSXML2.IXMLDOMNodeList
'
Dim pObjectClassNode As MSXML2.IXMLDOMNode
Dim pSubtypeNode As MSXML2.IXMLDOMNode
Dim pFieldNode As MSXML2.IXMLDOMNode
'
Dim pNode As MSComctlLib.Node
'
Dim pIndexObjectClass As Long
Dim pIndexSubtype As Long
Dim pIndexField As Long
'
Dim pObjectClassName As String
Dim pSubtypeName As String
Dim pFieldName As String
'
pTreeView.Nodes.Clear
Set pNode = pTreeView.Nodes.Add(, , pTitle, pTitle)
pNode.Image = 1
pNode.Bold = True
pNode.Sorted = True
'
If pObjectClassNodeList.length = 0 Then
Set pNode = pTreeView.Nodes.Add(pTitle, MSComctlLib.tvwChild, "NA", "No Field Associations")
pNode.EnsureVisible
Else
For pIndexObjectClass = 0 To pObjectClassNodeList.length - 1 Step 1
Set pObjectClassNode = pObjectClassNodeList(pIndexObjectClass)
pObjectClassName = modImportExport.GetQualifiedTableNameSimple(pObjectClassNode)
Set pNode = pTreeView.Nodes.Add(pTitle, MSComctlLib.tvwChild, pObjectClassName, pObjectClassName)
pNode.Sorted = True
pNode.EnsureVisible
pNode.Image = 2
Set pSubtypeNodeList = pObjectClassNode.selectNodes("subtype")
'
For pIndexSubtype = 0 To pSubtypeNodeList.length - 1 Step 1
Set pSubtypeNode = pSubtypeNodeList(pIndexSubtype)
pSubtypeName = CStr(pSubtypeNode.Attributes.getNamedItem("name").Text)
If pSubtypeName = "" Then
pSubtypeName = "-"
End If
Set pNode = pTreeView.Nodes.Add(pObjectClassName, MSComctlLib.tvwChild, pObjectClassName & "|" & pSubtypeName, pSubtypeName)
pNode.Sorted = True
pNode.Image = 3
Set pFieldNodeList = pSubtypeNode.selectNodes("field")
'
For pIndexField = 0 To pFieldNodeList.length - 1 Step 1
Set pFieldNode = pFieldNodeList(pIndexField)
pFieldName = pFieldNode.Attributes.getNamedItem("name").Text
Set pNode = pTreeView.Nodes.Add(pObjectClassName & "|" & pSubtypeName, MSComctlLib.tvwChild, pObjectClassName & "|" & pSubtypeName & "|" & pFieldName, pFieldName)
pNode.Image = 4
'
Next pIndexField
Next pIndexSubtype
Next pIndexObjectClass
End If
'-------------------
' Select First Node
'-------------------
If pTreeView.Nodes.Count > 0 Then
Set pNode = pTreeView.Nodes.Item(1)
Set pTreeView.SelectedItem = pNode
End If
'
Exit Sub
ErrorHandler:
Call HandleError(False, "AddDomainAssociations " & MODULE_NAME & " (" & CStr(Erl) & ")", Err.Number, Err.Source, Err.Description)
End Sub
Private Sub AddDomainProperties(ByRef pListItems As ListItems, _
ByRef pXMLDOMNodeDomain1 As MSXML2.IXMLDOMNode, _
ByRef pXMLDOMNodeDomain2 As MSXML2.IXMLDOMNode, _
ByRef pHeading As String, _
ByRef pNodeName As String, _
Optional ByRef pEnumerator As Variant)
On Error GoTo ErrorHandler
'
Dim pListItem As ListItem
'
Set pListItem = pListItems.Add(, , pHeading)
pListItem.Bold = True
If IsMissing(pEnumerator) Then
pListItem.SubItems(1) = pXMLDOMNodeDomain1.Attributes.getNamedItem(pNodeName).Text
Else
pListItem.SubItems(1) = CStr(Trim(pEnumerator(pXMLDOMNodeDomain1.Attributes.getNamedItem(pNodeName).Text)))
End If
If Not (pXMLDOMNodeDomain2 Is Nothing) Then
If IsMissing(pEnumerator) Then
pListItem.SubItems(2) = pXMLDOMNodeDomain2.Attributes.getNamedItem(pNodeName).Text
Else
pListItem.SubItems(2) = CStr(Trim(pEnumerator(pXMLDOMNodeDomain2.Attributes.getNamedItem(pNodeName).Text)))
End If
End If
'
Exit Sub
ErrorHandler:
Call HandleError(False, "AddDomainProperties " & MODULE_NAME & " (" & CStr(Erl) & ")", Err.Number, Err.Source, Err.Description)
End Sub
Private Sub cmdSelect_Click()
On Error GoTo ErrorHandler
'
Call MakeDomainSelection(True)
'
Exit Sub
ErrorHandler:
Call HandleError(True, "cmdSelect_Click " & MODULE_NAME & " (" & CStr(Erl) & ")", Err.Number, Err.Source, Err.Description)
End Sub
Private Sub chkUnselect_Click()
On Error GoTo ErrorHandler
'
Call MakeDomainSelection(False)
'
Exit Sub
ErrorHandler:
Call HandleError(True, "chkUnselect_Click " & MODULE_NAME & " (" & CStr(Erl) & ")", Err.Number, Err.Source, Err.Description)
End Sub
Private Sub MakeDomainSelection(ByRef pSelect As Boolean)
On Error GoTo ErrorHandler
'
Dim pIcon As Long
Dim pIndex As Long
'
Select Case (True)
Case Me.optSelection1.Value
pIcon = 1
Case Me.optSelection2.Value
pIcon = 2
Case Me.optSelection3.Value
pIcon = 3
End Select
'
For pIndex = 1 To Me.ListView1.ListItems.Count Step 1
If Me.ListView1.ListItems.Item(pIndex).SmallIcon = pIcon Then
Me.ListView1.ListItems.Item(pIndex).Checked = pSelect
End If
Next pIndex
'
Call UpdateLoadButton
'
Exit Sub
ErrorHandler:
Call HandleError(False, "MakeDomainSelection " & MODULE_NAME & " (" & CStr(Erl) & ")", Err.Number, Err.Source, Err.Description)
End Sub
Private Sub UpdateStatusBar(ByRef pMessage As String)
On Error GoTo ErrorHandler
'
Me.StatusBar1.SimpleText = pMessage
DoEvents
'
Exit Sub
ErrorHandler:
Call HandleError(False, "UpdateStatusBar " & MODULE_NAME & " (" & CStr(Erl) & ")", Err.Number, Err.Source, Err.Description)
End Sub
Private Sub cmdLoad_Click()
On Error GoTo ErrorHandler
'
Dim pGxApplication As esriCatalogUI.IGxApplication
Dim pGxObject As esriCatalog.IGxObject
Dim pGxDatabase As esriCatalog.IGxDatabase
Dim pWorkspace As esriGeoDatabase.IWorkspace
Dim pDatabaseConnectionInfo As esriGeoDatabase.IDatabaseConnectionInfo
Dim pWorkspaceDomains2 As esriGeoDatabase.IWorkspaceDomains2
Dim pDomain As esriGeoDatabase.IDomain
Dim pRangeDomain As esriGeoDatabase.IRangeDomain
Dim pCodedValueDomain As esriGeoDatabase.ICodedValueDomain
'
Dim pXMLDOMNodeDomainSource As MSXML2.IXMLDOMNode
Dim pXMLDOMNodeMemberSource As MSXML2.IXMLDOMNode
Dim pXMLDOMNodeListMemberSource As MSXML2.IXMLDOMNodeList
'
Dim pXMLDOMNodeDomainTarget As MSXML2.IXMLDOMNode
Dim pXMLDOMNodeGeodatabaseDesignerTarget As MSXML2.IXMLDOMNode
'
Dim pIndexDomain As Long
Dim pIndexMember As Long
Dim pDomainName As String
'-------------------------
' Get Workspace Interface
'-------------------------
Set pGxApplication = mApplication
Set pGxObject = pGxApplication.SelectedObject
'
If TypeOf pGxObject Is esriCatalog.IGxDatabase Then
Set pGxDatabase = pGxObject
Set pWorkspace = pGxDatabase.Workspace
If pWorkspace.Type = esriFileSystemWorkspace Then
MsgBox "Please select a Geodatabase", vbExclamation, App.FileDescription
Exit Sub
End If
Else
MsgBox "Please select a Geodatabase", vbExclamation, App.FileDescription
Exit Sub
End If
'-------------------
' Change Mouse Icon
'-------------------
Me.MousePointer = vbHourglass
'-------------------------
' QI to IWorkspaceDomains
'-------------------------
Set pWorkspaceDomains2 = pWorkspace
If pWorkspace.Type = esriGeoDatabase.esriWorkspaceType.esriRemoteDatabaseWorkspace Then
Set pDatabaseConnectionInfo = pWorkspace
End If
'------------------------------
' Get Target Domain Collection
'------------------------------
Set pXMLDOMNodeGeodatabaseDesignerTarget = mXMLDocumentTarget.getElementsByTagName("geodatabaseDesigner").nextNode
'
For pIndexDomain = 1 To Me.ListView1.ListItems.Count Step 1
'-----------------------------
' Test if ListItem is CHECKED
'-----------------------------
If Me.ListView1.ListItems.Item(pIndexDomain).Checked Then
'-----------------
' Get Domain Name
'-----------------
pDomainName = CStr(Me.ListView1.ListItems.Item(pIndexDomain).Text)
'-------------------
' Update Status Bar
'-------------------
Call UpdateStatusBar("Importing Domain: " & pDomainName)
Set pXMLDOMNodeDomainSource = mXMLDocumentSource.selectNodes("geodatabaseDesigner/domain[@name='" & pDomainName & "']").nextNode
Set pXMLDOMNodeListMemberSource = pXMLDOMNodeDomainSource.selectNodes("member")
Select Case Me.ListView1.ListItems.Item(pIndexDomain).SmallIcon
Case 1
'---------------------
' Create a NEW domain
'---------------------
Select Case CLng(pXMLDOMNodeDomainSource.Attributes.getNamedItem("esriDomainType").Text)
Case esriGeoDatabase.esriDomainType.esriDTCodedValue
Set pDomain = New esriGeoDatabase.CodedValueDomain
Case esriGeoDatabase.esriDomainType.esriDTRange
Set pDomain = New esriGeoDatabase.RangeDomain
End Select
'------------------------
' Set Name of NEW domain
'------------------------
pDomain.Name = CStr(pXMLDOMNodeDomainSource.Attributes.getNamedItem("name").Text)
Case 2, 3
'---------------------
' Get Existing Domain
'---------------------
Set pDomain = pWorkspaceDomains2.DomainByName(pDomainName)
'-----------------------------
' Remove all existing members
'-----------------------------
If pDomain.Type = esriDTCodedValue Then
Set pCodedValueDomain = pDomain
For pIndexMember = pCodedValueDomain.CodeCount - 1 To 0 Step -1
Call pCodedValueDomain.DeleteCode(pCodedValueDomain.Value(pIndexMember))
Next pIndexMember
End If
End Select
'----------------
' Set Properties
'----------------
pDomain.Description = CStr(pXMLDOMNodeDomainSource.Attributes.getNamedItem("description").Text)
pDomain.FieldType = CLng(pXMLDOMNodeDomainSource.Attributes.getNamedItem("esriFieldType").Text)
pDomain.MergePolicy = CLng(pXMLDOMNodeDomainSource.Attributes.getNamedItem("esriMergePolicyType").Text)
pDomain.SplitPolicy = CLng(pXMLDOMNodeDomainSource.Attributes.getNamedItem("esriSplitPolicyType").Text)
'-------------
' Set Members
'-------------
Select Case pDomain.Type
Case esriGeoDatabase.esriDomainType.esriDTCodedValue
Set pCodedValueDomain = pDomain
For pIndexMember = 0 To pXMLDOMNodeListMemberSource.length - 1 Step 1
Set pXMLDOMNodeMemberSource = pXMLDOMNodeListMemberSource.Item(pIndexMember)
Call pCodedValueDomain.AddCode(CVar(pXMLDOMNodeMemberSource.Attributes.getNamedItem("value").Text), _
CStr(pXMLDOMNodeMemberSource.Attributes.getNamedItem("name").Text))
Next pIndexMember
Case esriGeoDatabase.esriDomainType.esriDTRange
Set pRangeDomain = pDomain
Set pXMLDOMNodeMemberSource = pXMLDOMNodeListMemberSource.nextNode
pRangeDomain.MinValue = CVar(pXMLDOMNodeMemberSource.Attributes.getNamedItem("minValue").Text)
pRangeDomain.MaxValue = CVar(pXMLDOMNodeMemberSource.Attributes.getNamedItem("maxValue").Text)
End Select
'----------------------------------------
' Either ADD or ALTER an existing domain
'----------------------------------------
Select Case Me.ListView1.ListItems.Item(pIndexDomain).SmallIcon
Case 1
'------------
' Add Domain
'------------
Call pWorkspaceDomains2.AddDomain(pDomain)
If pWorkspace.Type = esriRemoteDatabaseWorkspace Then
If CStr(pXMLDOMNodeDomainSource.Attributes.getNamedItem("owner").Text) <> "" Then
pDomain.Owner = CStr(pXMLDOMNodeDomainSource.Attributes.getNamedItem("owner").Text)
End If
End If
'-------------------------------------------------------------------
' Update ListView1: Uncheck ListItem and Change Icon to "Identical"
'-------------------------------------------------------------------
Me.ListView1.ListItems.Item(pIndexDomain).Checked = False
Me.ListView1.ListItems.Item(pIndexDomain).SmallIcon = 4
Me.ListView1.ListItems.Item(pIndexDomain).Ghosted = True
'-------------------------------------------------
' Add New Domain Node to Target Domain Collection
'-------------------------------------------------
Call pXMLDOMNodeGeodatabaseDesignerTarget.appendChild(pXMLDOMNodeDomainSource.cloneNode(True))
Case 2, 3
'------------------------
' Get Target Domain Node
'------------------------
Set pXMLDOMNodeDomainTarget = pXMLDOMNodeGeodatabaseDesignerTarget.selectNodes("domain[@name='" & pDomainName & "']").nextNode
'--------------
' Alter Domain
'--------------
If pWorkspace.Type = esriRemoteDatabaseWorkspace Then
pDomain.Owner = pDatabaseConnectionInfo.ConnectedUser
End If
Call pWorkspaceDomains2.AlterDomain(pDomain)
'--------------------------------
' Change the Owner of the Domain
'--------------------------------
If pWorkspace.Type = esriRemoteDatabaseWorkspace Then
If CStr(pXMLDOMNodeDomainSource.Attributes.getNamedItem("owner").Text) = "" Then
pDomain.Owner = CStr(pXMLDOMNodeDomainTarget.Attributes.getNamedItem("owner").Text)
Else
pDomain.Owner = CStr(pXMLDOMNodeDomainSource.Attributes.getNamedItem("owner").Text)
End If
End If
'-------------------------------------------------------------------
' Update ListView1: Uncheck ListItem and Change Icon to "Identical"
'-------------------------------------------------------------------
Me.ListView1.ListItems.Item(pIndexDomain).Checked = False
Me.ListView1.ListItems.Item(pIndexDomain).SmallIcon = 4
Me.ListView1.ListItems.Item(pIndexDomain).Ghosted = True
'------------------------------------------
' Replace Target Domain with Source Domain
'------------------------------------------
Set pXMLDOMNodeDomainTarget = pXMLDOMNodeGeodatabaseDesignerTarget.replaceChild(pXMLDOMNodeDomainSource.cloneNode(True), pXMLDOMNodeDomainTarget)
Case Else
'------------------
' Skip Other Types
'------------------
End Select
End If
Next pIndexDomain
'---------------------
' Restore MouseCursor
'---------------------
Me.MousePointer = vbDefault
'----------------------
' Clear Menu StatusBar
'----------------------
Call UpdateStatusBar("")
'-------------------------
' Disable the Load Button
'-------------------------
Me.cmdLoad.Enabled = False
'
Exit Sub
ErrorHandler:
Call HandleError(True, "cmdLoad_Click " & MODULE_NAME & " (" & CStr(Erl) & ")", Err.Number, Err.Source, Err.Description)
End Sub