实例介绍
【实例简介】
上位机与安川PLC通讯的控件，控件支持C#、VB.net
【实例截图】截图是C#应用截图，控件是VB.net写的。
控件应用截图：
【文件目录】
MEMOBUS_COM
├── MEMOBUS_COM
│ ├── MEMOBUS_COM.Designer.vb
│ ├── MEMOBUS_COM.resx
│ ├── MEMOBUS_COM.vb
│ ├── MEMOBUS_COM.vbproj
│ ├── MEMOBUS_COM.vbproj.user
│ ├── My Project
│ │ ├── Application.Designer.vb
│ │ ├── Application.myapp
│ │ ├── AssemblyInfo.vb
│ │ ├── Resources.Designer.vb
│ │ ├── Resources.resx
│ │ ├── Settings.Designer.vb
│ │ └── Settings.settings
│ ├── Resources
│ │ ├── 通讯中断.png
│ │ └── 通讯连接.png
│ ├── bin
│ │ ├── Debug
│ │ │ ├── MEMOBUS_COM.dll
│ │ │ ├── MEMOBUS_COM.pdb
│ │ │ ├── MEMOBUS_COM.xml
│ │ │ └── MEMOBUS_TEST.exe
│ │ └── Release
│ └── obj
│ ├── Debug
│ │ ├── DesignTimeResolveAssemblyReferences.cache
│ │ ├── DesignTimeResolveAssemblyReferencesInput.cache
│ │ ├── MEMOBUS_COM.MEMOBUS_COM.resources
│ │ ├── MEMOBUS_COM.Resources.resources
│ │ ├── MEMOBUS_COM.dll
│ │ ├── MEMOBUS_COM.pdb
│ │ ├── MEMOBUS_COM.vbproj.FileListAbsolute.txt
│ │ ├── MEMOBUS_COM.vbproj.GenerateResource.Cache
│ │ ├── MEMOBUS_COM.vbprojResolveAssemblyReference.cache
│ │ ├── MEMOBUS_COM.xml
│ │ └── TempPE
│ │ └── My Project.Resources.Designer.vb.dll
│ └── Release
├── MEMOBUS_COM.sln
└── MEMOBUS_COM.suo
10 directories, 31 files
【核心代码】
Imports System.Net
Imports System.Net.Sockets
Imports System.Threading
Public Class MEMOBUS_COM
Declare Function GetTickCount Lib "kernel32" () As Integer
Private m_LocalIP As IPAddress
Private m_ConIP As IPAddress
Private m_ConPort As Integer
Private m_Socket As Socket
Private from_addr As SocketAddress
Private sbuf(4095) As Byte
Private rbuf(4095) As Byte
Private DATAi, MDATAi As Short
Private m_rMsg As String
Private m_rLen As Integer = 0
Private m_GetData() As Integer
Private m_GetDataL() As Integer
Private iSerial As Short
Private Ssbuf, Srbuf As String
Private Sub MEMOBUS_COM_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
iSerial = 0 '序列号，作用？
End Sub
Public Property localIP As IPAddress
Get
Return m_LocalIP
End Get
Set(ByVal value As Net.IPAddress)
m_LocalIP = value
End Set
End Property
Public Property conIP As IPAddress
Get
Return m_ConIP
End Get
Set(ByVal value As Net.IPAddress)
m_ConIP = value
End Set
End Property
Public Property conPort As Integer
Get
Return m_ConPort
End Get
Set(ByVal value As Integer)
m_ConPort = value
End Set
End Property
Public Function ConnectTCP() As Integer
Try
m_Socket = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
Dim point1 As IPEndPoint = New IPEndPoint(m_LocalIP, 0)
Dim point2 As IPEndPoint = New IPEndPoint(m_ConIP, m_ConPort)
m_Socket.Bind(point1)
m_Socket.Connect(point2)
Dim c_thread As Thread = New Thread(AddressOf ReceiveMsg)
c_thread.IsBackground = True
c_thread.Start()
Timer_STATUS.Enabled = True
Return 0
Catch ex As Exception
Return -1
End Try
End Function
Public Sub CloseTCP()
If isConnect() Then
Try
m_Socket.Shutdown(SocketShutdown.Both)
Catch ex As Exception
Finally
m_Socket.Close(1)
End Try
End If
End Sub
Public Function isConnect() As Boolean
Dim rc As Boolean
rc = m_Socket.Connected
Return rc
End Function
Private Function SendMsg(ByVal sMsg As String) As Short
Dim buffer(4096) As Byte
Try
buffer = System.Text.Encoding.ASCII.GetBytes(sMsg)
m_Socket.Send(buffer)
Return 0
Catch ex As Exception
Return -1
End Try
End Function
Private Sub ReceiveMsg()
Dim buffer(4096) As Byte
Dim zeroChars() As Char = {ChrW(0)}
Dim str1 As String = ""
Dim rc As Integer
While True
Try
Dim len As Integer = m_Socket.Receive(buffer)
If len = 0 Then
m_rMsg = ""
Exit While
Else
m_rMsg = System.Text.Encoding.ASCII.GetString(buffer, 0, len).TrimEnd(zeroChars)
'rc = ChkRspData(len, m_rMsg)
rc = ChkRspData_LAddr(len, m_rMsg)
m_rLen = len
Array.Clear(buffer, 0, 4096)
End If
Catch ex As Exception
Exit Sub
End Try
End While
End Sub
'------------------------------------------------------------------------------
' 创建扩展MEMOBUS协议指令
'------------------------------------------------------------------------------
Private Function MkCmdReadData(ByVal SFC As Byte, ByVal CPUNum As Byte,
ByVal Adr As Short, ByVal DataNum As Short,
ByRef Ssbuf As String) As Integer
Dim i As Integer
Dim Swork As String
'---- 计算数据数 ----
'---- MEMOBUS数据长度(Length为MFC至数据末尾) ----
Select Case SFC
Case &H9
MDATAi = 8
Case Else
MsgBox("Function code error")
Return -1
End Select
'---- 计算总数据数 ----
DATAi = MDATAi 14 '218报头(12字节) Length部(2字节) MEMOBUS数据长度(可变)
If DATAi > 4096 Then
MsgBox("Register size error")
Return -1
End If
'---- 清除缓冲 ----
For i = 0 To 4095
sbuf(i) = 0
Next
'---- 创建218报头部 ----
'---- 设定数据类别 ----
sbuf(0) = &H11 ' 扩展MEMOBUS(指令)
'---- 设定序列号(每次发送时递增) ----
sbuf(1) = (iSerial 1) Mod 256
'---- 设定发送目标通道编号 ----
sbuf(2) = &H0 'PLC侧通道不固定，因此可固定为0
'---- 设定发送源通道编号 ----
sbuf(3) = &H0 '电脑中无通道概念，因此固定为0
sbuf(4) = &H0 '预约
sbuf(5) = &H0 '预约
'---- 设定总数据数(218报头起始至MEMOBUS数据末尾) ----
'---- SFC"09"时， 22字节 = 218报头(12字节) MEMOBUS数据(10字节) ----
sbuf(6) = DATAi '数据长度(L)
sbuf(7) = DATAi \ 256 '数据长度(H)
sbuf(8) = &H0 '预约
sbuf(9) = &H0 '预约
sbuf(10) = &H0 '预约
sbuf(11) = &H0 '预约
'---- 创建MEMOBUS数据部 ----
'---- Length为MFC至数据末尾 ----
sbuf(12) = CByte(MDATAi And &HFF) '数据长度(L)
sbuf(13) = CByte((MDATAi And &HFF00) \ 256) '数据长度(H)
'---- MFC固定为0x20 ----
sbuf(14) = &H20
'---- SFC ----
sbuf(15) = SFC
'---- 设定CPU编号 ----
sbuf(16) = CPUNum * 16
sbuf(17) = &H0 'Spare固定为0
'---- 设定参考编号 ----
sbuf(18) = CByte(Adr And &HFF) 'Adr(L)
sbuf(19) = CByte((Adr And &HFF00) \ 256) 'Adr(H)
'---- 设定寄存器数 ----
sbuf(20) = CByte(DataNum And &HFF) 'DataNum(L)
sbuf(21) = CByte((DataNum And &HFF00) \ 256) 'DataNum(H)
'---- 将Byte型转换成String型 ----
For i = 0 To 21
Swork = Hex(sbuf(i))
If Len(Swork) = 1 Then
Swork = "0" Swork
End If
Ssbuf = Ssbuf Swork
Next
Return 0
End Function
'==========================扩展地址读取================================================
Private Function MkCmdReadData_Laddr(ByVal SFC As Byte, ByVal CPUNum As Byte,
ByVal Adr As Integer, ByVal DataNum As Short,
ByRef Ssbuf As String) As Integer
Dim i As Integer
Dim Swork As String
'---- 计算数据数 ----
'---- MEMOBUS数据长度(Length为MFC至数据末尾) ----
Select Case SFC
Case &H49
MDATAi = 12
Case Else
MsgBox("Function code error")
Return -1
End Select
'---- 计算总数据数 ----
DATAi = MDATAi 14 '218报头(12字节) Length部(2字节) MEMOBUS数据长度(可变)
If DATAi > 4096 Then
MsgBox("Register size error")
Return -1
End If
'---- 清除缓冲 ----
For i = 0 To 4095
sbuf(i) = 0
Next
'---- 创建218报头部 ----
'---- 设定数据类别 ----
sbuf(0) = &H11 ' 扩展MEMOBUS(指令)
'---- 设定序列号(每次发送时递增) ----
sbuf(1) = (iSerial 1) Mod 256
'---- 设定发送目标通道编号 ----
sbuf(2) = &H0 'PLC侧通道不固定，因此可固定为0
'---- 设定发送源通道编号 ----
sbuf(3) = &H0 '电脑中无通道概念，因此固定为0
sbuf(4) = &H0 '预约
sbuf(5) = &H0 '预约
'---- 设定总数据数(218报头起始至MEMOBUS数据末尾) ----
'---- SFC"09"时， 22字节 = 218报头(12字节) MEMOBUS数据(10字节) ----
sbuf(6) = DATAi '数据长度(L)
sbuf(7) = DATAi \ 256 '数据长度(H)
sbuf(8) = &H0 '预约
sbuf(9) = &H0 '预约
sbuf(10) = &H0 '预约
sbuf(11) = &H0 '预约
'---- 创建MEMOBUS数据部 ----
'---- Length为MFC至数据末尾 ----
sbuf(12) = CByte(MDATAi And &HFF) '数据长度(L)
sbuf(13) = CByte((MDATAi And &HFF00) \ 256) '数据长度(H)
'---- MFC固定为0x20 ----
sbuf(14) = &H43
'---- SFC ----
sbuf(15) = SFC
'---- 设定CPU编号 ----
sbuf(16) = CPUNum * 16
sbuf(17) = &H0 'Spare固定为0
'------设定寄存器种类-------
sbuf(18) = &H4D
sbuf(19) = &H0
'---- 设定参考编号 ----
Dim addr1(4) As Byte
Integer2DByte(Adr, addr1)
sbuf(20) = addr1(1) 'Adr(LL)
sbuf(21) = addr1(2) 'Adr(LH)
sbuf(22) = addr1(3) 'Adr(HL)
sbuf(23) = addr1(4) 'Adr(HH)
'---- 设定寄存器数 ----
sbuf(24) = CByte(DataNum And &HFF) 'DataNum(L)
sbuf(25) = CByte((DataNum And &HFF00) \ 256) 'DataNum(H)
'---- 将Byte型转换成String型 ----
For i = 0 To 25
Swork = Hex(sbuf(i))
If Len(Swork) = 1 Then
Swork = "0" Swork
End If
Ssbuf = Ssbuf Swork
Next
Return 0
End Function
'------------------------------------------------------------------------------
' 确认响应数据
'------------------------------------------------------------------------------
Private Function ChkRspData(ByVal rlen As Short, ByRef Srbuf As String) As Short
Dim i, j As Integer
Dim rcvDATAi As Short
Dim rc As Short
Dim var1 As Integer
rc = 0
'---- 将String型转换成Byte型 ----
j = 0
For i = 0 To rlen - 1
rbuf(i) = Val("&H" & Mid(Srbuf, j 1, 2))
j = j 2
Next
'----确认总数据长度 ----
var1 = Byte2Integer(sbuf(20), sbuf(21))
If rlen <> (20 var1 * 2) * 2 Then
rc = -1
Return (rc)
End If
'---- 确认数据包类型 ----
If (rbuf(0) <> &H19) Then
rc = -2
Return (rc)
End If
'---- 确认序列号 ----
If (sbuf(1) <> rbuf(1)) Then
rc = -3
Return (rc)
End If
'---- 确认通信文本的总数据长度 ----
Select Case sbuf(15)
Case &H9
rcvDATAi = Val(Str(sbuf(21)) & Str(sbuf(20))) * 2 20
If ((rbuf(6) <> rcvDATAi) And (rbuf(7) <> (rcvDATAi \ 256))) Then
rc = -4
Return (rc)
End If
Case Else
rc = -10
Return (rc)
End Select
'---- 确认MFC ----
If (rbuf(14) <> &H20) Then
rc = -6
Return (rc)
End If
'---- 确认SFC ----
If (rbuf(15) <> sbuf(15)) Then
rc = -7
Return (rc)
End If
'---- 确认寄存器数 ----
If ((rbuf(18) <> sbuf(20)) Or (rbuf(19) <> sbuf(21))) Then
rc = -8
Return (rc)
End If
'---- 读取rbuf(20)以后的寄存器数据 ----
Dim DataNum As Integer
DataNum = Byte2Integer(rbuf(18), rbuf(19))
ReDim m_GetData(DataNum)
ReDim m_GetDataL(DataNum / 2)
For i = 1 To DataNum
m_GetData(i) = Byte2Integer(rbuf(18 2 * i), rbuf(19 2 * i))
Next
For i = 0 To DataNum / 2 - 1
m_GetDataL(i) = DByte2Integer(rbuf(20 4 * i), rbuf(21 4 * i), rbuf(22 4 * i), rbuf(23 4 * i))
Next
iSerial = iSerial 1
If iSerial = 60000 Then iSerial = 0
Return (rc)
End Function
'================响应扩展地址数据========================================
Private Function ChkRspData_LAddr(ByVal rlen As Short, ByRef Srbuf As String) As Short
Dim i, j As Integer
Dim rcvDATAi As Short
Dim rc As Short
Dim var1 As Integer
rc = 0
'---- 将String型转换成Byte型 ----
j = 0
For i = 0 To rlen - 1
rbuf(i) = Val("&H" & Mid(Srbuf, j 1, 2))
j = j 2
Next
'----确认总数据长度 ----
var1 = Byte2Integer(sbuf(24), sbuf(25))
If rlen <> (22 var1 * 2) * 2 Then
rc = -1
Return (rc)
End If
'---- 确认数据包类型 ----
If (rbuf(0) <> &H19) Then
rc = -2
Return (rc)
End If
'---- 确认序列号 ----
If (sbuf(1) <> rbuf(1)) Then
rc = -3
Return (rc)
End If
'---- 确认通信文本的总数据长度 ----
Select Case sbuf(15)
Case &H49
rcvDATAi = Val(Str(sbuf(25)) & Str(sbuf(24))) * 2 22
If ((rbuf(6) <> rcvDATAi) And (rbuf(7) <> (rcvDATAi \ 256))) Then
rc = -4
Return (rc)
End If
Case Else
rc = -10
Return (rc)
End Select
'---- 确认MFC ----
If (rbuf(14) <> &H43) Then
rc = -6
Return (rc)
End If
'---- 确认SFC ----
If (rbuf(15) <> sbuf(15)) Then
rc = -7
Return (rc)
End If
'---- 确认寄存器数 ----
If ((rbuf(20) <> sbuf(24)) Or (rbuf(21) <> sbuf(25))) Then
rc = -8
Return (rc)
End If
'---- 读取rbuf(22)以后的寄存器数据 ----
Dim DataNum As Integer
DataNum = Byte2Integer(rbuf(20), rbuf(21))
ReDim m_GetData(DataNum)
ReDim m_GetDataL(DataNum / 2)
For i = 1 To DataNum
m_GetData(i) = Byte2Integer(rbuf(20 2 * i), rbuf(21 2 * i))
Next
For i = 0 To DataNum / 2 - 1
m_GetDataL(i) = DByte2Integer(rbuf(22 4 * i), rbuf(23 4 * i), rbuf(24 4 * i), rbuf(25 4 * i))
Next
iSerial = iSerial 1
If iSerial = 60000 Then iSerial = 0
Return (rc)
End Function
'---------------------------------------------------------------------
Private Function MkCmdSendData(ByVal SFC As Byte, ByVal CPUNum As Byte,
ByVal Adr As Short, ByVal DataNum As Short, ByVal iData() As Integer,
ByRef Ssbuf As String) As Integer
Dim i As Integer
Dim Swork As String
If DataNum < 1 Then Return 0
'---- 计算数据数 ----
'---- MEMOBUS数据长度(Length为MFC至数据末尾) ----
Select Case SFC
Case &HB
MDATAi = 8 DataNum * 4 ' //integer 占4位
Case Else
MsgBox("Function code error")
Return -1
End Select
'---- 计算总数据数 ----
DATAi = MDATAi 12 2 '218报头(12字节) Length部(2字节) MEMOBUS固有数据长度(可变)
If DATAi > 4096 Then
MsgBox("Register size error")
Return -1
End If
'---- 清除缓冲 ----
For i = 0 To 4095
sbuf(i) = 0
Next
'---- 创建218报头部 ----
'---- 设定数据类别 ----
sbuf(0) = &H11 ' 扩展MEMOBUS(指令)
'---- 设定序列号(每次发送时递增) ----
sbuf(1) = (iSerial 1) Mod 256
'---- 设定发送目标通道编号 ----
sbuf(2) = &H0 'PLC侧通道不固定，因此可固定为0
'---- 设定发送源通道编号 ----
sbuf(3) = &H0 '电脑中无通道概念，因此固定为0
sbuf(4) = &H0 '预约
sbuf(5) = &H0 '预约
'---- 设定总数据数(218报头起始至MEMOBUS数据末尾) ----
'---- SFC"09"时， 22字节 = 218报头(12字节) MEMOBUS数据(10字节) ----
sbuf(6) = DATAi '数据长度(L)
sbuf(7) = DATAi \ 256 '数据长度(H)
sbuf(8) = &H0 '预约
sbuf(9) = &H0 '预约
sbuf(10) = &H0 '预约
sbuf(11) = &H0 '预约
'---- 创建MEMOBUS数据部 ----
'---- Length为MFC至数据末尾 ----
sbuf(12) = CByte(MDATAi And &HFF) '数据长度(L)
sbuf(13) = CByte((MDATAi And &HFF00) \ 256) '数据长度(H)
'---- MFC固定为0x20 ----
sbuf(14) = &H20
'---- SFC ----
sbuf(15) = SFC
'---- 设定CPU编号 ----
sbuf(16) = CPUNum * 16
sbuf(17) = &H0 'Spare固定为0
'---- 设定参考编号 ----
sbuf(18) = CByte(Adr And &HFF) 'Adr(L)
sbuf(19) = CByte((Adr And &HFF00) \ 256) 'Adr(H)
'---- 设定寄存器数 ----
sbuf(20) = CByte((DataNum * 2) And &HFF) 'DataNum(L)
sbuf(21) = CByte(((DataNum * 2) And &HFF00) \ 256) 'DataNum(H)
'---- 录入数据，将Integer型转换成Byte型 ----
Dim iByte(4) As Byte
For i = 0 To DataNum - 1
Integer2DByte(iData(i), iByte)
sbuf(22 i * 4) = iByte(1)
sbuf(22 i * 4 1) = iByte(2)
sbuf(22 i * 4 2) = iByte(3)
sbuf(22 i * 4 3) = iByte(4)
Next
'---- 将Byte型转换成String型 ----
For i = 0 To DATAi - 1
Swork = Hex(sbuf(i))
If Len(Swork) = 1 Then
Swork = "0" Swork
End If
Ssbuf = Ssbuf Swork
Next
Return 0
End Function
'=========================写扩展地址数据====================================================
Private Function MkCmdSendData_LAddr(ByVal SFC As Byte, ByVal CPUNum As Byte,
ByVal Adr As Integer, ByVal DataNum As Short, ByVal iData() As Integer,
ByRef Ssbuf As String) As Integer
Dim i As Integer
Dim Swork As String
If DataNum < 1 Then Return 0
'---- 计算数据数 ----
'---- MEMOBUS数据长度(Length为MFC至数据末尾) ----
Select Case SFC
Case &H4B
MDATAi = 12 DataNum * 4 ' //integer 占4位
Case Else
MsgBox("Function code error")
Return -1
End Select
'---- 计算总数据数 ----
DATAi = MDATAi 12 2 '218报头(12字节) Length部(2字节) MEMOBUS固有数据长度(可变)
If DATAi > 4096 Then
MsgBox("Register size error")
Return -1
End If
'---- 清除缓冲 ----
For i = 0 To 4095
sbuf(i) = 0
Next
'---- 创建218报头部 ----
'---- 设定数据类别 ----
sbuf(0) = &H11 ' 扩展MEMOBUS(指令)
'---- 设定序列号(每次发送时递增) ----
sbuf(1) = (iSerial 1) Mod 256
'---- 设定发送目标通道编号 ----
sbuf(2) = &H0 'PLC侧通道不固定，因此可固定为0
'---- 设定发送源通道编号 ----
sbuf(3) = &H0 '电脑中无通道概念，因此固定为0
sbuf(4) = &H0 '预约
sbuf(5) = &H0 '预约
'---- 设定总数据数(218报头起始至MEMOBUS数据末尾) ----
'---- SFC"09"时， 22字节 = 218报头(12字节) MEMOBUS数据(10字节) ----
sbuf(6) = DATAi '数据长度(L)
sbuf(7) = DATAi \ 256 '数据长度(H)
sbuf(8) = &H0 '预约
sbuf(9) = &H0 '预约
sbuf(10) = &H0 '预约
sbuf(11) = &H0 '预约
'---- 创建MEMOBUS数据部 ----
'---- Length为MFC至数据末尾 ----
sbuf(12) = CByte(MDATAi And &HFF) '数据长度(L)
sbuf(13) = CByte((MDATAi And &HFF00) \ 256) '数据长度(H)
'---- MFC固定为0x20 ----
sbuf(14) = &H43
'---- SFC ----
sbuf(15) = SFC
'---- 设定CPU编号 ----
sbuf(16) = CPUNum * 16
sbuf(17) = &H0 'Spare固定为0
'-------设定寄存器种类------------
sbuf(18) = &H4D
sbuf(19) = &H0
'---- 设定参考编号 ----
Dim addr1(4) As Byte
Integer2DByte(Adr, addr1)
sbuf(20) = addr1(1) 'Adr(LL)
sbuf(21) = addr1(2) 'Adr(LH)
sbuf(22) = addr1(3) 'Adr(HL)
sbuf(23) = addr1(4) 'Adr(HH)
'---- 设定寄存器数 ----
sbuf(24) = CByte((DataNum * 2) And &HFF) 'DataNum(L)
sbuf(25) = CByte(((DataNum * 2) And &HFF00) \ 256) 'DataNum(H)
'---- 录入数据，将Integer型转换成Byte型 ----
Dim iByte(4) As Byte
For i = 0 To DataNum - 1
Integer2DByte(iData(i), iByte)
sbuf(26 i * 4) = iByte(1)
sbuf(26 i * 4 1) = iByte(2)
sbuf(26 i * 4 2) = iByte(3)
sbuf(26 i * 4 3) = iByte(4)
Next
'---- 将Byte型转换成String型 ----
For i = 0 To DATAi - 1
Swork = Hex(sbuf(i))
If Len(Swork) = 1 Then
Swork = "0" Swork
End If
Ssbuf = Ssbuf Swork
Next
Return 0
End Function
'----------------------------------------------------------------------------
Private Function Byte2Integer(ByVal varL As Byte, ByVal varH As Byte) As Integer
Dim str1, strL, strH As String
Dim var1 As Integer
strH = Hex(varH) : strL = Hex(varL)
strH = strH.PadLeft(2, "0") : strL = strL.PadLeft(2, "0")
str1 = strH & strL
var1 = CInt(Val("&H" & (str1)))
Return var1
End Function
Private Function DByte2Integer(ByVal varL1 As Byte, ByVal varH1 As Byte, ByVal varL2 As Byte, ByVal varH2 As Byte) As Integer
Dim str1, strL1, strH1, strL2, strH2 As String
Dim var1 As Integer
Dim in1 As Long
strH1 = Hex(varH1) : strL1 = Hex(varL1)
strH2 = Hex(varH2) : strL2 = Hex(varL2)
strH1 = strH1.PadLeft(2, "0") : strL1 = strL1.PadLeft(2, "0")
strH2 = strH2.PadLeft(2, "0") : strL2 = strL2.PadLeft(2, "0")
str1 = strH2 & strL2 & strH1 & strL1
If CLng("&H" & str1) > 2147483647 Then
in1 = CLng("&H" & str1) - 4294967296
Else
in1 = CLng("&H" & str1)
End If
var1 = in1
Return var1
End Function
Public Sub Integer2DByte(dataInt As Integer, ByRef varByte() As Byte)
Dim str1, str2 As String
Dim str3(4) As String
ReDim varByte(4)
str1 = Hex(dataInt)
str2 = str1.PadLeft(8, "0")
str3(1) = Strings.Right(str2, 2)
str3(2) = Strings.Mid(str2, 5, 2)
str3(3) = Strings.Mid(str2, 3, 2)
str3(4) = Strings.Left(str2, 2)
varByte(1) = CByte("&H" & str3(1))
varByte(2) = CByte("&H" & str3(2))
varByte(3) = CByte("&H" & str3(3))
varByte(4) = CByte("&H" & str3(4))
'varByte(1) = CByte(dataInt And &HFF)
'varByte(3) = CByte((dataInt And &HFF00) \ 256)
'varByte(4) = CByte((dataInt And &HFF0000) \ 65536)
'varByte(5) = CByte((dataInt And &HFF000000) \ 16777216) '会溢出
End Sub
Private Sub Timer_STATUS_Tick(sender As Object, e As EventArgs) Handles Timer_STATUS.Tick
If isConnect() Then
PictureBox_CONNECT.Image = My.Resources.PIC_CONNECT
Else
PictureBox_CONNECT.Image = My.Resources.PIC_DISCONNECT
End If
End Sub
Public Function ReadMData(FirstAddr As Integer, iDataNum As Short, ByRef buffer() As Integer) As Integer
Dim SFC, CPUNum As Byte
Dim DataNum As Short
Dim Adr As Integer
Dim rc As Integer
Dim iDelay As Integer
m_rLen = 0
SFC = &H49 '读取保持寄存器的内容(扩展) '非扩展&H9
CPUNum = 1 '将对象设为CPU1
Adr = FirstAddr '设置起始地址
DataNum = iDataNum * 2 '从起始地址读取10个字
'---- 创建扩展MEMOBUS发送数据 ----
'rc = MkCmdReadData(SFC, CPUNum, Adr, DataNum, Ssbuf)
rc = MkCmdReadData_Laddr(SFC, CPUNum, Adr, DataNum, Ssbuf)
SendMsg(Ssbuf)
Ssbuf = ""
iDelay = GetTickCount
While (Math.Abs(GetTickCount - iDelay) <= 30)
If m_rLen > 0 Then
ReDim buffer(iDataNum)
For i = 0 To iDataNum - 1
buffer(i) = m_GetDataL(i)
Next
rc = m_rLen
m_rLen = 0
Exit While
End If
End While
Return rc
End Function
Public Function WriteMData(FirstAddr As Integer, iDataNum As Short, buffer() As Integer) As Short
Dim SFC, CPUNum As Byte
Dim DataNum As Short
Dim Adr As Integer
Dim rc As Short
SFC = &H4B '写入保持寄存器的内容(扩展)
CPUNum = 1 '将对象设为CPU1
Adr = FirstAddr '将起始地址设为MW00000
DataNum = iDataNum '从起始地址读取n个双字
'---- 创建扩展MEMOBUS发送数据 ----
'rc = MkCmdSendData(SFC, CPUNum, Adr, DataNum, buffer, Ssbuf)
rc = MkCmdSendData_LAddr(SFC, CPUNum, Adr, DataNum, buffer, Ssbuf)
SendMsg(Ssbuf)
Ssbuf = ""
Return rc
End Function
End Class
小贴士
感谢您为本站写下的评论，您的评论对其它用户来说具有重要的参考价值，所以请认真填写。
- 类似“顶”、“沙发”之类没有营养的文字，对勤劳贡献的楼主来说是令人沮丧的反馈信息。
- 相信您也不想看到一排文字/表情墙，所以请不要反馈意义不大的重复字符，也请尽量不要纯表情的回复。
- 提问之前请再仔细看一遍楼主的说明，或许是您遗漏了。
- 请勿到处挖坑绊人、招贴广告。既占空间让人厌烦，又没人会搭理，于人于己都无利。
关于好例子网
本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享，对搜索内容的合法性不具有预见性、识别性、控制性，仅供学习研究，请务必在下载后24小时内给予删除，不得用于其他任何用途，否则后果自负。基于互联网的特殊性，平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查；无论平台是否已进行审查，用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场，基于网友分享，根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定，若资源存在侵权或相关问题请联系本站客服人员，点此联系我们。关于更多版权及免责申明参见 版权及免责申明
网友评论
我要评论