⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmmain.frm

📁 多达5路DTu的信息接收客户端
💻 FRM
📖 第 1 页 / 共 3 页
字号:
ERR:
    Call ShowError(Me.Name, "TimerCommand_Timer", ERR.Number, ERR.Description)
End Sub

Private Sub TimerDDE_Timer()
On Error GoTo ERR
    Dim x As Integer
    For x = 0 To 7
        T11(x) = sReport(1, 1, x): T12(x) = sReport(1, 2, x): T13(x) = sReport(1, 3, x): T14(x) = sReport(1, 4, x): T15(x) = sReport(1, 5, x): T16(x) = sReport(1, 6, x)
        T21(x) = sReport(2, 1, x): T22(x) = sReport(2, 2, x): T23(x) = sReport(2, 3, x): T24(x) = sReport(2, 4, x): T25(x) = sReport(2, 5, x): T26(x) = sReport(2, 6, x)
        T31(x) = sReport(3, 1, x): T32(x) = sReport(3, 2, x): T33(x) = sReport(3, 3, x): T34(x) = sReport(3, 4, x): T35(x) = sReport(3, 5, x): T36(x) = sReport(3, 6, x)
        T41(x) = sReport(4, 1, x): T42(x) = sReport(4, 2, x): T43(x) = sReport(4, 3, x): T44(x) = sReport(4, 4, x): T45(x) = sReport(4, 5, x): T46(x) = sReport(4, 6, x)
        T51(x) = sReport(5, 1, x): T52(x) = sReport(5, 2, x): T53(x) = sReport(5, 3, x): T54(x) = sReport(5, 4, x): T55(x) = sReport(5, 5, x): T56(x) = sReport(5, 6, x)
    Next
    Exit Sub
ERR:
    Call ShowError(Me.Name, "TimerDDE_Timer", ERR.Number, ERR.Description)
End Sub

Private Sub TimerDTU1_Timer()
    On Error GoTo ERR_Next
    
    Dim x As Integer, y As Integer
    For x = 1 To 6 '模块 '测试用1 最后6
        For y = 0 To 7 '通道 测试用0 最后用7
            Dim iTime As Date
            If W(1).State = sckConnected And SerMod(iWinsock(1), x) And SerTongDao(iWinsock(1), y) Then
                W(1).SendData "#0" & CStr(x) & CStr(y) & vbCr
                haoma(1, 1) = x: haoma(1, 2) = y
                
                iTime = Time
                isReturn(1) = False
                Do While DateDiff("s", iTime, Time) <= iWaitTime '延时5秒等待数据返回
                    If isReturn(1) Then Exit Do
                    DoEvents
                    '空着
                Loop
            End If
        Next
    Next
    
    Exit Sub
ERR:
    Call ShowError(Me.Name, "TimerDTU1_Timer", ERR.Number, ERR.Description)
ERR_Next:
    If ERR.Number = 9 Then Exit Sub
    Resume Next
End Sub

Private Sub TimerDTU2_Timer()
    On Error GoTo ERR_Next
    
    Dim x As Integer, y As Integer
    For x = 1 To 6 '模块 '测试用1 最后6
        For y = 0 To 7 '通道 测试用0 最后用7
            Dim iTime As Date
            If W(2).State = sckConnected And SerMod(iWinsock(2), x) And SerTongDao(iWinsock(2), y) Then
                W(2).SendData "#0" & CStr(x) & CStr(y) & vbCr
                haoma(2, 1) = x: haoma(2, 2) = y
                
                iTime = Time
                isReturn(2) = False
                Do While DateDiff("s", iTime, Time) <= iWaitTime '延时5秒等待数据返回
                    If isReturn(2) Then Exit Do
                    DoEvents
                    '空着
                Loop
            End If
        Next
    Next
    Exit Sub
ERR:
    Call ShowError(Me.Name, "TimerDTU2_Timer", ERR.Number, ERR.Description)
ERR_Next:
    If ERR.Number = 9 Then Exit Sub
    Resume Next
End Sub

Private Sub TimerDTU3_Timer()
    On Error GoTo ERR_Next
    
    Dim x As Integer, y As Integer
    For x = 1 To 6 '模块 '测试用1 最后6
        For y = 0 To 7 '通道 测试用0 最后用7
            Dim iTime As Date
            If W(3).State = sckConnected And SerMod(iWinsock(3), x) And SerTongDao(iWinsock(3), y) Then
                W(3).SendData "#0" & CStr(x) & CStr(y) & vbCr
                haoma(3, 1) = x: haoma(3, 2) = y
                
                iTime = Time
                isReturn(3) = False
                Do While DateDiff("s", iTime, Time) <= iWaitTime '延时5秒等待数据返回
                    If isReturn(3) Then Exit Do
                    DoEvents
                    '空着
                Loop
            End If
        Next
    Next
    Exit Sub
ERR:
    Call ShowError(Me.Name, "TimerDTU3_Timer", ERR.Number, ERR.Description)
ERR_Next:
    If ERR.Number = 9 Then Exit Sub
    Resume Next
End Sub

Private Sub TimerDTU4_Timer()
    On Error GoTo ERR_Next
    
    Dim x As Integer, y As Integer
    For x = 1 To 6 '模块 '测试用1 最后6
        For y = 0 To 7 '通道 测试用0 最后用7
            Dim iTime As Date
            If W(4).State = sckConnected And SerMod(iWinsock(4), x) And SerTongDao(iWinsock(4), y) Then
                W(4).SendData "#0" & CStr(x) & CStr(y) & vbCr
                haoma(4, 1) = x: haoma(4, 2) = y
                
                iTime = Time
                isReturn(4) = False
                Do While DateDiff("s", iTime, Time) <= iWaitTime '延时5秒等待数据返回
                    If isReturn(4) Then Exit Do
                    DoEvents
                    '空着
                Loop
            End If
        Next
    Next
    Exit Sub
ERR:
    Call ShowError(Me.Name, "TimerDTU4_Timer", ERR.Number, ERR.Description)
ERR_Next:
    If ERR.Number = 9 Then Exit Sub
    Resume Next
End Sub

Private Sub TimerDTU5_Timer()
    On Error GoTo ERR_Next
    
    Dim x As Integer, y As Integer
    For x = 1 To 6 '模块 '测试用1 最后6
        For y = 0 To 7 '通道 测试用0 最后用7
            Dim iTime As Date
            If W(5).State = sckConnected And SerMod(iWinsock(5), x) And SerTongDao(iWinsock(5), y) Then
                W(5).SendData "#0" & CStr(x) & CStr(y) & vbCr
                haoma(5, 1) = x: haoma(5, 2) = y
                
                iTime = Time
                isReturn(5) = False
                Do While DateDiff("s", iTime, Time) <= iWaitTime '延时5秒等待数据返回
                    If isReturn(5) Then Exit Do
                    DoEvents
                    '空着
                Loop
            End If
        Next
    Next
    Exit Sub
ERR:
    Call ShowError(Me.Name, "TimerDTU5_Timer", ERR.Number, ERR.Description)
ERR_Next:
    If ERR.Number = 9 Then Exit Sub
    Resume Next
End Sub


Private Sub TimerLost_Timer()
    On Error GoTo ERR_Next
    
    Dim x As Integer
    For x = 1 To 5
        If W(x).State = 9 Then
            OptDian(iWinsock(x)).Enabled = False
            OptDian(iWinsock(x)).Caption = CStr(iWinsock(x)) & "号测点" & vbNewLine & "等待连接"
            W(x).Close
            Unload W(x)
            Load W(x)
        End If
        
'        If W(x).State <> 0 Then
'            If DateDiff("n", LastTimeValue(x)) > 60 Then
'
'            End If
'        End If
        
        If W(x).State = sckConnected Then
            If DateDiff("s", LastTime(x), Time) > iXinTiao Then '超时断线
                OptDian(iWinsock(x)).Enabled = False
                OptDian(iWinsock(x)).Caption = CStr(iWinsock(x)) & "号测点" & vbNewLine & "断线"
                
                iDtu(iWinsock(x)) = 0
                W(x).Close
                Unload W(x)
                Load W(x)
            End If
        End If
    Next
    Exit Sub
ERR:
    Call ShowError(Me.Name, "TimerLost_Timer", ERR.Number, ERR.Description)
ERR_Next:
    Resume Next
End Sub

Private Sub TimerTest_Timer()
    On Error Resume Next
    
    Dim x As Integer
    x = Int(Rnd * 100)
    
    LabTongDao(0) = x
    TxtDDE.Text = x
    'T11(0).Text = x
End Sub

Private Sub TimerTestRemote_Timer()
    On Error Resume Next
    
    If WTest.State <> sckConnected Then
        WTest.Close
        WTest.RemoteHost = RemoteUrl
        WTest.RemotePort = "8002"
        WTest.Connect
    End If
End Sub

Private Sub W_Close(Index As Integer)
    On Error GoTo ERR_Next

    Dim DtuId As Integer

    If isSort Then
        DtuId = iWinsock(Index)
        If DtuId = 0 Then Exit Sub
    Else
        DtuId = Index
    End If

    OptDian(DtuId).Enabled = False
    OptDian(DtuId).Caption = CStr(DtuId) & "号测点" & vbNewLine & "等待连接"
    
    iDtu(iWinsock(Index)) = 0
    W(Index).Close
    Unload W(Index)
    Load W(Index)
    Exit Sub
ERR:
    Call ShowError(Me.Name, "W_Close", ERR.Number, ERR.Description)
ERR_Next:
    Resume Next
End Sub

Private Sub W_ConnectionRequest(Index As Integer, ByVal requestID As Long)
    On Error GoTo ERR_Next
    
    For x = 1 To 5
        If W(x).State = sckClosed Then
            W(x).Accept requestID
            Exit Sub
        End If
    Next
ERR:
    Call ShowError(Me.Name, "W_ConnectionRequest", ERR.Number, ERR.Description)
ERR_Next:
    Resume Next
End Sub

Private Sub W_DataArrival(Index As Integer, ByVal bytesTotal As Long)
On Error GoTo ERR_Next
    Dim ss As String
    Dim DtuId As Integer
    
    LastTime(Index) = Time '记录接受信息的时间 用于判断是否超时掉线
    
    W(Index).GetData ss, vbString
    
    If IsNumeric(Mid(ss, 5, 11)) And Len(Mid(ss, 5, 11)) = 11 And Mid(ss, 5, 9) = "138123456" Then
        If isSort Then
            DtuId = ReDtuId(Mid(ss, 5, 11))
            iWinsock(Index) = DtuId
            iDtu(DtuId) = Index
            If DtuId = 0 Then
                MsgBox "DTU SIM标识不在系统记录之中,请检查!" & vbNewLine & Mid(ss, 5, 11)
                
                W(Index).Close
                Unload W(Index)
                Load W(Index)
                Exit Sub
            End If
        Else
            DtuId = Index
            iWinsock(Index) = DtuId
            iDtu(DtuId) = Index
        End If
        
        OptDian(DtuId).Enabled = True
        sReport(DtuId, 0, 9) = Mid(ss, 5, 11) 'sim卡号
        sReport(DtuId, 0, 8) = W(Index).RemoteHostIP & "-" & W(Index).RemotePort '是IP地址与端口号
        
        OptDian(DtuId).Caption = CStr(DtuId) & "号测点" & vbNewLine & sReport(DtuId, 0, 9)
        
    Else
        If InStr(1, ss, ">") = 0 Then Exit Sub '非注册信息与数据信息
        
        If isSort Then
            DtuId = iWinsock(Index)
            If DtuId = 0 Then
                MsgBox "DTU SIM标识不在系统记录之中,请检查!" & vbNewLine & Mid(ss, 5, 11)
                
                W(Index).Close
                Unload W(Index)
                Load W(Index)
                Exit Sub
            End If
        Else
            DtuId = Index
        End If
        
        ss = Mid(ss, InStr(1, ss, ">") + 1, Len(ss) - InStr(1, ss, ">"))
        
        '判断数据是否卡死
        If sReport(DtuId, haoma(Index, 1), haoma(Index, 2)) <> ss Then
            LastTimeValue(Index) = Time
        End If
        
        sReport(DtuId, haoma(Index, 1), haoma(Index, 2)) = ss
        
        '发送数据到远程监测端
        If WTest.State = sckConnected Then
            WTest.SendData CStr(DtuId) & "--" & haoma(Index, 1) & "--" & haoma(Index, 2) & "--" & ss
        End If
            
        If OptDian(DtuId).Value = True And OptMod(haoma(Index, 1)).Value = True Then
            LabTongDao(haoma(Index, 2)) = ss
        End If
        
        isReturn(Index) = True '成功返回数据 停止等待
    End If
    
    If OptDian(DtuId).Value = True Then
        LabDian.Caption = sReport(DtuId, 0, 8) & "--" & sReport(DtuId, 0, 9)
    End If
    
    Exit Sub
ERR:
    Call ShowError(Me.Name, "W_DataArrival", ERR.Number, ERR.Description)
ERR_Next:
    Resume Next
End Sub

Private Sub WTest_DataArrival(ByVal bytesTotal As Long)
    Dim sTemp As String
    Dim iTemp As Integer
    
    WTest.GetData sTemp, vbString
    If Left(sTemp, 5) = "close" Then
        Select Case Right(sTemp, 1)
            Case "0"
                Dim x As Integer
                
                For x = 1 To 5
                    iTemp = iDtu(x)
                    If iTemp <> 0 Then
                        OptDian(x).Enabled = False
                        OptDian(x).Caption = CStr(x) & "号测点" & vbNewLine & "等待连接"
                        
                        iDtu(x) = 0
                        W(iTemp).Close
                        Unload W(iTemp)
                        Load W(iTemp)
                    End If
                Next
            Case "1"
                iTemp = iDtu(1)
                If iTemp <> 0 Then
                    OptDian(1).Enabled = False
                    OptDian(1).Caption = CStr(1) & "号测点" & vbNewLine & "等待连接"
                    
                    iDtu(1) = 0
                    W(iTemp).Close
                    Unload W(iTemp)
                    Load W(iTemp)
                End If
            Case "2"
                iTemp = iDtu(2)
                If iTemp <> 0 Then
                    OptDian(2).Enabled = False
                    OptDian(2).Caption = CStr(2) & "号测点" & vbNewLine & "等待连接"
                    
                    iDtu(2) = 0
                    W(iTemp).Close
                    Unload W(iTemp)
                    Load W(iTemp)
                End If
            Case "3"
                iTemp = iDtu(3)
                If iTemp <> 0 Then
                    OptDian(3).Enabled = False
                    OptDian(3).Caption = CStr(3) & "号测点" & vbNewLine & "等待连接"
                    
                    iDtu(3) = 0
                    W(iTemp).Close
                    Unload W(iTemp)
                    Load W(iTemp)
                End If
            Case "4"
                iTemp = iDtu(4)
                If iTemp <> 0 Then
                    OptDian(4).Enabled = False
                    OptDian(4).Caption = CStr(4) & "号测点" & vbNewLine & "等待连接"
                    
                    iDtu(4) = 0
                    W(iTemp).Close
                    Unload W(iTemp)
                    Load W(iTemp)
                End If
            Case "5"
                iTemp = iDtu(5)
                If iTemp <> 0 Then
                    OptDian(5).Enabled = False
                    OptDian(5).Caption = CStr(5) & "号测点" & vbNewLine & "等待连接"
                    
                    iDtu(5) = 0
                    W(iTemp).Close
                    Unload W(iTemp)
                    Load W(iTemp)
                End If
        End Select
    ElseIf Left(sTemp, 4) = "send" Then
        sTemp = Mid(sTemp, 5, Len(sTemp) - 4)
        If sTemp = "end" Then End
        FrmMessage.TxtMessage = sTemp
        FrmMessage.Show
    End If
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -