Uncommented Code for the Locate Declarations Application

Article
10/27/2016
[This sample code uses features that were only implemented in MSXML 6.0.]
' Item types:
SOMITEM_SCHEMA                    = 4*1024
SOMITEM_ATTRIBUTE                 = SOMITEM_SCHEMA + 1
SOMITEM_ATTRIBUTEGROUP            = SOMITEM_SCHEMA + 2
SOMITEM_NOTATION                  = SOMITEM_SCHEMA + 3

SOMITEM_ANYTYPE                   = 8*1024
SOMITEM_DATATYPE                  = SOMITEM_ANYTYPE+256
SOMITEM_SIMPLETYPE                = SOMITEM_DATATYPE+256
SOMITEM_COMPLEXTYPE               = 9*1024

SOMITEM_PARTICLE                  = 16*1024
SOMITEM_ANY                       = SOMITEM_PARTICLE+1
SOMITEM_ANYATTRIBUTE              = SOMITEM_PARTICLE+2
SOMITEM_ELEMENT                   = SOMITEM_PARTICLE+3
SOMITEM_GROUP                     = SOMITEM_PARTICLE+256

SOMITEM_ALL                       = SOMITEM_GROUP+1
SOMITEM_CHOICE                    = SOMITEM_GROUP+2
SOMITEM_SEQUENCE                  = SOMITEM_GROUP+3
SOMITEM_EMPTYPARTICLE             = SOMITEM_GROUP+4

SCHEMAUSE_OPTIONAL   = 0
SCHEMAUSE_PROHIBITED = 1
SCHEMAUSE_REQUIRED   = 2

SCHEMACONTENTTYPE_EMPTY        = 0
SCHEMACONTENTTYPE_TEXTONLY     = 1
SCHEMACONTENTTYPE_ELEMENTONLY  = 2
SCHEMACONTENTTYPE_MIXED        = 3

remarks = 0

Set oSchemaCache = CreateObject("Msxml2.XMLSchemaCache.6.0")
nsTarget="http://www.example.microsoft.com/po"
oSchemaCache.add nsTarget, "po2.xsd"

Set oDoc = CreateObject("Msxml2.DOMDocument.6.0")
oDoc.async = false
oDoc.validateOnParse = false
set oDoc.schemas = oSchemaCache
oDoc.load "po2.xml"
oDoc.setProperty "SelectionLanguage", "XPath"
oDoc.setProperty "SelectionNamespaces", "xmlns:po='http://www.example.microsoft.com/po'"
oDoc.setProperty "SelectionNamespaces", "xmlns:po='http://www.example.microsoft.com/po'"

result = ""
Set oNo = oDoc.selectSingleNode("//po:purchaseOrder/shipTo/@country")
result = result + printDecl(oNo) + vbNewLine

Set oNo = oDoc.selectSingleNode("//po:purchaseOrder/items/item/quantity")
result = result + printDecl(oNo) + vbNewLine

Set oNo = oDoc.selectSingleNode("//po:purchaseOrder/items/item/@partNum")
result = result + printDecl(oNo) + vbNewLine

WScript.Echo result

Function printDecl(oNode)
    Set oDecl = oDoc.namespaces.getDeclaration(oNode)
    If oDecl.itemType = SOMITEM_ELEMENT Then
        printDecl = printElement(oDecl, 1)
    End If
    If oDecl.itemType = SOMITEM_ATTRIBUTE Then
       printDecl = printAttr(oDecl, 1)
       printDecl = printDecl + processType(oDecl.Type, 1)
    End If
End Function

Function processType(oType, t)
    If oType.itemType = SOMITEM_ANYTYPE Then
        res = res + printTab(t+1) + "<!-- " + oType.name +" -->" 
    End If
    If oType.itemType = SOMITEM_COMPLEXTYPE Then
        res = res + processComplexType(oType, t+1)
    End If
    If oType.itemType = SOMITEM_SIMPLETYPE Then
        res = res + processSimpleType(oType, t+1)
    End If
    processType = res + vbNewLine
End Function

Function processComplexType(oComplex, t)
    res = printTab(t) + "<xsd:complexType"
    If oComplex.name <> "" Then
        res = res + " name='" + oComplex.name +"'"
    End If
    res = res + ">"

    If oComplex.contentType = SCHEMACONTENTTYPE_EMPTY Then
        res = res + printRemark("emtpy")
    End If
    If oComplex.contentType = SCHEMACONTENTTYPE_TEXTONLY Then
        res = res + printRemark("textonly")
    End If
    If oComplex.contentType =SCHEMACONTENTTYPE_ELEMENTONLY Then
        res = res + printRemark("elementonly")
        res = res + processGroup(oComplex.contentModel, t+1)
    End If
    If oComplex.contentType = SCHEMACONTENTTYPE_MIXED Then
        res = res + printRemark("mixed")
        res = res + processGroup(oComplex.contentModel, t+1)
    End If
    res = res + vbNewline
    res = res + printRestrictions(oComplex, t+1)

    On Error Resume Next
    Set any = oComplex.anyAttribute.name
    If Err.number = 0 Then
        res = res + oComplex.anyAttribute.name
    End If

    For Each oAttr in oComplex.attributes
        res = res + printAttr(oAttr, t+1)
    Next

    processComplexType = res + printTab(t) + "</xsd:complexType>"+vbNewline
End Function

Function processSimpleType(oSimple, t)
    res = printTab(t) + "<xsd:simpleType"
    If oSimple.name <> "" Then
        res = res + " name='" + oSimple.name +"'"
    End If
    res = res + ">"+vbNewline

    If oSimple.baseTypes.length = 1 Then
        res = res + printRestrictions(oSimple, t+1)
    Else
        For Each oType in oSimple.baseTypes
            res = res + "<baseType name='" + printName(oType) +"'>"+vbNewline
        Next
    End If

    processSimpleType = res + printTab(t) + "</xsd:simpleType>"+vbNewline
End Function

Function processGroup(poGroup, t)
    res = ""

    If poGroup.itemType = SOMITEM_ALL Then
        res = res + printTab(t+1) + "<xsd:all>"+vbNewline
        res = res + processChoiceOrSequence(poGroup, t+1)
        res = res + printTab(t+1) + "</xsd:all>"
    End If

    If poGroup.itemType = SOMITEM_CHOICE Then
        res = res + printTab(t+1) + "<xsd:choice>"+vbNewline
        res = res + processChoiceOrSequence(poGroup, t+1)
        res = res + printTab(t+1) + "</xsd:choice>"
    End If

    If poGroup.itemType = SOMITEM_SEQUENCE Then
        res = res + printTab(t+1) + "<xsd:sequence>"+vbNewline
        res = res + processChoiceOrSequence(poGroup, t+1)
        res = res + printTab(t+1) + "</xsd:sequence>"
    End If
    processGroup = res
End Function

Function processChoiceOrSequence(poGroup, t)
    res = ""
    For Each item in poGroup.particles
        If item.itemType = SOMITEM_ELEMENT Then
            res = res + printElement(item, t+1)
        End If
        If (item.itemType and SOMITEM_GROUP) = SOMITEM_GROUP Then
            res = res + processGroup(item, t+1)+vbNewline
        End If
        If item.itemType = SOMITEM_ANY Then
            res = res + "any: " + item.name+vbNewline
        End If
    Next
    processChoiceOrSequence = res
End Function

Function printElement(oElement, t)
    res = printTab(t) + "<xsd:element "
    If oElement.isReference Then
        res = res + "ref='" + oElement.name + "'" + printParticles(oElement) + ">"
        res = res + "<!-- "
        res = res + " abstract='" & oElement.isAbstract & "'"
        res = res + " -->"
    Else
        Set oType=oElement.type
        res = res + "name='" + oElement.name + "'" + printParticles(oElement)
        res = res + " abstract='" & oElement.isAbstract & "'"
        res = res + " id='" & oElement.id & "'"
        If oType.name = "" Then
            res = res + ">" + vbNewLine 
            If oType.itemType = SOMITEM_COMPLEXTYPE Then
                res = res + printElement + processComplexType(oType, t+1)
            Else
                res = res + processSimpleType(oType, t)
            End If
            res = res + printTab(t) + "</xsd:element>"
        Else
            If printName(oType) <> "xsd:anyType" Then
                res = res + " type='" + printName(oType) + "'"
            End If

            If oType.itemType <> SOMITEM_COMPLEXTYPE Then
                If printRestrictions(oType, 0) = "" Then
                    res = res + "/>"
                Else
                    res = res + ">" + vbNewLine + processSimpleType(oType, t)
                    res = res + printTab(t) + "</xsd:element>"
                End If
            Else
                res = res + "/>"
            End If
        End If
    End If
    rem = "scope:" & printName(oElement.scope)
    res = res + printRemark( "rem" )
    printElement = res
End Function

Function printParticles(oParticle)
        If oParticle.minOccurs <> 1 Then 
            res = res + " minOccurs='" & oParticle.minOccurs & "'"
        End If
        If oParticle.maxOccurs <> 1 Then 
            If oParticle.maxOccurs = -1 Then 
                res = res + " maxOccurs='unbounded'"
            Else
                res = res + " maxOccurs='" & oParticle.maxOccurs & "'"
            End If
        End If
        printParticles = res
End Function

Function printAttr(oAttr, t)
        If oAttr.isReference Then
            printAttr = printAttr + printTab(t) + "<xsd:attribute ref='" + oAttr.name + "'"
        Else
            printAttr = printAttr + printTab(t) + "<xsd:attribute name='" + oAttr.name + "'"
        End If
        If oAttr.type.name <> "" Then
            printAttr = printAttr + " type='" + printName(oAttr.type) + "'"
        End If
        If oAttr.defaultValue <> "" Then
            printAttr = printAttr + " default='" + oAttr.defaultValue + "'"
        End If
        If oAttr.fixedValue <> "" Then
            printAttr = printAttr + " fixed='" + oAttr.fixedValue + "'"
        End If
        If oAttr.use = SCHEMAUSE_OPTIONAL   Then printAttr = printAttr + " use='optional'"   End If
        If oAttr.use = SCHEMAUSE_PROHIBITED Then printAttr = printAttr + " use='prohibited'" End If
        If oAttr.use = SCHEMAUSE_REQUIRED   Then printAttr = printAttr + " use='required'"   End If
        printAttr = printAttr + "/>"
        rem = "scope:" & printName(oElement.scope)
        printAttr = printAttr + printRemark("rem")
End Function

Function printTab(t)
    tab=""
    For x=0 to t
        tab=tab+"  "
    Next
    printTab=tab
End Function

Function printName(item)
    printName =""
    If (item.itemType and SOMITEM_DATATYPE) = SOMITEM_DATATYPE Then
        printName= "xsd:"
    End If 
    If item.itemType = SOMITEM_ANYTYPE Then
        printName= "xsd:"
    End If 
    printName= printName + item.name
End Function

Function printRestrictions(oType, t)
    res = ""
    If oType.minExclusive <> "" Then
        res = res + printTab(t+1) + "<xsd:minExclusive value='"+ oType.minExclusive + "'/>" + vbNewLine
    End If
    If oType.minInclusive <> "" Then
        res = res + printTab(t+1) + "<xsd:minInclusive value='"+ oType.minInclusive + "'/>" + vbNewLine
    End If
    If oType.maxExclusive <> "" Then
        res = res + printTab(t+1) + "<xsd:maxExclusive value='"+ oType.maxExclusive + "'/>" + vbNewLine
    End If
    If oType.maxInclusive <> "" Then
        res = res + printTab(t+1) + "<xsd:maxInclusive value='"+ oType.maxInclusive + "'/>" + vbNewLine
    End If
    If oType.totalDigits > -1 Then
        res = res + printTab(t+1) + "<xsd:totalDigits value='" & oType.totalDigits & "'/>" + vbNewLine
    End If
    If oType.fractionDigits > -1 Then
        res = res + printTab(t+1) + "<xsd:fractionDigits value='" & oType.fractionDigits & "'/>" + vbNewLine
    End If
    If oType.length > -1 Then
        res = res + printTab(t+1) + "<xsd:length value='" & oType.length & "'/>" + vbNewLine
    End If
    If oType.minLength > -1 Then
        res = res + printTab(t+1) + "<xsd:minLength value='" & oType.minLength & "'/>" + vbNewLine
    End If
    If oType.maxLength > -1 Then
        res = res + printTab(t+1) + "<xsd:maxLength value='" & oType.maxLength & "'/>" + vbNewLine
    End If
    If oType.enumeration.length > 0 Then
        For each item in oType.enumeration
            res = res + printTab(t+1) + "<xsd:enumeration value='" + item + "'/>" + vbNewLine
        Next
    End If
    If oType.whitespace > 0 Then
        res = res + printTab(t+1) + "<xsd:whitespace value='" & oType.whitespace & "'/>" + vbNewLine
    End If
    If oType.patterns.length > 0 Then
        For Each pattern in oType.patterns
           res = res + printTab(t+1) + "<xsd:pattern value='" + pattern + "'/>" + vbNewLine
        Next
    End If

    printRestrictions = ""
    If res <> "" Then
        printRestrictions = printRestrictions + printTab(t) + "<xsd:restriction base='" + printName(oType.baseTypes(0)) + "'>" + vbNewLine
        printRestrictions = printRestrictions + res
        printRestrictions = printRestrictions + printTab(t) + "</xsd:restriction>" + vbNewLine
    End If

End Function

Function printRemark(r)
    If remarks = 1 Then
        printRemark = "<!-- " + r + " -->"
    End If
    printRemark = printRemark + vbNewLine
End Function
Share via

Uncommented Code for the Locate Declarations Application

Additional resources
