form1.frm

监控程序

Dim sImage As String
Select Case nLevel
    Case 1
        Set AddMonitorNode = TVMonitor.Nodes.Add(curNode, tvwChild, sKey, sText)
    Case 2
        Set AddMonitorNode = TVMonitor.Nodes.Add(curNode, tvwChild, sKey, sText)
    Case 3
        Set AddMonitorNode = TVMonitor.Nodes.Add(curNode, tvwChild, sKey, sText)
End Select

End Function
'加载xml文件中的
Public Function AddMonitorNode2(ByRef ParentNode As Node, ByVal sKey As String, ByVal sText As String) As Node
Dim sImage As String
Select Case ParentNode.Tag
    Case "0"
        Set AddMonitorNode2 = TVMonitor.Nodes.Add(ParentNode, tvwChild, sKey, sText)
    Case "1"
        Set AddMonitorNode2 = TVMonitor.Nodes.Add(ParentNode, tvwChild, sKey, sText)
    Case "2"
        Set AddMonitorNode2 = TVMonitor.Nodes.Add(ParentNode, tvwChild, sKey, sText)
End Select
ReDim Preserve Locations(AddMonitorNode2.Index)
AddMonitorNode2.Key = sPrefix & AddMonitorNode2.Index
End Function

Private Sub DeleteNode(ByVal sNode As Node)
If MsgBox("您确认删除" & sNode.FullPath & "吗？", vbQuestion + vbOKCancel) = vbCancel Then Exit Sub
'del from xml
Dim nIndex As Integer
Dim tmpEle As IXMLDOMElement
Dim tmpParentEle As IXMLDOMElement
Set tmpEle = findEle(rootEle, "key", sNode.Key)
nIndex = Mid(sNode.Key, 4)
Set tmpParentEle = tmpEle.ParentNode
'XML中删除
tmpParentEle.removeChild tmpEle
SaveProject
'设备值清0
'ClearLocationData Locations(nIndex)

'treeview中删除
TVMonitor.Nodes.Remove sNode.Index
End Sub

Private Sub Connect(ByVal IP As String, ByVal Port As Integer)
    
    If Winsock1.State = 7 Then Winsock1.SendData "x" + vbCrLf
    If Winsock1.State = 1 Then Winsock1.Close
    curRemoteHostIP = IP
    curRemoteHostPort = Port
With Winsock1
'    .LocalPort = 8192
    .RemoteHost = curRemoteHostIP
    .RemotePort = curRemoteHostPort
'    .Bind
'    If .Protocol = sckTCPProtocol Then
'        .Protocol = sckUDPProtocol
'    End If
End With
End Sub

Private Sub GetDeviceData()
    StartStr = &H7E
    ProtocolStr = &H1
    LeadprotocolStr = &H1
    AddDeviceStr = &H21020002
    AddSiteNoStr = &HFF
    PassStr = &H101
    NPPassStr = &H80
    UseProtocolStr = &H1
    CommandStr = &H2
    AnswerStr = &HFF
    OCStr = ""
    SendAllData
End Sub
Private Sub SendAllData()
Dim AllStr As String '发送字符
Dim MidStr As String
Dim tmpOCStrdata As String '填补oc字符
Dim ocstrbdata As String 'oc位原有字符
Dim DeviceL As Long, DeviceH As Long
Dim DeviceLL As String, DeviceLH As String, DeviceHL As String, DeviceHH As String, PassL As String, PassH As String '站点编号，发送包标识
Dim CrcByte() As Byte
Dim CRCStr As Long
Dim n As Integer
Dim SendAllstr() As Byte

On Error Resume Next
    MidStr = ""
    AllStr = ""
    tmpOCStrdata = ""
    ocstrbdata = ""

    DeviceHH = &H21
    DeviceHL = &H2
    DeviceLH = &H0
    DeviceLL = &H2
    PassH = PassStr \ 256
    PassL = PassStr Mod 256
    For n = 1 To OLStr - Len(OCStr) - 3
          tmpOCStrdata = tmpOCStrdata & ChrW(&H0)
    Next n
    
    If Len(OCStr) > 0 Then
        For n = 1 To Len(OCStr)
              ocstrbdata = ocstrbdata & ChrW(Mid(OCStr, n, 1))
        Next n
    End If
    
    ocstrbdata = ocstrbdata & tmpOCStrdata
    MidStr = ChrW(ProtocolStr) & ChrW(LeadprotocolStr) & ChrW(DeviceLL) & ChrW(DeviceLH) & ChrW(DeviceHL) & ChrW(DeviceHH) & ChrW(AddSiteNoStr) & ChrW(PassL) & ChrW(PassH) & ChrW(NPPassStr) & ChrW(UseProtocolStr) & ChrW(CommandStr) & ChrW(AnswerStr) & ChrW(OLStr) & ChrW(OIDStr Mod 256) & ChrW(OIDStr \ 256) & ocstrbdata
 '   Debug.Print MidStr
    ReDim CrcByte(Len(MidStr))
        For n = 1 To Len(MidStr)
            CrcByte(n) = AscW(Mid(MidStr, n, 1))
        Next n

    CRCStr = GetCRCWord(CrcByte)
    Dim x As String
    MidStr = ChaStr(MidStr & ChrW(CRCStr Mod 256) & ChrW(CRCStr \ 256))
'    MidStr = MidStr & ChrW(CRCStr Mod 256) & ChrW(CRCStr \ 256)
    x = Hex(CRCStr \ 256)
    Debug.Print x
    AllStr = ChrW(StartStr) & MidStr & ChrW(StartStr)
    ReDim SendAllstr(Len(AllStr) - 1)
    Dim s As String
    For n = 0 To Len(AllStr) - 1
        SendAllstr(n) = AscW(Mid(AllStr, n + 1, 1))
        s = s & Hex(SendAllstr(n)) & " "
    Next n
    Debug.Print s
    Text3.Text = Text3.Text & s & vbCrLf
    Winsock1.SendData SendAllstr
    
End Sub
Public Function GetCRCWord(str() As Byte) As String   '求Str的CRC值,双字节字符串输出 crc_ccitt
Const DATA8000 = 32768 '0X8000
Const CRCDATA = 4129 'OX1021
Dim i, J, TmpByte, L As Byte
Dim tmpLen As Integer
Dim TmpCRC As Long
'tmpLen = Len(Str)
 For i = 1 To UBound(str)
   TmpByte = str(i)
  ' Debug.Print TmpByte
   L = 128
   For J = 0 To 7
       If TmpCRC >= DATA8000 Then
         TmpCRC = TmpCRC * 2
         TmpCRC = TmpCRC Xor CRCDATA
       Else
         TmpCRC = TmpCRC * 2
       End If
       TmpCRC = TmpCRC Mod 65536
       '
       If (TmpByte And L) <> 0 Then
         TmpCRC = TmpCRC Xor CRCDATA
         TmpCRC = TmpCRC Mod 65536
       End If
       L = L \ 2
   Next J
 Next i
GetCRCWord = TmpCRC
'Debug.Print Hex(TmpCRC \ 256) & " " & Hex(TmpCRC Mod 256)
End Function


Private Sub TVMonitor_NodeCheck(ByVal Node As MSComctlLib.Node)
    If Node.Checked = True Then
        Node.Checked = False
    ElseIf Node.Checked = False Then
        Node.Checked = True
    End If
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim resdata As String
Dim strdata As String
Dim i As Integer
Dim n As Long
Dim ResDatastr() As Byte
Dim var As Variant


If AllTextFlag = True And AutoAlmIP <> Winsock1.RemoteHostIP Then
    AutoAlmIP = Winsock1.RemoteHostIP
    var = Split(AutoAlmIP, ".")
    MSFlexGrid1.AddItem "老化房" & vbTab & var(UBound(var))
Else
    AutoAlmIP = Winsock1.RemoteHostIP
End If
resdata = ""
strdata = ""
    Winsock1.GetData ResDatastr, vbArray + vbByte, bytesTotal 'winsock接受16进制数据
    For i = 0 To UBound(ResDatastr)
        strdata = strdata & ChrW(ResDatastr(i))
    Next i
    For i = 0 To UBound(ResDatastr)
        resdata = resdata & Hex((ResDatastr(i))) & " "
    Next i
    Text3.Text = Text3.Text & vbCrLf & resdata
    GetArrivalData (strdata)
End Sub

Private Function ArriChaStr(ByVal str As String) As String    '发送后转换字符
Dim i As Integer
Dim tmpChaStr As Long
    For i = 1 To Len(str)
        tmpChaStr = 0
        tmpChaStr = AscW(Mid(str, i, 1))
        If tmpChaStr = 94 Then
            If AscW(Mid(str, i + 1, 1)) = 93 Then
                tmpChaStr = 94
                i = i + 1
            ElseIf AscW(Mid(str, i + 1, 1)) = 125 Then
                tmpChaStr = 126
                i = i + 1
            End If
        End If
        ArriChaStr = ArriChaStr & ChrW(tmpChaStr)
    Next i
End Function
Private Function ChaStr(ByVal str As String) As String    '接收前转换字符
Dim i As Integer
Dim tmpChaStr As String
    For i = 1 To Len(str)
        tmpChaStr = ""
        tmpChaStr = Mid(str, i, 1)
        If AscW(tmpChaStr) = 94 Then
            tmpChaStr = ChrW(&H5E) & ChrW(&H5D)
        ElseIf AscW(tmpChaStr) = 126 Then
            tmpChaStr = ChrW(&H5E) & ChrW(&H7D)
        End If
        ChaStr = ChaStr & tmpChaStr
    Next i
End Function
Private Sub GetArrivalData(ByVal str As String)    '处理接受到的字符
Dim lendata As Integer
Dim MidStr As String
Dim RealCRC As String
Dim RealCRC1 As Long
Dim RealCRC2 As Long
Dim TmpCRC As Long
Dim CrcByte() As Byte
Dim getdatastr As String
On Error GoTo Err:
lendata = Len(str)
tmpnstepData = ""
getdatastr = ""
MidStr = ""
strdata = ""
    If AscW(Mid(str, 1, 1)) = 126 And AscW(Mid(str, lendata, 1)) = 126 Then
        tmpnstepData = str
        MidStr = Mid(str, 2, lendata - 2)
        MidStr = ArriChaStr(MidStr)
 '       Debug.Print MidStr
    'add
        Dim i As Integer
'        Dim strdata As String
        For i = 1 To Len(MidStr)
            strdata = strdata & " " & Hex(AscW(Mid(MidStr, i, 1)))
        Next i
'        Debug.Print strdata
        
    'add
        RealCRC2 = AscW(Right(MidStr, 1))
        RealCRC1 = AscW(Mid(MidStr, Len(MidStr) - 1, 1))
        RealCRC = Hex(RealCRC2 * 256 + RealCRC1)

        
 '       RealCRC = Hex(AscW(Right(MidStr, 1)) * 256 + AscW(Mid(MidStr, Len(MidStr) - 1, 1)))
        MidStr = Mid(MidStr, 1, Len(MidStr) - 2)
        ReDim CrcByte(Len(MidStr))
            For n = 1 To Len(MidStr)
                CrcByte(n) = AscW(Mid(MidStr, n, 1))
            '    CrcByte(n) = Mid(MidStr, n, 1)
            Next n
        CRCStr = GetCRCWord(CrcByte)
        TmpCRC = CRCStr
        If Hex(TmpCRC) <> RealCRC Then
             MsgBox "效验错误"
             AllTextFlag = False
            Exit Sub
        Else
            Select Case AscW(Mid(MidStr, 10, 1)) 'NP交互标识
                Case 1
                    MsgBox "系统忙！！"
                    tmpnstepData = ""
                    Exit Sub
                Case Else
                        Select Case AscW(Mid(MidStr, 12, 1)) '命令标识
                            Case 1 '设备主动告警上报
                                getdatastr = Mid(MidStr, 14)
                                AutoAlmflag = True
                                GetLasData getdatastr
                            Case Else
                                Select Case AscW(Mid(MidStr, 13, 1)) '应答标识
                                    Case 0 '执行成功
                                        getdatastr = Mid(MidStr, 14)
                                        GetLasData getdatastr
                                    Case 1 '有条件执行
                                    Case 2 '无效命令
                                    Case 255
                                End Select
                        End Select
           End Select
        End If
        nstep = nstep + 1
    Else

        Exit Sub
    End If
    Exit Sub
Err:
    MsgBox "读取数据错误，请从新读取！！！"
    TimerMsg.Enabled = False
    TimerAlm.Enabled = False
    AllTextFlag = False
End Sub
Private Sub GetLasData(ByVal str As String)
Dim strdata As String

Dim OCstrData As String
Dim LenStr As Integer
Dim strdata1 As String
Dim strdata2 As String
Dim strdata3 As String
Dim n As Integer
    strdata = ""
    OIDstrData = ""
    OCstrData = ""
    strdata = Mid(str, 4, AscW(Mid(str, 1, 1)))
    OIDstrData = Hex(AscW(Mid(str, 3, 1)) * 256 + AscW(Mid(str, 2, 1)))
    For n = 1 To Len(strdata)
        OCstrData = OCstrData & AscW(Mid(strdata, n, 1))
    Next n
    If OIDstrData = "5" Then
        txtDevice.Text = strdata
    ElseIf OIDstrData = "101" Then
        For n = 0 To 3
            strdata1 = Hex(AscW(Mid(strdata, 4 - n, 1)))
            If Len(strdata1) < 2 Then
                strdata1 = "0" & strdata1
            End If
            strdata2 = strdata2 & strdata1
        Next n
        txtSiteNo.Text = strdata2
    Else
        If AutoAlmflag = True Then
            FrmAutoAlm.Alert
        Else
            Display OIDstrData, strdata, nstep
        End If
    End If
End Sub

Private Sub Display(ByVal str As String, ByVal lastdata As String, ByVal nRow As Integer)
Dim n As Integer
Dim strdata As String
Dim strdata1 As String
strdata = ""
strdata1 = ""
With MSFlexGrid1
    
    Select Case str
    Case "302"
'        .Row = nRow + 1
'        .Col = 0
'        .Text = "电源故障告警"
        strdata1 = "电源故障告警"
        AlmDisplay strdata1, lastdata
    Case "328"
'        .Row = nRow + 1
'        .Col = 0
'        .Text = "门禁告警"
        strdata1 = "门禁告警"
        AlmDisplay strdata1, lastdata
    Case "330"
'        .Row = nRow + 1
'        .Col = 0
'        .Text = "下行输入过功率告警（通道1）"
        strdata1 = "下行输入过功率告警（通道1）"
        AlmDisplay strdata1, lastdata
    Case "332"
'        .Row = nRow + 1
'        .Col = 0
'        .Text = "下行输出过功率告警（通道1）"
        strdata1 = "下行输出过功率告警（通道1）"
        AlmDisplay strdata1, lastdata
    Case "334"
'        .Row = nRow + 1
'        .Col = 0
'        .Text = "上行输出过功率告警（通道1）"
        strdata1 = "上行输出过功率告警（通道1）"
        AlmDisplay strdata1, lastdata
    Case "335"
'        .Row = nRow + 1
'        .Col = 0
'        .Text = "下行驻波比告警（通道1）"
        strdata1 = "下行驻波比告警（通道1）"
        AlmDisplay strdata1, lastdata
    Case "336"
'        .Row = nRow + 1
'        .Col = 0
'        .Text = "下行输入过功率告警（通道2）"
        strdata1 = "下行输入过功率告警（通道2）"
        AlmDisplay strdata1, lastdata
    Case "338"
'        .Row = nRow + 1
'        .Col = 0
'        .Text = "下行输出过功率告警（通道2）"
        strdata1 = "下行输出过功率告警（通道2）"
        AlmDisplay strdata1, lastdata
'        .Col = 0
    Case "33A"
'        .Row = nRow + 1
'        .Col = 0
'        .Text = "上行输出过功率告警（通道2）"
        strdata1 = "上行输出过功率告警（通道2）"
        AlmDisplay strdata1, lastdata
    Case "33B"
'        .Row = nRow + 1
'        .Col = 0
'        .Text = "下行驻波比告警（通道2）"
        strdata1 = "下行驻波比告警（通道2）"
        AlmDisplay strdata1, lastdata
    Case "33C"
'        .Row = nRow + 1
'        .Col = 0
'        .Text = "下行输入过功率告警（通道3）"
        strdata1 = "下行输入过功率告警（通道3）"
        AlmDisplay strdata1, lastdata
    Case "33E"
'        .Row = nRow + 1
'        .Col = 0
'        .Text = "下行输出过功率告警（通道3）"
        strdata1 = "下行输出过功率告警（通道3）"
        AlmDisplay strdata1, lastdata
    Case "340"
'        .Row = nRow + 1
'        .Col = 0
'        .Text = "上行输出过功率告警（通道3）"
        strdata1 = "上行输出过功率告警（通道3）"
        AlmDisplay strdata1, lastdata
    Case "341"
'        .Row = nRow + 1
'        .Col = 0
'        .Text = "下行驻波比告警（通道3）"
        strdata1 = "下行驻波比告警（通道3）"
        AlmDisplay strdata1, lastdata
    Case "3A0"
'        .Row = nRow + 1
'        .Col = 0
'        .Text = "下行功放过温告警（通道1）"
        strdata1 = "下行功放过温告警（通道1）"
        AlmDisplay strdata1, lastdata
    Case "3A2"
'        .Row = nRow + 1
'        .Col = 0
'        .Text = "上行功放过温告警（通道1）"
        strdata1 = "上行功放过温告警（通道1）"