VBA with WinSock2: send() sends wrong data

Question

I'm trying to use WinSock2 in VBA to send (and later on, receive) data from a localhost TCP Stream.

For now, I've mostly been trying to replicate the client sample from here,https://msdn.microsoft.com/en-us/library/windows/desktop/ms738630(v=vs.85).aspx

My code "almost" works; I can create a socket & establish a connection to my server. Sending data (e.g. invoking the send() function of ws2_32.dll) is odd, though..

In the example below, the server would indeed receive a byte array of length 10, but its contents are odd. The first 4 bytes of the array are set (but vary with each call), the last 6 bytes are always 0.

I'm not really sure what's going on; given I run this in 32bit Excel = pointers would be 4 bytes long, it almost seems a bit like only the address of some variable is being sent.

When I try to call this function passing an explicit address of the data (the SendWithPtr() call that is commented out), same issue occurs, so that doesn't help either.

Does anyone know what's going on there? Do I need to call the send() function different in any way?!

Thanks

---

VBA Code:

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

Server code, just for reference:

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();
        }
    }
}
}

Answer 1

 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)

Answer 2

 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)

Answer 3

You need to pass the address of the data within the array - i.e. the address of the first element (because the address of the variable itself is the address of the enclosing SAFEARRAY)

• Change the send argument to ByRef buf As Any

• Pass in the address of the first array element:

  RetVal = Send(m_ConnSocket, SendBuf(0), buflen, 0)