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