module1.bas

监控程序

Attribute VB_Name = "Module1"
Public XMLObj As New DOMDocument
Public xmlPath As String
Public rootEle As IXMLDOMElement    'root ele
Public rootLaoHua As IXMLDOMElement
Public Const sPrefix As String = "Key"
Public Type LaoHuaType
    IP As String            'Ip地址
    Port As Integer         '端口
End Type
Public Locations() As LaoHuaType
Public nKey As Long
Public nstep As Integer
Public tmpnstepData As String
Declare Function timeGetTime Lib "winmm.dll" () As Long
Public AutoAlmflag As Boolean
Public AutoAlmIP As String
Public OIDstrData As String
'.延时函数
Public Sub Delay(pauseTime As Single)
Dim Start
Start = timeGetTime
'设定开始时间
Do While timeGetTime < Start + pauseTime
   DoEvents
   If tmpnstepData <> "" Then Exit Sub
Loop
Start = timeGetTime
nstep = nstep + 1
End Sub
Public Sub Delay1(pauseTime As Single)
Dim Start
Start = timeGetTime
'设定开始时间
Do While timeGetTime < Start + pauseTime
   DoEvents
Loop
Start = timeGetTime
End Sub

Public Sub Main()
    If (App.PrevInstance) Then Exit Sub
    xmlPath = App.Path + "\" + App.EXEName + ".xml"
    XMLObj.async = False 'XML文件的下载是否与XML的处理异步进行
    XMLObj.Load xmlPath
    If Not XMLObj.parsed Then
    If MsgBox("配置文件被破坏，如果继续启动程序会丢失上次保存的信息。" + vbCrLf + _
        "建议程序退出？", vbOKCancel + vbQuestion, sAppName) = vbOK Then Exit Sub
    End If
    Set rootEle = XMLObj.documentElement
    Set rootLaoHua = rootEle.selectSingleNode("laohua")
    nKey = 1
    FrmMain.Show
End Sub
Public Function ReadEleValue(ByRef ParentEle As IXMLDOMElement, ByVal Tagname As String, Optional ByVal defaulValue As String)
Dim tmpEle As IXMLDOMElement
Set tmpEle = ParentEle.selectSingleNode(Tagname)
If tmpEle Is Nothing Then
    ReadEleValue = defaulValue
Else
    ReadEleValue = tmpEle.Text
End If
End Function
'查找节点元素,根据其子节点的tagname-Value对。
Public Function findEle(ByRef Parent As IXMLDOMElement, ByVal Tagname As String, ByVal sValue As String) As IXMLDOMElement
    Dim tmpEle As IXMLDOMElement
    Dim objNodeList As IXMLDOMNodeList
    Set objNodeList = Parent.selectNodes(".//" + Tagname)

    For Each tmpEle In objNodeList
        If tmpEle.Text = sValue Then
            Set findEle = tmpEle.ParentNode
            Exit Function
        End If
    Next
End Function

Public Function FindEle2(ByVal Parent As IXMLDOMNodeList, ByVal nodeName As String, ByVal nodeKeyName As String, ByVal nodeKeyValue As String) As IXMLDOMElement
    Dim oNode As IXMLDOMNode
    Dim tmp As String
    For Each oNode In Parent
        If UCase(oNode.nodeName) = UCase(nodeName) Then
            tmp = ReadEleValue(oNode, nodeKeyName)
            If tmp = nodeKeyValue Then
                Set FindEle2 = oNode
                Exit Function
            End If
                      
        End If
    Next

End Function
'add ele
Public Function addEle(ByRef ParentEle As IXMLDOMElement, ByVal Tagname As String, ByVal sValue As String) As IXMLDOMElement
Dim tmpEle As IXMLDOMElement
Set tmpEle = ParentEle.ownerDocument.createElement(Tagname)
tmpEle.Text = sValue
ParentEle.appendChild tmpEle
ParentEle.appendChild ParentEle.ownerDocument.createTextNode(vbCrLf)
Set addEle = tmpEle
End Function
'save project
Public Sub SaveProject()
    XMLObj.save xmlPath
End Sub