modxml.bas

中专学校的学生操行分管理系统,包含了网络查询的功能

Attribute VB_Name = "modXml"
Option Explicit

'*************************************************
'创建空XML文件
'*************************************************
Private Sub CreateXMLFile(ByVal strFile As String)
    Open strFile For Output As #1
    Print #1, "<?xml version=""1.0"" encoding=""GB2312""?>"
    Print #1, "<BrookPrint>"
    Print #1, "</BrookPrint>"
    Close #1
End Sub

'*************************************************
'创建XML文件,保存查询结果的表格数据
'*************************************************
Public Function CreateTempData() As Boolean
    Dim strFile As String
    
    On Error GoTo ErrorHander
    CreateTempData = True
    strFile = strPath & "TempData.xml"
    If Dir$(strFile) <> "" Then Kill strFile
    modPubVar.rstReport.Save strFile, adPersistXML
    Set modPubVar.rstReport = Nothing
    Exit Function
ErrorHander:
    CreateTempData = False
    MsgBox "创建临时数据文件出错！", , MSGTEXT
End Function

'*************************************************
'创建XML文件,保存查询结果的表格结构
'*************************************************
Public Function CreateTempStruc() As Boolean
    Dim strFile As String
    Dim objXml As New DOMDocument26
    Dim myReportList As IXMLDOMNodeList
    Dim myReport As IXMLDOMNode
    Dim ndReport As IXMLDOMNode
    Dim ndPart As IXMLDOMNode
    Dim ndPrint As IXMLDOMNode
    Dim abShare As IXMLDOMAttribute
    Dim i, intCount As Integer
        
    On Error GoTo ErrorHander
    
    CreateTempStruc = True
    strFile = strPath & "TempStruc.xml"
    If Dir$(strFile) <> "" Then Kill strFile
    Call CreateXMLFile(strFile)
    intCount = objGrid.Count
    
    objXml.Load strFile
'   Report节点及其属性
    Set ndReport = objXml.createNode(NODE_ELEMENT, "Report", "")
    Set abShare = objXml.createAttribute("ID")
    abShare.text = strReportID
    ndReport.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("Name")
    abShare.text = strName
    ndReport.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("Style")
    abShare.text = rsFlag
    ndReport.Attributes.setNamedItem abShare
'   Head节点及其属性
    Set ndPart = objXml.createNode(NODE_ELEMENT, "Head", "")
    Set ndPrint = objXml.createNode(NODE_ELEMENT, "Print", "")
    Call InitPrint(ndPrint, objXml, strName, 0, 0, 0, 0, False)
    ndReport.appendChild ndPrint
    
'    For i = 0 To intCount - 1
'        Set myNode = objXml.createNode(NODE_ELEMENT, "width", "")
'        myNode.text = CStr(grdReport.Columns(i).width)
'        Set myName = objXml.createAttribute("reportsum")
'        myName.text = lvReport.ListItems("Col" & CStr(i)).SubItems(1)
'        myNode.Attributes.setNamedItem myName
'        Set myName = objXml.createAttribute("decimalplaces")
'        myName.text = lvReport.ListItems("Col" & CStr(i)).SubItems(2)
'        myNode.Attributes.setNamedItem myName
'        newNode.appendChild myNode
'    Next i
'
    objXml.getElementsByTagName("BrookPrint").Item(0).appendChild ndReport
            
    objXml.Save strFile
    Set objXml = Nothing
        
    Exit Function
ErrorHander:
    CreateTempStruc = False
    MsgBox "创建报表结构文件出错！", , MSGTEXT
    Set objXml = Nothing
End Function

Private Sub InitPrint(nd As IXMLDOMNode, objXml As DOMDocument26, ByVal text As String, _
ByVal x As Integer, ByVal y As Integer, ByVal h As Integer, ByVal w As Integer, ByVal fun As Boolean)
    Dim abShare As IXMLDOMAttribute

    Set abShare = objXml.createAttribute("align")
    abShare.text = PrintAlign.bpCenter
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("backColor")
    abShare.text = vbWhite
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("borderColor")
    abShare.text = vbBlack
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("Bold")
    abShare.text = True
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("curX")
    abShare.text = x
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("curY")
    abShare.text = y
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("Italic")
    abShare.text = False
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("Name")
    abShare.text = "宋体"
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("Size")
    abShare.text = 10
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("Strikethrough")
    abShare.text = False
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("Underline")
    abShare.text = False
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("foreColor")
    abShare.text = vbBlack
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("height")
    abShare.text = h
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("isFun")
    abShare.text = fun
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("style")
    abShare.text = False
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("text")
    abShare.text = text
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("width")
    abShare.text = w
    nd.Attributes.setNamedItem abShare
End Sub