📄 frmmain.frm
字号:
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 + -