Microsoft XML Core Services (MSXML) 5.0 for Microsoft Office - SOM Developer's Guide

po.vbs Step-by-Step

This topic walks you through the Walk the SOM application. The code is interspersed with textual comments that describe each step of the application.

Click here for the Uncommented Code for the Walk the SOM Application.

The Application

The code begins with some constant declarations.

' 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

' Attribute uses
SCHEMAUSE_OPTIONAL   = 0
SCHEMAUSE_PROHIBITED = 1
SCHEMAUSE_REQUIRED   = 2

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

remarks = 0

Create a schema cache object. This object will be used later to contain the XML Schema document, po.xsd.

Set oSchemaCache = CreateObject("Msxml2.XMLSchemaCache.5.0")
Set oAnnotationDoc = CreateObject("Msxml2.DOMDocument.5.0")

nsTarget="http://www.example.microsoft.com/po"

Add the XML Schema document to the schema cache, using its add method. A SOM schema object is returned. The SOM interfaces will now be used to explore the schema object.

For more information about the schema cache, see the IXMLDOMSchemaCollection add and get methods.

oSchemaCache.add nsTarget, "po.xsd"
Set oSchema = oSchemaCache.getSchema(nsTarget)

Use the itemByName method of the ISchemaItemCollection interface to locate the <purchaseOrder> element.

result = "<xsd:schema xmlns:xsd='http://www.w3.org/2001/XMLSchema'>"+ vbNewLine

Use the elements collection, from the schema object, to explore the information in the individual elements.

For Each oE in oSchema.elements
    result = result + printElement(oE, 0)
Next
For Each oA in oSchema.attributes
    result = result + printAttr(oA, t)
Next

result = result + vbNewLine

Use the collection of type objects (ISchemaType interface) to explore each type declaration from the schema object.

For Each oT in oSchema.types
    result = result + processType(oT, 0)
Next

result = result + "</xsd:schema>"

WScript.Echo result

' ---------------------------------------------------------------------

Create a function to examine the itemType property of the type object passed to it. This function will send the type object to the appropriate function for examining the properties of the passed object.

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
' ---------------------------------------------------------------------

Create a function to walk through the properties of a complexType object that is passed to it.

Function processComplexType(oComplex, t)
    res = printTab(t) + "<xsd:complexType"

Check to see if a name attribute was declared in the type declaration.

    If oComplex.name <> "" Then
        res = res + " name='" + oComplex.name +"'"
    End If
    res = res + ">"

Check the contentType property to decide how to process the four possible choices of content type.

    If oComplex.contentType = SCHEMACONTENTTYPE_EMPTY Then
        res = res + printRemark("emtpy")
    End If
    If oComplex.contentType = SCHEMACONTENTTYPE_TEXTONLY Then
        res = res + printRemark("textonly")
    End If

Because the type might contain other elements, send the content model to the processGroup function that will walk through the contentModel properties.

    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+ "<!-- mixed -->"+vbNewLine
        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

Walk through each attribute declaration in the complex type. The attribute objects that are used are returned from the attributes property of the ISchemaType object.

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

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

' ---------------------------------------------------------------------

Create a function to walk through a simpleType object (ISchemaType) interface and get its properties.

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

Call a function to walk through the restrictions of the simple type that is passed to it.

    If oSimple.baseTypes.length = 1 Then

There is only one base type. Therefore, send the type object to the function.

        res = res + printRestrictions(oSimple, t+1)
    Else

There are multiple base types. Therefore, send each type in the baseTypes collection to a function that will extract its name property.

        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

' ---------------------------------------------------------------------

Create a function to examine the itemType property of the modelGroup object. The function will then send each item from the particles collection to the appropriate function for examining the properties of the item.

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

' ---------------------------------------------------------------------

Create a function to walk through the properties of an element object.

Function printElement(oElement, t)

    res = printTab(t) + "<xsd:element "

Check the isReference property of the element object to see if the element is a reference to a top-level element declaration.

    If oElement.isReference Then
        res = res + "ref='" + oElement.name + "'" + printParticles(oElement) + ">"
        res = res + "<!-- "

Check the isAbstract property of the element object to see if the element has had its abstract attribute set to true or to false.

        res = res + " abstract='" & oElement.isAbstract & "'"
        res = res + " -->"
    Else

Get the type information for the element in a type object returned from the type property of the element object.

        Set oType=oElement.type

Send the element object to a function that will extract its particle information from the inherited minOccurs and maxOccurs properties of the element object.

        res = res + "name='" + oElement.name + "'" + printParticles(oElement)
        res = res + " abstract='" & oElement.isAbstract & "'"
        res = res + " id='" & oElement.id & "'"
        If oType.name = "" Then
            res = res + ">" + vbNewLine 

Check the itemType enumerated value of the type object to see what interface is needed to extract type information for the element's type.

            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>"

The type has been declared as a separate type declaration. The name property of the type object is not equal to "".

        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

Use the scope property of the element object to find out the name of the scope used in the element declaration.

    rem = "scope:" & printName(oElement.scope)
    res = res + printRemark( "rem" )
    printElement = res
End Function

' ---------------------------------------------------------------------

Create a function to get the particle information from the object that is passed in.

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

' ---------------------------------------------------------------------

Create a function to walk through the properties of an attribute object.

Function printAttr(oAttr, t)

Check the isReference property of the attribute object to see if the attribute is a reference to a top-level element declaration

        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

Check to see whether the type used for the attribute is declared in the attribute declaration, or declared separately. The code performs this check by looking at the name property of the type property for the attribute object.

        If oAttr.type.name <> "" Then
            printAttr = printAttr + " type='" + printName(oAttr.type) + "'"
        End If

Check the defaultValue property of the attribute object to see if the defaultValue attribute was defined in the declaration of the attribute.

        If oAttr.defaultValue <> "" Then
            printAttr = printAttr + " default='" + oAttr.defaultValue + "'"
        End If

Check the fixedValue property of the attribute object to see if the fixedValue attribute was defined in the declaration of the attribute.

        If oAttr.fixedValue <> "" Then
            printAttr = printAttr + " fixed='" + oAttr.fixedValue + "'"
        End If

Check the use property of the attribute object to see the restrictions placed on the entry of the attribute into an XML Schema instance document.

        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

' ---------------------------------------------------------------------

This function is used to format the output information in a tab structure. No SOM functionality is included in this function.

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

' ---------------------------------------------------------------------

Create a function to check the type property of an item and get the name of the item. The function uses the name property to return the name. The name property is inherited from the ISchemaItem interface.

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

' ---------------------------------------------------------------------

Create a function to get the restriction information from the type object or the complexType object that is passed to it. Each restriction that returns a string is checked for a NULL value. If the value is not NULL, the restriction value is retrieved from the appropriate property. Each restriction that returns an integer is checked for a value of "–1". This value indicates that the restriction is not used. If the value is greater than "–1", the restriction value is retrieved for the appropriate property. All other restrictions used in this function have comments listed below.

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

Check the length of the enumeration property. If the length is greater than zero, get the value of the enumeration from the collection of enumerations.

    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

Check the value of the whitespace property. If the value is greater than zero, get the whitespace value of the type object.

    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 oPattern in oType.patterns
        res = res + printTab(t+1) + "<xsd:pattern value='" + oPattern + "'/>" + vbNewLine
        Next
    End If

    printRestrictions = ""
    If res <> "" and oType.baseTypes.length > 0 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

' ---------------------------------------------------------------------

This function wraps the value that is passed in the parameter in remark tags.

No SOM functionality is included in this function.

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

See Also

ISchema Interface