您所在位置：主题：请教该程序数据读取问题
343410885
[专家分：0] 发布于 2010-06-01 09:55:00
Private Function GetDecNum(ByVal hexNum As String) As Long
If Mid(Trim(hexNum), 1, 2) = "&H" & Mid(Trim(hexNum), 1, 2) = "&h" Then
GetDecNum = Val(hexNum)
Else
hexNum = "&H" & hexNum
GetDecNum = Val(hexNum)
End If
End Function
Private Sub Check1_Click()
If Check1.Value = 1 Then
Text1.Text = "127.0.0.1"
Else
Text1.Text = "192.168.0.13"
End If
End Sub
Private Sub Command1_Click()
On Error GoTo ErrProc
Dim p1 As Integer
Dim p2 As Integer
Dim p11 As String
Dim p21 As String
p1 = Text3.Text
p2 = Text5.Text
u = p1
'u = Hex(Text3.Text)
'p11 = "&H" + Hex(p1)
If p2 = 0 Then
'p21 = "&H" + Hex(0)
p21 = 0
ElseIf p2 = 1 Then
p21 = "&H" + "FF"
Else
MsgBox "写入数据必须是1或0", , "提示"
End If
Dim sendstr(14) As Byte
sendstr(0) = &H0 '交换识别号高字节，通常为0
sendstr(1) = &H0 '交换识别号低字节，通常为0
sendstr(2) = &H0 '协议识别号高字节，为 0
sendstr(3) = &H0 '协议识别号低字节，为 0
sendstr(4) = &H0 '字节长度高字节
sendstr(5) = &H6 ' 以下字节长度低字节
sendstr(6) = &H0 '单元识别号，确省为 255
sendstr(7) = &H5 '写一个线圈命令代码
sendstr(8) = Int(p1 / 256) '写线圈的起始地址高字节
sendstr(9) = p1 Mod 256 '写线圈的起始地址低字节
sendstr(10) = p21 '=FF打开线圈，=00关闭线圈
sendstr(11) = &H0
Dim aStr As String
Dim i As Integer
Dim j As Integer
For i = 0 To 11
aStr = aStr & Chr(sendstr(i))
Next
Winsock1.SendData aStr
Exit Sub
ErrProc:
MsgBox "传输数据失败", vbCritical, "网络传输"
End Sub
Private Sub Command2_Click()
'On Error GoTo ErrProc
Dim m As Integer
Dim n As Integer
Dim x As String
Dim y1 As String
Dim y2 As String
Dim y3 As String
Dim y4 As String
m = Text3.Text
n = Text5.Text
x = Hex(n)
u = m
If m >= 32768 Or m < -32768 Then
MsgBox "写入数据必须在0~32768之间", , "提示"
End If
'If 32768 > n And n >= 4096 Then
'If Mid(Hex(n), 3, 1) = "0" Then
'y1 = "&H" + Mid(Hex(n), 1, 2)
'y2 = "&H" + Mid(Hex(n), 4, 1)
'End If
'End If
'If 32768 > n And n >= 4096 Then
'If Mid(Hex(n), 3, 1) <> "0" Then
'y1 = "&H" + Mid(Hex(n), 1, 2)
'y2 = "&H" + Mid(Hex(n), 3, 2)
'End If
'End If
'If 4096 > n And n >= 256 Then
'If Mid(Hex(n), 2, 1) <> "0" Then
'y1 = "&H" + Mid(Hex(n), 1, 1)
'y2 = "&H" + Mid(Hex(n), 2, 2)
'End If
'End If
'If 4096 > n And n >= 256 Then
'If Mid(Hex(n), 2, 1) = "0" Then
'y1 = "&H" + Mid(Hex(n), 1, 1)
'y2 = "&H" + Mid(Hex(n), 3, 1)
'End If
'End If
If 256 > n And n >= 0 Then
y1 = "&H" + Hex(0)
y2 = "&H" + Hex(n)
End If
If n < 0 Then
If Mid(Hex(n), 3, 1) <> "0" Then
y1 = "&H" + Mid(Hex(n), 1, 2)
y2 = "&H" + Mid(Hex(n), 3, 2)
End If
End If
If n < 0 Then
If Mid(Hex(n), 3, 1) = "0" Then
y1 = "&H" + Mid(Hex(n), 1, 2)
y2 = "&H" + Mid(Hex(n), 4, 1)
End If
End If
Dim strr(15) As Byte
strr(0) = &H0 '交换识别号高字节，通常为 0
strr(1) = &H0 '交换识别号低字节，通常为 0
strr(2) = &H0 '协议识别号高字节，为 0
strr(3) = &H0 '协议识别号低字节，为 0
strr(4) = &H0 '字节长度高字节
strr(5) = &H9 '以下字节长度低字节
strr(6) = &H4 '单元识别号，确省为 255
strr(7) = &H10 '写寄存器命令代码
strr(8) = Int(m / 256) '写数据的起始地址高字节
strr(9) = m Mod 256 '写数据的起始地址低字节
strr(10) = &H0 '写入寄存器个数高字节
strr(11) = &H1 '写入寄存器个数低字节
strr(12) = &H1
strr(13) = y1 'Hex(Int(n / 256)) '写入数据高字节
strr(14) = y2 'n Mod 256 ' 写入数据低字节
Dim eStr As String
Dim i As Integer
For i = 0 To 14
eStr = eStr & Chr(strr(i))
'Text6.Text = Text6.Text & strr(i)
Next
Winsock1.SendData eStr
Exit Sub
ErrProc:
MsgBox "传输数据失败", vbCritical, "网络传输"
End Sub
Private Sub Command3_Click()
On Error GoTo ErrProc
Dim y As String
Text5.Text = ""
'y = "&H" + Hex(Text3.Text)
'u = Hex(Text3.Text)
Dim m1 As Integer
m1 = Text3.Text
u = m1
If m1 >= 32768 Or m1 < 0 Then
MsgBox "写入数据必须在0~32768之间", , "提示"
End If
Dim str(12) As Byte
str(0) = &H0 '交换识别号高字节，通常为 0
str(1) = &H0 '交换识别号低字节，通常为 0
str(2) = &H0 '协议识别号高字节，为 0
str(3) = &H0 '协议识别号低字节，为 0
str(4) = &H0 '字节长度高字节
str(5) = &H6 '以下字节长度低字节
str(6) = &H4 '单元识别号，确省为 255
str(7) = &H3 '读寄存器命令代码
str(8) = Int(m1 / 256) '读数据的起始地址高字节
str(9) = m1 Mod 256 '读数据的起始地址低字节
str(10) = &H0 '读数据寄存器个数高字节
str(11) = &H1 '读数据寄存器个数低字节
Dim bStr As String
Dim i As Integer
For i = 0 To 11
bStr = bStr & Chr$(str(i))
Next
Winsock1.SendData bStr
Exit Sub
ErrProc:
MsgBox "传输数据失败", vbCritical, "网络传输"
End Sub
Private Sub Command4_Click()
On Error GoTo ErrProc
Dim m3 As Integer
Dim p31 As String
m3 = Text3.Text
Text5.Text = ""
u = m3
'p31 = "&H" + Hex(p3)
'u = Hex(Text3.Text)
Dim sendstr(14) As Byte
sendstr(0) = &H0 '交换识别号高字节，通常为0
sendstr(1) = &H0 '交换识别号低字节，通常为0
sendstr(2) = &H0 '协议识别号高字节，为 0
sendstr(3) = &H0 '协议识别号低字节，为 0
sendstr(4) = &H0 '字节长度高字节
sendstr(5) = &H6 ' 以下字节长度低字节
sendstr(6) = &H0 '单元识别号，确省为 255
sendstr(7) = &H1 '写一个线圈命令代码
sendstr(8) = Int(m3 / 256) '读线圈的起始地址高字节
sendstr(9) = m3 Mod 256 '读线圈的起始地址低字节
sendstr(10) = &H0 '=FF打开线圈，=00关闭线圈
sendstr(11) = &H1
Dim aStr As String
Dim i As Integer
Dim j As Integer
For i = 0 To 11
dStr = dStr & Chr(sendstr(i))
Next
Winsock1.SendData dStr
Exit Sub
ErrProc:
MsgBox "传输数据失败", vbCritical, "网络传输"
End Sub
Private Sub Timer2_Timer()
Label4.Caption = Val(Label4.Caption) + 1
End Sub
Private Sub unconne_Click()
Winsock1.Close
Text2.Text = ""
If Winsock1.State = 0 Then
Label2.Caption = "连接断开"
Else: Label2.Caption = "已连接"
End If
Timer2.Enabled = False
Label4.Caption = ""
End Sub
Private Sub conne_Click()
'conne.Enabled = False
'exi.Enabled = ture
'Text1.Enabled = False
Winsock1.Close
Winsock1.Connect Text1, 502
Timer2.Enabled = True
End Sub
Private Sub exi_Click()
End
End Sub
Private Sub Form_Load()
Label2.Caption = "未连接"
Timer2.Enabled = False
Timer2.Interval = 1000 '时间为1000毫秒
Label4.Caption = 0
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
End Sub
Private Sub Timer1_Timer()
version.Caption = "Version: 1.0 : " + Format(Now, "mmm dd yyyy Hh:Nn:Ss")
End Sub
Private Sub Winsock1_Connect()
Label2.Caption = "connected time:(s)"
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim strdata() As Byte
Dim i As Integer
Dim j As Integer
Dim s As String
Dim s0 As String
Dim s1 As String
Dim s2 As String
Dim s11 As String
Dim s12 As String
'Dim IO As Byte
'Dim Y As String
Text4.Text = ""
i = Winsock1.BytesReceived
ReDim strdata(i)
Winsock1.GetData strdata, vbByte, i
For j = 0 To i - 1
's = s + Hex(strdata(j))
s = s & strdata(j)
Next
'If s Like "*5*" Then
'Text2.Text = s
's1 = Mid(s, 12, 2)
'If s1 = "10" Then
'IO = 1
'a = 0
'Else
'IO = 0
'a = 1
' End If
'If a = 1 Then
'Shape1.FillColor = RGB(0, 255, 0) 'green
'Label2.Caption = "IO点接通"
'End If
'If a = 0 Then
' Shape1.FillColor = RGB(255, 0, 0) 'red
'Label2.Caption = "IO点断开"
'End If
'End If
Dim b As Long
'Dim b1 As Long
If Hex(strdata(7)) Like "1" Then
s0 = Hex(strdata(9))
b = GetDecNum(s0) '这个16是十六进制的数
'Me.Print b '这里打印出来的b为十进制的数22.
Text2.Text = s
Text4.Text = "读线圈" & vbCrLf & vbCrLf & "偏移地址:" + "0" + u & vbCrLf & "读出数为：" & b
End If
If Hex(strdata(7)) Like "5" Then
Text2.Text = s
Text4.Text = "写线圈" & vbCrLf & vbCrLf & "偏移地址:" + "0" + u & vbCrLf & "写入数据：" & Text5.Text
End If
If Hex(strdata(7)) Like "3" Then
s1 = Hex(strdata(9))
s2 = Hex(strdata(10))
If Len(s1) = 2 Then
s11 = s1
Else
s11 = "0" + s1
End If
If Len(s2) = 2 Then
s12 = s2
Else
s12 = "0" + s2
End If
s0 = s11 + s12
b = GetDecNum(s0) '这个16是十六进制的数
'Me.Print b '这里打印出来的b为十进制的数22.
Text2.Text = s
Text4.Text = "读寄存器" & vbCrLf & vbCrLf & "偏移地址:" + "0" + u & vbCrLf & "读出数为：" & b
End If
If Hex(strdata(7)) Like "10" Then
Text2.Text = s
Text4.Text = "写寄存器" & vbCrLf & vbCrLf & "偏移地址:" + "0" + u & vbCrLf & "写入数据：" & Text5.Text
End If
End Sub
If Mid(Trim(hexNum), 1, 2) = "&H" & Mid(Trim(hexNum), 1, 2) = "&h" Then
GetDecNum = Val(hexNum)
Else
hexNum = "&H" & hexNum
GetDecNum = Val(hexNum)
End If
End Function
Private Sub Check1_Click()
If Check1.Value = 1 Then
Text1.Text = "127.0.0.1"
Else
Text1.Text = "192.168.0.13"
End If
End Sub
Private Sub Command1_Click()
On Error GoTo ErrProc
Dim p1 As Integer
Dim p2 As Integer
Dim p11 As String
Dim p21 As String
p1 = Text3.Text
p2 = Text5.Text
u = p1
'u = Hex(Text3.Text)
'p11 = "&H" + Hex(p1)
If p2 = 0 Then
'p21 = "&H" + Hex(0)
p21 = 0
ElseIf p2 = 1 Then
p21 = "&H" + "FF"
Else
MsgBox "写入数据必须是1或0", , "提示"
End If
Dim sendstr(14) As Byte
sendstr(0) = &H0 '交换识别号高字节，通常为0
sendstr(1) = &H0 '交换识别号低字节，通常为0
sendstr(2) = &H0 '协议识别号高字节，为 0
sendstr(3) = &H0 '协议识别号低字节，为 0
sendstr(4) = &H0 '字节长度高字节
sendstr(5) = &H6 ' 以下字节长度低字节
sendstr(6) = &H0 '单元识别号，确省为 255
sendstr(7) = &H5 '写一个线圈命令代码
sendstr(8) = Int(p1 / 256) '写线圈的起始地址高字节
sendstr(9) = p1 Mod 256 '写线圈的起始地址低字节
sendstr(10) = p21 '=FF打开线圈，=00关闭线圈
sendstr(11) = &H0
Dim aStr As String
Dim i As Integer
Dim j As Integer
For i = 0 To 11
aStr = aStr & Chr(sendstr(i))
Next
Winsock1.SendData aStr
Exit Sub
ErrProc:
MsgBox "传输数据失败", vbCritical, "网络传输"
End Sub
Private Sub Command2_Click()
'On Error GoTo ErrProc
Dim m As Integer
Dim n As Integer
Dim x As String
Dim y1 As String
Dim y2 As String
Dim y3 As String
Dim y4 As String
m = Text3.Text
n = Text5.Text
x = Hex(n)
u = m
If m >= 32768 Or m < -32768 Then
MsgBox "写入数据必须在0~32768之间", , "提示"
End If
'If 32768 > n And n >= 4096 Then
'If Mid(Hex(n), 3, 1) = "0" Then
'y1 = "&H" + Mid(Hex(n), 1, 2)
'y2 = "&H" + Mid(Hex(n), 4, 1)
'End If
'End If
'If 32768 > n And n >= 4096 Then
'If Mid(Hex(n), 3, 1) <> "0" Then
'y1 = "&H" + Mid(Hex(n), 1, 2)
'y2 = "&H" + Mid(Hex(n), 3, 2)
'End If
'End If
'If 4096 > n And n >= 256 Then
'If Mid(Hex(n), 2, 1) <> "0" Then
'y1 = "&H" + Mid(Hex(n), 1, 1)
'y2 = "&H" + Mid(Hex(n), 2, 2)
'End If
'End If
'If 4096 > n And n >= 256 Then
'If Mid(Hex(n), 2, 1) = "0" Then
'y1 = "&H" + Mid(Hex(n), 1, 1)
'y2 = "&H" + Mid(Hex(n), 3, 1)
'End If
'End If
If 256 > n And n >= 0 Then
y1 = "&H" + Hex(0)
y2 = "&H" + Hex(n)
End If
If n < 0 Then
If Mid(Hex(n), 3, 1) <> "0" Then
y1 = "&H" + Mid(Hex(n), 1, 2)
y2 = "&H" + Mid(Hex(n), 3, 2)
End If
End If
If n < 0 Then
If Mid(Hex(n), 3, 1) = "0" Then
y1 = "&H" + Mid(Hex(n), 1, 2)
y2 = "&H" + Mid(Hex(n), 4, 1)
End If
End If
Dim strr(15) As Byte
strr(0) = &H0 '交换识别号高字节，通常为 0
strr(1) = &H0 '交换识别号低字节，通常为 0
strr(2) = &H0 '协议识别号高字节，为 0
strr(3) = &H0 '协议识别号低字节，为 0
strr(4) = &H0 '字节长度高字节
strr(5) = &H9 '以下字节长度低字节
strr(6) = &H4 '单元识别号，确省为 255
strr(7) = &H10 '写寄存器命令代码
strr(8) = Int(m / 256) '写数据的起始地址高字节
strr(9) = m Mod 256 '写数据的起始地址低字节
strr(10) = &H0 '写入寄存器个数高字节
strr(11) = &H1 '写入寄存器个数低字节
strr(12) = &H1
strr(13) = y1 'Hex(Int(n / 256)) '写入数据高字节
strr(14) = y2 'n Mod 256 ' 写入数据低字节
Dim eStr As String
Dim i As Integer
For i = 0 To 14
eStr = eStr & Chr(strr(i))
'Text6.Text = Text6.Text & strr(i)
Next
Winsock1.SendData eStr
Exit Sub
ErrProc:
MsgBox "传输数据失败", vbCritical, "网络传输"
End Sub
Private Sub Command3_Click()
On Error GoTo ErrProc
Dim y As String
Text5.Text = ""
'y = "&H" + Hex(Text3.Text)
'u = Hex(Text3.Text)
Dim m1 As Integer
m1 = Text3.Text
u = m1
If m1 >= 32768 Or m1 < 0 Then
MsgBox "写入数据必须在0~32768之间", , "提示"
End If
Dim str(12) As Byte
str(0) = &H0 '交换识别号高字节，通常为 0
str(1) = &H0 '交换识别号低字节，通常为 0
str(2) = &H0 '协议识别号高字节，为 0
str(3) = &H0 '协议识别号低字节，为 0
str(4) = &H0 '字节长度高字节
str(5) = &H6 '以下字节长度低字节
str(6) = &H4 '单元识别号，确省为 255
str(7) = &H3 '读寄存器命令代码
str(8) = Int(m1 / 256) '读数据的起始地址高字节
str(9) = m1 Mod 256 '读数据的起始地址低字节
str(10) = &H0 '读数据寄存器个数高字节
str(11) = &H1 '读数据寄存器个数低字节
Dim bStr As String
Dim i As Integer
For i = 0 To 11
bStr = bStr & Chr$(str(i))
Next
Winsock1.SendData bStr
Exit Sub
ErrProc:
MsgBox "传输数据失败", vbCritical, "网络传输"
End Sub
Private Sub Command4_Click()
On Error GoTo ErrProc
Dim m3 As Integer
Dim p31 As String
m3 = Text3.Text
Text5.Text = ""
u = m3
'p31 = "&H" + Hex(p3)
'u = Hex(Text3.Text)
Dim sendstr(14) As Byte
sendstr(0) = &H0 '交换识别号高字节，通常为0
sendstr(1) = &H0 '交换识别号低字节，通常为0
sendstr(2) = &H0 '协议识别号高字节，为 0
sendstr(3) = &H0 '协议识别号低字节，为 0
sendstr(4) = &H0 '字节长度高字节
sendstr(5) = &H6 ' 以下字节长度低字节
sendstr(6) = &H0 '单元识别号，确省为 255
sendstr(7) = &H1 '写一个线圈命令代码
sendstr(8) = Int(m3 / 256) '读线圈的起始地址高字节
sendstr(9) = m3 Mod 256 '读线圈的起始地址低字节
sendstr(10) = &H0 '=FF打开线圈，=00关闭线圈
sendstr(11) = &H1
Dim aStr As String
Dim i As Integer
Dim j As Integer
For i = 0 To 11
dStr = dStr & Chr(sendstr(i))
Next
Winsock1.SendData dStr
Exit Sub
ErrProc:
MsgBox "传输数据失败", vbCritical, "网络传输"
End Sub
Private Sub Timer2_Timer()
Label4.Caption = Val(Label4.Caption) + 1
End Sub
Private Sub unconne_Click()
Winsock1.Close
Text2.Text = ""
If Winsock1.State = 0 Then
Label2.Caption = "连接断开"
Else: Label2.Caption = "已连接"
End If
Timer2.Enabled = False
Label4.Caption = ""
End Sub
Private Sub conne_Click()
'conne.Enabled = False
'exi.Enabled = ture
'Text1.Enabled = False
Winsock1.Close
Winsock1.Connect Text1, 502
Timer2.Enabled = True
End Sub
Private Sub exi_Click()
End
End Sub
Private Sub Form_Load()
Label2.Caption = "未连接"
Timer2.Enabled = False
Timer2.Interval = 1000 '时间为1000毫秒
Label4.Caption = 0
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
End Sub
Private Sub Timer1_Timer()
version.Caption = "Version: 1.0 : " + Format(Now, "mmm dd yyyy Hh:Nn:Ss")
End Sub
Private Sub Winsock1_Connect()
Label2.Caption = "connected time:(s)"
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim strdata() As Byte
Dim i As Integer
Dim j As Integer
Dim s As String
Dim s0 As String
Dim s1 As String
Dim s2 As String
Dim s11 As String
Dim s12 As String
'Dim IO As Byte
'Dim Y As String
Text4.Text = ""
i = Winsock1.BytesReceived
ReDim strdata(i)
Winsock1.GetData strdata, vbByte, i
For j = 0 To i - 1
's = s + Hex(strdata(j))
s = s & strdata(j)
Next
'If s Like "*5*" Then
'Text2.Text = s
's1 = Mid(s, 12, 2)
'If s1 = "10" Then
'IO = 1
'a = 0
'Else
'IO = 0
'a = 1
' End If
'If a = 1 Then
'Shape1.FillColor = RGB(0, 255, 0) 'green
'Label2.Caption = "IO点接通"
'End If
'If a = 0 Then
' Shape1.FillColor = RGB(255, 0, 0) 'red
'Label2.Caption = "IO点断开"
'End If
'End If
Dim b As Long
'Dim b1 As Long
If Hex(strdata(7)) Like "1" Then
s0 = Hex(strdata(9))
b = GetDecNum(s0) '这个16是十六进制的数
'Me.Print b '这里打印出来的b为十进制的数22.
Text2.Text = s
Text4.Text = "读线圈" & vbCrLf & vbCrLf & "偏移地址:" + "0" + u & vbCrLf & "读出数为：" & b
End If
If Hex(strdata(7)) Like "5" Then
Text2.Text = s
Text4.Text = "写线圈" & vbCrLf & vbCrLf & "偏移地址:" + "0" + u & vbCrLf & "写入数据：" & Text5.Text
End If
If Hex(strdata(7)) Like "3" Then
s1 = Hex(strdata(9))
s2 = Hex(strdata(10))
If Len(s1) = 2 Then
s11 = s1
Else
s11 = "0" + s1
End If
If Len(s2) = 2 Then
s12 = s2
Else
s12 = "0" + s2
End If
s0 = s11 + s12
b = GetDecNum(s0) '这个16是十六进制的数
'Me.Print b '这里打印出来的b为十进制的数22.
Text2.Text = s
Text4.Text = "读寄存器" & vbCrLf & vbCrLf & "偏移地址:" + "0" + u & vbCrLf & "读出数为：" & b
End If
If Hex(strdata(7)) Like "10" Then
Text2.Text = s
Text4.Text = "写寄存器" & vbCrLf & vbCrLf & "偏移地址:" + "0" + u & vbCrLf & "写入数据：" & Text5.Text
End If
End Sub