📄 form1.frm
字号:
sumstr = Right("0000" + hex(sump), 4)
lhex = Right(sumstr, 2)
hhex = Left(sumstr, 2)
If lhex = Right("00" + hex(tempdata(i + 5 + lengthBW + 3 - 2)), 2) And hhex = Right("00" + hex(tempdata(i + 5 + lengthBW + 3 - 1)), 2) Then
For j = 1 To 6 + lengthBW + 3
data(j) = tempdata(i + j - 1)
Next j
receiveStatic = 1
Text1.Text = Text1.Text + "接收数据:OK" + Chr(13) + Chr(10)
Exit Function
End If
End If
End If
End If
End If
End If
End If
Next i
End If
receiveStatic = 0
Text1.Text = Text1.Text + "接收数据:error" + Chr(13) + Chr(10)
End Function
Function unzipdata(caseRECEIVE As Integer)
For i = 1 To 15
receiveFault(i) = 0
receivePC(i) = 0
receiveN(i) = 0
Next i
Select Case caseRECEIVE
Case 1
'受到ask
Case 2
'收到nck
Case 3
'收到故障状态数据
sumCH = data(11)
For i = 1 To sumCH
receiveFault(i) = data(11 + i)
Next i
Case 4
'收到放电量数据
sumCH = data(11)
For i = 1 To sumCH
receivePC(i) = data(11 + (i - 1) * 2 + 1) + data(11 + i * 2) * 256
Next i
Case 5
'收到脉冲数据
sumCH = data(11)
For i = 1 To sumCH
receiveN(i) = data(11 + i)
Next i
Case 6
'收到所有数据
sumCH = data(11)
'故障信息
For i = 1 To sumCH
receiveFault(i) = data(11 + i)
Next i
'收到放电量数据
For i = 1 To sumCH
receivePC(i) = data(11 + sumCH + (i - 1) * 2 + 1) + data(11 + sumCH + i * 2) * 256
Next i
'收到脉冲数据
For i = 1 To sumCH
receiveN(i) = data(11 + 3 * sumCH + i)
Next i
End Select
End Function
Sub viewData()
For i = 1 To 15
viewGrid.TextMatrix(3, i) = receiveFault(i)
viewGrid.TextMatrix(1, i) = receivePC(i)
viewGrid.TextMatrix(2, i) = receiveN(i)
Next i
End Sub
Function sumcode(p() As Byte, start As Integer, codelength As Integer) As Integer
Dim sumtemp As Single
sumtemp = 0#
For i = start + 5 To codelength - 3
sumtemp = sumtemp + p(i)
Next i
sumcode = Int(sumtemp)
End Function
Function str_hex(str1)
bith8 = Left(str1, 1)
bitl8 = Right(str1, 1)
If Not IsNumeric(bith8) Then
Data1 = Asc(UCase(bith8)) - Asc("A") + 10
Else
Data1 = Val(bith8)
End If
If Not IsNumeric(bitl8) Then
Data2 = Asc(UCase(bitl8)) - Asc("A") + 10
Else
Data2 = Val(bitl8)
End If
str_hex = Data1 * 16 + Data2
End Function
Function char_hex(char1)
If Not IsNumeric(char1) Then
Data1 = Asc(UCase(char1)) - Asc("A") + 10
Else
Data1 = Val(char1)
End If
char_hex = Data1
End Function
Function hex_char(hex)
If Not IsNumeric(hex) Then
Value = Asc(UCase(hex)) - Asc("A") + 16
Else
Value = Val(hex)
End If
hex_char = Value
End Function
Private Sub btnOK_Click()
For i = 1 To 15
viewGrid.TextMatrix(3, i) = ""
viewGrid.TextMatrix(1, i) = ""
viewGrid.TextMatrix(2, i) = ""
Next i
Text1.Text = ""
'发送请求
'***********************************************
txtcomboASK = comboASK.Text
'ReDim package(4)
Dim caseASK As Integer
Select Case txtcomboASK
Case "申请故障状况" 'C1
caseASK = 3
Case "申请放电量" 'C2
caseASK = 4
Case "申请脉冲数" 'C3
caseASK = 5
Case "申请所有测量数据" 'C4
caseASK = 6
Case "手动发送ASK" 'ASK
caseASK = 1
Case "手动发送NCK" 'NSK
caseASK = 2
End Select
'发送请求
trans_data (caseASK)
sumNCK = 0
'************************************************************
'接受客户端根据请求返回的数据
'************************************************************
'从缓冲区接受数据,并判断数据有效性
receiveStart:
receive_data
If receiveStatic = 1 Then
'处理特征码
Select Case data(7)
Case &H6 'ACK
caseRECEIVE = 1
Case &H15 'NAK
caseRECEIVE = 2
Case &H40 '故障状态上传
caseRECEIVE = 3
Case &H41 '放电量上传
caseRECEIVE = 4
Case &H42 '脉冲数上传
caseRECEIVE = 5
Case &H43 '所有测量数据上传
caseRECEIVE = 6
End Select
' 是请求接受数据
If caseASK > 2 Then
If caseRECEIVE = caseASK Then
'发送ack
trans_data (1)
'解包
unzipdata (caseRECEIVE)
'显示
viewData
Exit Sub
End If
End If
End If
'如果接受数据不是请求的数据,发nck
trans_data (2)
If sumNCK < 4 Then
sumNCK = sumNCK + 1
GoTo receiveStart
End If
End Sub
Private Sub btnRestore_Click()
Open App.Path + "\standard.cfg" For Input As #2
For i = 1 To 5
If Not EOF(2) Then
Line Input #2, buff
Combo(i - 1).Text = buff
End If
Next i
Close #2
End Sub
Private Sub btnSave_Click()
Open App.Path + "\user.cfg" For Output As #3
For i = 1 To 5
Print #3, Combo(i - 1).Text
Next i
Close #3
End Sub
Private Sub btnXH_Click()
btnOK_Click
tti = Now
tdelay = 60
While 1 > 0
Do
DoEvents
tti1 = (Now - tti) * 24# * 60# * 60#
Loop Until tti1 > tdelay
comboASK.ListIndex = Int(0 + 3 * Rnd())
btnOK_Click
tti = Now
tdelay = 10
Do
DoEvents
tti1 = (Now - tti) * 24# * 60# * 60#
Loop Until tti1 > tdelay
Wend
End Sub
Private Sub Form_Load()
MSComm1.CommPort = 1
MSComm1.Settings = "9600,n,8,1"
MSComm1.RThreshold = 1
MSComm1.InBufferSize = 20
MSComm1.OutBufferSize = 80
MSComm1.InputLen = 1
MSComm1.InputMode = comInputModeBinary
MSComm1.InBufferCount = 0
MSComm1.OutBufferCount = 0
With comboASK
.AddItem "申请故障状况"
.AddItem "申请放电量"
.AddItem "申请脉冲数"
.AddItem "申请所有测量数据"
.AddItem "手动发送ASK"
.AddItem "手动发送NCK"
End With
viewGrid.TextMatrix(1, 0) = "PC(i)"
viewGrid.TextMatrix(2, 0) = "NN(i)"
viewGrid.TextMatrix(3, 0) = "故障状态"
For i = 1 To 15
viewGrid.TextMatrix(0, i) = "通道" + Str(i)
viewGrid.ColAlignment(i) = 4
Next i
viewGrid.ColAlignment(0) = 4
viewGrid.ColWidth(0) = 1500
viewGrid.TextMatrix(0, 0) = "接收端数据"
With Combo(0)
.AddItem "com1"
.AddItem "com2"
.AddItem "com3"
.AddItem "com4"
End With
With Combo(1)
.AddItem 2400
.AddItem 4800
.AddItem 9600
.AddItem 19200
End With
With Combo(2)
.AddItem 5
.AddItem 6
.AddItem 7
.AddItem 8
End With
With Combo(3)
.AddItem 1
.AddItem 1.5
.AddItem 2
End With
With Combo(4)
.AddItem "偶"
.AddItem "奇"
.AddItem "无"
End With
'*************************************************************************
Open App.Path + "\user.cfg" For Input As #1
For i = 1 To 5
If Not EOF(1) Then
Line Input #1, buff
Combo(i - 1).Text = buff
End If
Next i
Close #1
'*************************************************************************
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = flase
End If
MSComm1.PortOpen = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = flase
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -