VBA 使用 WinSock2：send() 发送错误数据
VBA with WinSock2: send() sends wrong data
我正在尝试在 VBA 中使用 WinSock2 从本地主机 TCP 流发送（以及稍后接收）数据。
现在，我主要是尝试从这里复制客户端样本，https://msdn.microsoft.com/en-us/library/windows/desktop/ms738630(v=vs.85).aspx
我的代码 "almost" 有效；我可以创建一个套接字并建立到我的服务器的连接。
发送数据（例如调用 ws2_32.dll 的 send() 函数）很奇怪，但是..
在下面的示例中，服务器确实会收到一个长度为 10 的字节数组，但其内容是奇数。数组的前 4 个字节已设置（但每次调用都不同），后 6 个字节始终为 0。
我不太确定发生了什么；假设我 运行 this in 32bit Excel = pointers would be 4 bytes long, it almost seems bit like only some variable address are being sent.
当我尝试调用此函数来传递数据的显式地址时（SendWithPtr() 调用被注释掉），同样的问题发生了，所以这也无济于事。
有人知道那里发生了什么吗？我是否需要以任何方式调用不同的 send() 函数？！
谢谢
VBA代码：
Option Explicit
' Constants ----------------------------------------------------------
Const INVALID_SOCKET = -1
Const WSADESCRIPTION_LEN = 256
Const SOCKET_ERROR = -1
' Typ definitions ----------------------------------------------------
Private Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription(0 To WSADESCRIPTION_LEN) As Byte
szSystemStatus(0 To WSADESCRIPTION_LEN) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type
Private Type ADDRINFO
ai_flags As Long
ai_family As Long
ai_socktype As Long
ai_protocol As Long
ai_addrlen As Long
ai_canonName As LongPtr 'strptr
ai_addr As LongPtr 'p sockaddr
ai_next As LongPtr 'p addrinfo
End Type
' Enums ---------------------------------------------------------------
Enum AF
AF_UNSPEC = 0
AF_INET = 2
AF_IPX = 6
AF_APPLETALK = 16
AF_NETBIOS = 17
AF_INET6 = 23
AF_IRDA = 26
AF_BTH = 32
End Enum
Enum sock_type
SOCK_STREAM = 1
SOCK_DGRAM = 2
SOCK_RAW = 3
SOCK_RDM = 4
SOCK_SEQPACKET = 5
End Enum
' External functions --------------------------------------------------
Public Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequested As Integer, ByRef data As WSADATA) As Long
Public Declare Function connect Lib "ws2_32.dll" (ByVal socket As Long, ByVal SOCKADDR As Long, ByVal namelen As Long) As Long
Public Declare Sub WSACleanup Lib "ws2_32.dll" ()
Private Declare PtrSafe Function GetAddrInfo Lib "ws2_32.dll" Alias "getaddrinfo" (ByVal NodeName As String, ByVal ServName As String, ByVal lpHints As LongPtr, lpResult As LongPtr) As Long
Public Declare Function ws_socket Lib "ws2_32.dll" Alias "socket" (ByVal AF As Long, ByVal stype As Long, ByVal Protocol As Long) As Long
Public Declare Function closesocket Lib "ws2_32.dll" (ByVal socket As Long) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
Public Declare Function Send Lib "ws2_32.dll" Alias "send" (ByVal s As Long, ByRef buf() As Byte, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function SendWithPtr Lib "ws2_32.dll" Alias "send" (ByVal s As Long, ByVal bufPtr As Long, ByVal buflen As Long, ByVal flags As Long) As Long
Private Declare PtrSafe Function WSAGetLastError Lib "ws2_32.dll" () As Long
Private Declare Function VarPtrArray Lib "VBE7" Alias "VarPtr" (var() As Any) As Long
Sub TestWinsock()
Dim m_wsaData As WSADATA
Dim m_RetVal As Integer
Dim m_Hints As ADDRINFO
Dim m_ConnSocket As Long: m_ConnSocket = INVALID_SOCKET
Dim Server As String
Dim port As String
Dim pAddrInfo As LongPtr
Dim RetVal As Long
Dim lastError As Long
RetVal = WSAStartup(MAKEWORD(2, 2), m_wsaData)
If (RetVal <> 0) Then
LogError "WSAStartup failed with error " & RetVal, WSAGetLastError()
Call WSACleanup
Exit Sub
End If
m_Hints.ai_family = AF.AF_UNSPEC
m_Hints.ai_socktype = sock_type.SOCK_STREAM
Server = "localhost"
port = "5001"
RetVal = GetAddrInfo(Server, port, VarPtr(m_Hints), pAddrInfo)
If (RetVal <> 0) Then
LogError "Cannot resolve address " & Server & " and port " & port & ", error " & RetVal, WSAGetLastError()
Call WSACleanup
Exit Sub
End If
m_Hints.ai_next = pAddrInfo
Dim connected As Boolean: connected = False
Do While m_Hints.ai_next > 0
CopyMemory m_Hints, ByVal m_Hints.ai_next, LenB(m_Hints)
m_ConnSocket = ws_socket(m_Hints.ai_family, m_Hints.ai_socktype, m_Hints.ai_protocol)
If (m_ConnSocket = INVALID_SOCKET) Then
LogError "Error opening socket, error " & RetVal
Else
Dim connectionResult As Long
connectionResult = connect(m_ConnSocket, m_Hints.ai_addr, m_Hints.ai_addrlen)
If connectionResult <> SOCKET_ERROR Then
connected = True
Exit Do
End If
LogError "connect() to socket failed"
closesocket (m_ConnSocket)
End If
Loop
If Not connected Then
LogError "Fatal error: unable to connect to the server", WSAGetLastError()
Call WSACleanup
Exit Sub
End If
Dim SendBuf() As Byte
SendBuf = StrConv("Message #1", vbFromUnicode)
Dim buflen As Integer
buflen = UBound(SendBuf) - LBound(SendBuf) + 1
' !!!!!!!!!!!
' !! Send() does not seem to send the right bytes !!
' !!!!!!!!!!!
RetVal = Send(m_ConnSocket, SendBuf, buflen, 0)
' The following does not work either:
' RetVal = SendWithPtr(m_ConnSocket, VarPtrArray(SendBuf), buflen, 0)
If RetVal = SOCKET_ERROR Then
LogError "send() failed", WSAGetLastError()
Call WSACleanup
Exit Sub
Else
Debug.Print "sent " & RetVal & " bytes"
End If
RetVal = closesocket(m_ConnSocket)
If RetVal <> 0 Then
LogError "closesocket() failed", WSAGetLastError()
Call WSACleanup
Else
Debug.Print "closed socket"
End If
End Sub
Public Function MAKEWORD(Lo As Byte, Hi As Byte) As Integer
MAKEWORD = Lo + Hi * 256& Or 32768 * (Hi > 127)
End Function
Private Sub LogError(msg As String, Optional ErrorCode As Long = -1)
If ErrorCode > -1 Then
msg = msg & " (error code " & ErrorCode & ")"
End If
Debug.Print msg
End Sub
服务器代码，仅供参考：
using System;
using System.Net;
using System.Net.Sockets;
using System.Text;
using System.Threading;
namespace Server
{
class Program
{
static void Main(string[] args)
{
var address = Dns.GetHostEntry("localhost").AddressList[0];
var addressBytes = address.GetAddressBytes();
var port = 5001;
var ipEndpoint = new IPEndPoint(address, port);
var listener = new TcpListener(ipEndpoint);
listener.Start();
bool done = false;
TcpClient tcpClient = null;
try
{
while (!done)
{
Thread.Sleep(10);
Console.WriteLine("Waiting for broadcast");
tcpClient = listener.AcceptTcpClient();
byte[] bytes = new byte[10];
NetworkStream stream = tcpClient.GetStream();
var bytesRead = stream.Read(bytes, 0, bytes.Length);
// when called via the VBA sample, "bytes" will contain odd values.
// when called through Microsoft's C++ sample, everything works fine
}
}
finally {
tcpClient?.Close();
}
}
}
}
您需要传递数组内数据的地址 - 即第一个元素的地址（因为变量本身的地址是封闭 SAFEARRAY 的地址）
将 send 参数更改为 ByRef buf As Any
传入第一个数组元素的地址：
RetVal = Send(m_ConnSocket, SendBuf(0), buflen, 0)
Dim arrBuffers(1 To MAX_BUFFER_LENGTH) As Byte
Dim lngBytesReceived As Long
Dim strTempBuffer As String
lngBytesReceived = recv(s1, arrBuffers(1), MAX_BUFFER_LENGTH, 0&)
If lngBytesReceived > 0 Then
'
' If we have received some data, convert it to the Unicode
' string that is suitable for the Visual Basic String data type
'
strTempBuffer = StrConv(arrBuffers, vbUnicode)
'
' Remove unused bytes
'
strBuffer = Left$(strTempBuffer, lngBytesReceived)
Const MAX_BUFFER_LENGTH As Long = 8192
Dim arrBuffers(1 To MAX_BUFFER_LENGTH) As Byte
Dim lngBytesReceived As Long
Dim strTempBuffer As String
lngBytesReceived = recv(s1, arrBuffers(1), MAX_BUFFER_LENGTH, 0&)
strTempBuffer = StrConv(arrBuffers, vbUnicode)
strBuffer = Left$(strTempBuffer, lngBytesReceived)
我正在尝试在 VBA 中使用 WinSock2 从本地主机 TCP 流发送（以及稍后接收）数据。
现在，我主要是尝试从这里复制客户端样本，https://msdn.microsoft.com/en-us/library/windows/desktop/ms738630(v=vs.85).aspx
我的代码 "almost" 有效；我可以创建一个套接字并建立到我的服务器的连接。 发送数据（例如调用 ws2_32.dll 的 send() 函数）很奇怪，但是..
在下面的示例中，服务器确实会收到一个长度为 10 的字节数组，但其内容是奇数。数组的前 4 个字节已设置（但每次调用都不同），后 6 个字节始终为 0。
我不太确定发生了什么；假设我 运行 this in 32bit Excel = pointers would be 4 bytes long, it almost seems bit like only some variable address are being sent.
当我尝试调用此函数来传递数据的显式地址时（SendWithPtr() 调用被注释掉），同样的问题发生了，所以这也无济于事。
有人知道那里发生了什么吗？我是否需要以任何方式调用不同的 send() 函数？！
谢谢
VBA代码：
Option Explicit
' Constants ----------------------------------------------------------
Const INVALID_SOCKET = -1
Const WSADESCRIPTION_LEN = 256
Const SOCKET_ERROR = -1
' Typ definitions ----------------------------------------------------
Private Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription(0 To WSADESCRIPTION_LEN) As Byte
szSystemStatus(0 To WSADESCRIPTION_LEN) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type
Private Type ADDRINFO
ai_flags As Long
ai_family As Long
ai_socktype As Long
ai_protocol As Long
ai_addrlen As Long
ai_canonName As LongPtr 'strptr
ai_addr As LongPtr 'p sockaddr
ai_next As LongPtr 'p addrinfo
End Type
' Enums ---------------------------------------------------------------
Enum AF
AF_UNSPEC = 0
AF_INET = 2
AF_IPX = 6
AF_APPLETALK = 16
AF_NETBIOS = 17
AF_INET6 = 23
AF_IRDA = 26
AF_BTH = 32
End Enum
Enum sock_type
SOCK_STREAM = 1
SOCK_DGRAM = 2
SOCK_RAW = 3
SOCK_RDM = 4
SOCK_SEQPACKET = 5
End Enum
' External functions --------------------------------------------------
Public Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequested As Integer, ByRef data As WSADATA) As Long
Public Declare Function connect Lib "ws2_32.dll" (ByVal socket As Long, ByVal SOCKADDR As Long, ByVal namelen As Long) As Long
Public Declare Sub WSACleanup Lib "ws2_32.dll" ()
Private Declare PtrSafe Function GetAddrInfo Lib "ws2_32.dll" Alias "getaddrinfo" (ByVal NodeName As String, ByVal ServName As String, ByVal lpHints As LongPtr, lpResult As LongPtr) As Long
Public Declare Function ws_socket Lib "ws2_32.dll" Alias "socket" (ByVal AF As Long, ByVal stype As Long, ByVal Protocol As Long) As Long
Public Declare Function closesocket Lib "ws2_32.dll" (ByVal socket As Long) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
Public Declare Function Send Lib "ws2_32.dll" Alias "send" (ByVal s As Long, ByRef buf() As Byte, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function SendWithPtr Lib "ws2_32.dll" Alias "send" (ByVal s As Long, ByVal bufPtr As Long, ByVal buflen As Long, ByVal flags As Long) As Long
Private Declare PtrSafe Function WSAGetLastError Lib "ws2_32.dll" () As Long
Private Declare Function VarPtrArray Lib "VBE7" Alias "VarPtr" (var() As Any) As Long
Sub TestWinsock()
Dim m_wsaData As WSADATA
Dim m_RetVal As Integer
Dim m_Hints As ADDRINFO
Dim m_ConnSocket As Long: m_ConnSocket = INVALID_SOCKET
Dim Server As String
Dim port As String
Dim pAddrInfo As LongPtr
Dim RetVal As Long
Dim lastError As Long
RetVal = WSAStartup(MAKEWORD(2, 2), m_wsaData)
If (RetVal <> 0) Then
LogError "WSAStartup failed with error " & RetVal, WSAGetLastError()
Call WSACleanup
Exit Sub
End If
m_Hints.ai_family = AF.AF_UNSPEC
m_Hints.ai_socktype = sock_type.SOCK_STREAM
Server = "localhost"
port = "5001"
RetVal = GetAddrInfo(Server, port, VarPtr(m_Hints), pAddrInfo)
If (RetVal <> 0) Then
LogError "Cannot resolve address " & Server & " and port " & port & ", error " & RetVal, WSAGetLastError()
Call WSACleanup
Exit Sub
End If
m_Hints.ai_next = pAddrInfo
Dim connected As Boolean: connected = False
Do While m_Hints.ai_next > 0
CopyMemory m_Hints, ByVal m_Hints.ai_next, LenB(m_Hints)
m_ConnSocket = ws_socket(m_Hints.ai_family, m_Hints.ai_socktype, m_Hints.ai_protocol)
If (m_ConnSocket = INVALID_SOCKET) Then
LogError "Error opening socket, error " & RetVal
Else
Dim connectionResult As Long
connectionResult = connect(m_ConnSocket, m_Hints.ai_addr, m_Hints.ai_addrlen)
If connectionResult <> SOCKET_ERROR Then
connected = True
Exit Do
End If
LogError "connect() to socket failed"
closesocket (m_ConnSocket)
End If
Loop
If Not connected Then
LogError "Fatal error: unable to connect to the server", WSAGetLastError()
Call WSACleanup
Exit Sub
End If
Dim SendBuf() As Byte
SendBuf = StrConv("Message #1", vbFromUnicode)
Dim buflen As Integer
buflen = UBound(SendBuf) - LBound(SendBuf) + 1
' !!!!!!!!!!!
' !! Send() does not seem to send the right bytes !!
' !!!!!!!!!!!
RetVal = Send(m_ConnSocket, SendBuf, buflen, 0)
' The following does not work either:
' RetVal = SendWithPtr(m_ConnSocket, VarPtrArray(SendBuf), buflen, 0)
If RetVal = SOCKET_ERROR Then
LogError "send() failed", WSAGetLastError()
Call WSACleanup
Exit Sub
Else
Debug.Print "sent " & RetVal & " bytes"
End If
RetVal = closesocket(m_ConnSocket)
If RetVal <> 0 Then
LogError "closesocket() failed", WSAGetLastError()
Call WSACleanup
Else
Debug.Print "closed socket"
End If
End Sub
Public Function MAKEWORD(Lo As Byte, Hi As Byte) As Integer
MAKEWORD = Lo + Hi * 256& Or 32768 * (Hi > 127)
End Function
Private Sub LogError(msg As String, Optional ErrorCode As Long = -1)
If ErrorCode > -1 Then
msg = msg & " (error code " & ErrorCode & ")"
End If
Debug.Print msg
End Sub
服务器代码，仅供参考：
using System;
using System.Net;
using System.Net.Sockets;
using System.Text;
using System.Threading;
namespace Server
{
class Program
{
static void Main(string[] args)
{
var address = Dns.GetHostEntry("localhost").AddressList[0];
var addressBytes = address.GetAddressBytes();
var port = 5001;
var ipEndpoint = new IPEndPoint(address, port);
var listener = new TcpListener(ipEndpoint);
listener.Start();
bool done = false;
TcpClient tcpClient = null;
try
{
while (!done)
{
Thread.Sleep(10);
Console.WriteLine("Waiting for broadcast");
tcpClient = listener.AcceptTcpClient();
byte[] bytes = new byte[10];
NetworkStream stream = tcpClient.GetStream();
var bytesRead = stream.Read(bytes, 0, bytes.Length);
// when called via the VBA sample, "bytes" will contain odd values.
// when called through Microsoft's C++ sample, everything works fine
}
}
finally {
tcpClient?.Close();
}
}
}
}
您需要传递数组内数据的地址 - 即第一个元素的地址（因为变量本身的地址是封闭 SAFEARRAY 的地址）
将
send参数更改为ByRef buf As Any传入第一个数组元素的地址：
RetVal = Send(m_ConnSocket, SendBuf(0), buflen, 0)
Dim arrBuffers(1 To MAX_BUFFER_LENGTH) As Byte
Dim lngBytesReceived As Long
Dim strTempBuffer As String
lngBytesReceived = recv(s1, arrBuffers(1), MAX_BUFFER_LENGTH, 0&)
If lngBytesReceived > 0 Then
'
' If we have received some data, convert it to the Unicode
' string that is suitable for the Visual Basic String data type
'
strTempBuffer = StrConv(arrBuffers, vbUnicode)
'
' Remove unused bytes
'
strBuffer = Left$(strTempBuffer, lngBytesReceived)
Const MAX_BUFFER_LENGTH As Long = 8192
Dim arrBuffers(1 To MAX_BUFFER_LENGTH) As Byte
Dim lngBytesReceived As Long
Dim strTempBuffer As String
lngBytesReceived = recv(s1, arrBuffers(1), MAX_BUFFER_LENGTH, 0&)
strTempBuffer = StrConv(arrBuffers, vbUnicode)
strBuffer = Left$(strTempBuffer, lngBytesReceived)