| Microsoft XML Core Services (MSXML) 5.0 for Microsoft Office - SOM Developer's Guide |  |
Uncommented Code for the Walk the SOM Application
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
Set oSchemaCache = CreateObject("Msxml2.XMLSchemaCache.5.0")
Set oAnnotationDoc = CreateObject("Msxml2.DOMDocument.5.0")
' Load the schema.
nsTarget="http://www.example.microsoft.com/po"
oSchemaCache.add nsTarget, "po.xsd"
Set oSchema = oSchemaCache.getSchema(nsTarget)
result = "<xsd:schema xmlns:xsd='http://www.w3.org/2001/XMLSchema'>"+ vbNewLine
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
For Each oT in oSchema.types
result = result + processType(oT, 0)
Next
result = result + "</xsd:schema>"
WScript.Echo result
' -------------------------------------------------------------------------------------------
Function processType(oType, t)
' res = printTab(t) + printRemark(oType.name)+ vbNewLine
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 = ""
' List elements in the sequence.
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 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
Function printRemark(r)
If remarks = 1 Then
printRemark = "<!-- " + r + " -->"
End If
printRemark = printRemark + vbNewLine
End Function