[网络协议]Modbus TCP Excel VBA测试

最近正在研究用Excel VBA实现 modbus TCP取数据的功能，先是尝试用OSWINSCK控件的方式，之后又尝试了WindowsAPI尝数的方法。最后试下来用通过调用ws2_32.dll API函数的方法成功了，大体的过程如下：

1. oswinsck控件方法。
   访问 http://ostrosoft.com/oswinsck.aspx 主页，非商业用途的话是免费使用的，有下载zip包的向导。我的测试平台是win10 64bit 企业版 10.0.19042 Build 19042,VBA Retail7.1 1108 ,下载exe文件后运行安装，在安装目录下有个文件夹：C:\Program Files (x86)\OSWINSCK ， 里面是各种Demo程序，解压VBA的那个例子试着做了一个，代码也是借鉴了高人的。通过 Tools -> references 添加了 "OstroSoft Winsock Compent"的引用。

Option Explicit
Dim wsTCP As OSWINSCK.Winsock


'This example uses OstroSoft Winsock Component
'http://www.ostrosoft.com/oswinsck.asp

Private Sub CommandButton1_Click() ' Retrieve Data
On Error GoTo ErrHandler
  Dim sServer As String
  Dim nPort As Long
  Dim StartTime
  Dim Test As Excel.Application
'  Dim wsTCP As OSWINSCK.Winsock
  
 
  DoEvents
  nPort = 1100 ' See configuration in Do-More Designer
  ' Set the IP address of the PLC
'  sServer = Sheets("Sheet1").Range("B4").Value '"192.168.1.3"
  sServer = "10.107.242.118"
  RetrieveData = 1
  CommandButton1.BackColor = "&H0000FF00" ' Set colour to Green"

'Check to see if the object has been created. If not set wsTCP.
If SetObject = "" Then
Set wsTCP = CreateObject("OSWINSCK.Winsock")

wsTCP.Protocol = sckTCPProtocol
SetObject = 1
  End If

' Check the state of the TCP connection
'0 sckClosed connection closed
'1 sckOpen open
'2 sckListening listening for incoming connections
'3 sckConnectionPending connection pending
'4 sckResolvingHost resolving remote host name
'5 sckHostResolved remote host name successfully resolved
'6 sckConnecting connecting to remote host
'7 sckConnected connected to remote host
'8 sckClosing Connection Is closing
'9 sckError error occured

' If TCP is not connected, try to connect again.
If wsTCP.State <> 7 Then
    If (wsTCP.State <> sckClosed) Then
      wsTCP.CloseWinsock
    End If
    ' Open the connection
    wsTCP.Connect sServer, nPort
    StartTime = Timer ' Use the timer to determine if a connection cannot be made
    Do While ((Timer < StartTime + 2) And (wsTCP.State <> 7))
        DoEvents
    Loop
    If (wsTCP.State = 7) Then
    Else
       Exit Sub
    End If
End If

' If we are connected then request the information.
If (wsTCP.State = 7) Then
    MbusQuery = Chr(0) + Chr(1) + Chr(0) + Chr(0) + Chr(0) + Chr(6) + Chr(1) + Chr(3) + Chr(0) + Chr(1) + Chr(0) + Chr(10)
    wsTCP.SendData MbusQuery 'Send out the Modbus Information
   
End If
  Exit Sub

ErrHandler:
  MsgBox "Error " & Err.number & ": " & Err.Description
End Sub

开始调试，遗憾的是折腾了2天也没有搞明白在创建对象时出的那“没有注册类”的错误如何消除。参考网上的建议用 regsvr32 重新注册dll文件也不行，在syswow64下注册也不行，没办法走不通先暂时放下了。

2. Windows API 方法（ws2_32.dll)
https://sourceforge.net/projects/vba-modbus/ 由此网站上看到有前辈准备了一个模块文件，下载下来添加到项目里进行测试。需要注意的是在64位系统里需要在调用动态链接库声明里加上"PtrSafe"这个关键字，不然程序会报错。
Public Declare PtrSafe Function WSAStartup Lib “ws2_32.dll” (ByVal wVersionRequested As Integer, ByRef lpWSAData As WSADATA) As Long
原作者的注释用的是法语，找了一个在线翻译的网站帮忙，由于在此之前没有深入研究套接字原理，所以也只就尝试着运行一下。
先改Slave端口为自己的1100，读了一个保持寄存器有了返回值，说明测试通过了，还没来得急更深入的研究拿出来跟大家一起学习一下。
代码中提到了一个网站建议有时间看一下。http://www.simplymodbus.ca/TCP.htm
感谢前辈的肩膀，部份代码贴出来从大家参考。

 
 ' *************************
Public Declare PtrSafe Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequested As Integer, ByRef lpWSAData As WSADATA) As Long
Public Declare PtrSafe Function WSACleanup Lib "ws2_32.dll" () As Long
Public Declare PtrSafe Function socket Lib "ws2_32.dll" (ByVal AddressFamily As Long, ByVal SocketType As Long, ByVal Protocol As Long) As Long
Public Declare PtrSafe Function closesocket Lib "ws2_32.dll" (ByVal hSocket As Long) As Long
Public Declare PtrSafe Function Connect Lib "ws2_32.dll" Alias "connect" (ByVal hSocket As Long, ByRef Name As SOCKADDR, ByVal NameLen As Long) As Long
Public Declare PtrSafe Function gethostbyname Lib "ws2_32.dll" (ByVal Name As String) As Long
Public Declare PtrSafe Function inet_addr Lib "ws2_32.dll" (ByVal IpAddress As String) As Long
Public Declare PtrSafe Function send Lib "ws2_32.dll" (ByVal hSocket As Long, ByRef buffer As Any, ByVal BufferLength As Long, ByVal Flags As Long) As Long
Public Declare PtrSafe Function sendstr Lib "ws2_32.dll" Alias "send" (ByVal hSocket As Long, ByVal buffer As String, ByVal BufferLength As Long, ByVal Flags As Long) As Long
Public Declare PtrSafe Function recv Lib "ws2_32.dll" (ByVal hSocket As Long, ByRef buffer As Any, ByVal BufferLength As Long, ByVal Flags As Long) As Long
Public Declare PtrSafe Function recvstr Lib "ws2_32.dll" Alias "recv" (ByVal hSocket As Long, ByVal buffer As String, ByVal BufferLength As Long, ByVal Flags As Long) As Long


Public Const AF_INET = 2
Public Const SOCK_STREAM = 1
Public Const IPPROTO_TCP = 6

Public Type WSADATA
 wVersion       As Integer
 wHighVersion   As Integer
 szDescription  As String * 256
 szSystemStatus As String * 128
 iMaxSockets    As Integer
 iMaxUdpDg      As Integer
 lpVendorInfo   As Long
End Type

Public Type HOSTENT
 hName     As Long
 hAliases  As Long
 hAddrType As Integer
 hLength   As Integer
 hAddrList As Long
End Type

Private Type SOCKADDR
 sin_family As Integer
 sin_port(1 To 2) As Byte ' _ short
 sin_addr   As Long       'structure IN_ADDR
 sin_zero   As String * 7
End Type



' (FC = 03)
' To read% MW. The most useful in fact.
Function MdbGetHoldingRegister(ByVal server As String, ByVal slave As Byte, ByVal register As Long)
MdbGetRegister = "Fail"
Dim lsock As Long
Dim lret As Long
register = register And &HFFFF

'MdbConnect(ByVal server As String, ByRef lret As Long, ByRef lsock As Long)
lret = MdbConnect(server, lsock)

If lret = 0 And lsock <> -1 Then
    Dim trame As String
    trame = mdbTrameHeader + Chr(slave) ' Slave number
    trame = trame + Chr(3) ' code fonction (3 = Reading a word)
    trame = trame + Chr(register \ 256) + Chr(register Mod 256) ' Address to read
    trame = trame + Chr(0) + Chr(1) ' Number of values to be received

    If sendstr(lsock, trame, Len(trame), 0) Then
        ' Collection of data
       Dim lrec As Long
       Dim Tab_reception(256) As Byte
       Dim lDoEvenets

       lDoEvenets = DoEvents
       lrec = recv(lsock, Tab_reception(0), 256, 0)
       
       For i = 1 To lrec:
       
        Debug.Print "Received " + Str(i), Tab_reception(i)
       
       Next
       '
       ' Normally, we receive the headers.
       ' 0x01 0x00 0x00 0x00
       'Then a byte that gives the "useful" length of the frame
       'Then in this frame we have
       ' 0xXX : Slave
       ' 0xXX : Code
       ' 0x02 : pourquoi ?
       ' 0xXXYY : The value of the register (signed INT for VBA who does not know the unsigned)
       'And 0s to complete if we had sent? a longer frame (which is actually the case).
           'The weave received is normally the same size as the one sent
       '
       


       If lrec > 0 Then
            'MsgBox ("recu " & lrec & " trucs")
            'Dim recu As String
            'recu = ""
            'For i = 1 To lrec
            '  recu = recu & Hex(Tab_reception(i)) & " "
            'Next
            'MsgBox recu
           
        If Tab_reception(lrec - 2) < 128 Then
           MdbGetHoldingRegister = Tab_reception(lrec - 2) * 256 + Tab_reception(lrec - 1)
           
           Else
           
           MdbGetHoldingRegister = &H0 + ((Not Tab_reception(lrec - 2)) * 256) + Not Tab_reception(lrec - 1)
           MdbGetHoldingRegister = (Not MdbGetHoldingRegister) And &HFFFF
            
        End If
        Else
            MsgBox ("Nothing received.")
       End If

    End If
    
    MdbDisconnect (lsock)
           

End If

End Function



'Internal functions to not write too much 12 times the same thing
Function MdbConnect(ByVal server As String, ByRef lsock As Long)

Dim lData As WSADATA
Dim lname As SOCKADDR

MdbConnect = -1

' Winsock initialization
If WSAStartup(257, lData) = 0 Then
   ' Creation of a socket
   lsock = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
   If lsock <> -1 Then
 
        ' Connection to socket
        lname.sin_family = AF_INET
        lname.sin_port(1) = 1100 \ 256
        lname.sin_port(2) = 1100 Mod 256
        lname.sin_addr = inet_addr(server)
 
        MdbConnect = Connect(lsock, lname, LenB(lname))
        'MdbConnect = lret
        If MdbConnect <> 0 Then
            MsgBox (server & " Misson connection !")
            closesocket lsock
            WSACleanup
        End If
        Else
            MsgBox ("Screw up socket opening")
            WSACleanup
        
    End If

End If



End Function

'
Function MdbDisconnect(ByRef lsock As Long)
    closesocket lsock
    WSACleanup
End Function

'
Public Function mdbTrameHeader() As String
    ' Apparently, we have to start the plot with this magic thing.
    ' http://www.simplymodbus.ca/TCP.htm
    
    mdbTrameHeader = Chr(0) + Chr(1) + Chr(0) + Chr(0) + Chr(0) + Chr(6)
End Function