How to send and receive data from a server using VBA and Winsock

[nectorprime]

Hi Experts

I have been trying very hard to see if the VBA Code below can work, that is sending and receiving data in MS Access using VBA/Winsock via TCP/IP but to no luck. I assemble the code below using using VBA code I got on this site, that both the Winsock library and the functions for starting Winsock.

(1) I able to ping the remote server with no problem

Could it be I'm making a mistake by calling the code from the MS Access form as follows:

Starting Winsock

Call Main

Sending Data
Dim lngStatus As Long
Dim strData As String * 10240

' Send the data packet and check for error
 lngStatus = send("192.168.0.33,8888", strData, Len(strData), 0)

'```
Read maximum of bytes from serial port.
lngStatus = recv("192.168.1.33,8888", strData, Len(strData), 0)

**Main VBA Library being used here**

`Option Compare Database
Option Explicit

Public Const AF_INET = 2
Public Const FD_SETSIZE = 64
Public Const INADDR_ANY = 0
Public Const SOCK_STREAM = 1
Public Const SOL_SOCKET = 65535
Public Const SO_RCVTIMEO = &H1006
Public Const WSADESCRIPTION_LEN = 256
Public Const WSASYS_STATUS_LEN = 128
Public Const WSADESCRIPTION_LEN_ARRAY = WSADESCRIPTION_LEN + 1
Public Const WSASYS_STATUS_LEN_ARRAY = WSASYS_STATUS_LEN + 1

Type WSADATA ' {
     wVersion       As Integer
     wHighVersion   As Integer
     szDescription  As String * WSADESCRIPTION_LEN_ARRAY
     szSystemStatus As String * WSASYS_STATUS_LEN_ARRAY
     iMaxSockets    As Integer
     iMaxUdpDg      As Integer
     lpVendorInfo   As String
End Type ' }

Type IN_ADDR ' {
     s_addr         As Long
End Type ' }

Type fd_set ' {
     fd_count             As Integer
     fd_array(FD_SETSIZE) As Long
End Type ' }

Type timeval ' {
     tv_sec         As Long
     tv_usec        As Long
End Type ' }

Type sockaddr ' {
     sa_family      As Integer
     sa_data        As String * 14
End Type ' }

Type sockaddr_in ' {
     sin_family     As Integer
     sin_port       As Integer
     sin_addr       As IN_ADDR
     sin_zero       As String * 8
End Type ' }

' {
Public Declare PtrSafe Function WSAStartup Lib "wsock32.dll" (ByVal versionRequired As Long, wsa As WSADATA) As Long
Public Declare PtrSafe Function WSAGetLastError Lib "wsock32.dll" () As Long
Public Declare PtrSafe Function WSACleanup Lib "wsock32.dll" () As Long
Public Declare PtrSafe Function socket Lib "wsock32.dll" (ByVal addressFamily As Long, ByVal socketType As Long, ByVal protocol As Long) As Long
Public Declare PtrSafe Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
Public Declare PtrSafe Function bind Lib "wsock32.dll" (ByVal socket As Long, name As sockaddr_in, ByVal nameLength As Integer) As Long
Public Declare PtrSafe Function listen Lib "wsock32.dll" (ByVal socket As Long, ByVal backlog As Integer) As Long
Public Declare PtrSafe Function select_ Lib "wsock32.dll" Alias "select" (ByVal nfds As Integer, readfds As fd_set, writefds As fd_set, exceptfds As fd_set, timeOut As timeval) As Integer
Public Declare PtrSafe Function accept Lib "wsock32.dll" (ByVal socket As Long, clientAddress As sockaddr, clientAddressLength As Integer) As Long
Public Declare PtrSafe Function setsockopt Lib "wsock32.dll" (ByVal socket As Long, ByVal level As Long, ByVal optname As Long, ByRef optval As Long, ByVal optlen As Integer) As Long
Public Declare PtrSafe Function send Lib "wsock32.dll" (ByVal socket As Long, buffer As String, ByVal bufferLength As Long, ByVal flags As Long) As Long
Public Declare PtrSafe Function recv Lib "wsock32.dll" (ByVal socket As Long, ByVal buffer As String, ByVal bufferLength As Long, ByVal flags As Long) As Long
Public Declare PtrSafe Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
' }

Public Sub FD_ZERO(ByRef s As fd_set) ' {
    s.fd_count = 0
End Sub ' }

Sub FD_SET_(ByVal fd As Long, ByRef s As fd_set) ' {
    Dim i As Integer
    i = 0

    Do While i < s.fd_count
        If s.fd_array(i) = fd Then
            Exit Do
        End If

        i = i + 1
    Loop

    If i = s.fd_count Then
        If s.fd_count < FD_SETSIZE Then
            s.fd_array(i) = fd
            s.fd_count = s.fd_count + 1
        End If
    End If

End Sub ' }
'
'  https://github.com/michaelneu/webxcel was very helpful
'

Sub main() ' {

    If Not initWinsock Then
       MsgBox "Could not initialize Winsock"
    End If

    Debug.Print "winsock initialized"

    Dim serverSocket As Long
    serverSocket = createServerSocket(8888)

    acceptConnections serverSocket

    closesocket serverSocket
    WSACleanup

End Sub ' }

Function createServerSocket(ByVal port As Long) ' {

    createServerSocket = socket(AF_INET, SOCK_STREAM, 0)

    Dim endPoint As sockaddr_in
    endPoint.sin_family = AF_INET
    endPoint.sin_addr.s_addr = INADDR_ANY
    endPoint.sin_port = htons(port)

'   debug.print "lenB: " & lenB(endPoint)

    Dim rc As Long
    rc = bind(createServerSocket, endPoint, 16)
    If rc <> 0 Then
       MsgBox "Could not bind, error = " & WSAGetLastError()
       Exit Function
    End If

    rc = listen(createServerSocket, 10) ' 10 = backlog
    If rc <> 0 Then
       MsgBox "Could not listen"
    End If

End Function ' }

Sub acceptConnections(serverSocket As Long) ' {

    Dim clientSocket As Long

    Dim i As Long
    i = 0

    Do While i < 200
       i = i + 1
       Sleep 100
       Debug.Print "i = " & i

       clientSocket = getClientSocket(serverSocket)

       If clientSocket = 0 Then
          GoTo SKIP_THIS_ITERATION
       End If

       Dim reqText As String
       reqText = getStringFromSocket(clientSocket)

       Dim textResponse As String
       textResponse = "HTTP/1.1 200 OK" & Chr(10)
       textResponse = textResponse & "Content-Type: text/html" & Chr(10)
       textResponse = textResponse & Chr(10)
       textResponse = textResponse & "<!doctype html>" & Chr(10)
       textResponse = textResponse & "<html><body>Request was:<br><code><pre>"
       textResponse = textResponse & reqText
       textResponse = textResponse & "</pre></code></body></html>"

       send clientSocket, ByVal textResponse, Len(textResponse), 0

       closesocket clientSocket

SKIP_THIS_ITERATION:
    Loop

End Sub ' }

Function getClientSocket(serverSocket As Long) As Long ' {
    Dim fdSet As fd_set
    Dim emptyFdSet As fd_set
    Dim rc         As Integer

    FD_ZERO fdSet
    FD_SET_ serverSocket, fdSet

    Dim timeOutMs As Long
    timeOutMs = 500

    Dim timeOut  As timeval
    timeOut.tv_sec = timeOutMs / 1000
    timeOut.tv_usec = timeOutMs Mod 1000

    rc = select_(serverSocket, fdSet, emptyFdSet, emptyFdSet, timeOut)
    If rc = 0 Then
       getClientSocket = 0
       Exit Function
    End If

    Dim socketAddress As sockaddr
    getClientSocket = accept(serverSocket, socketAddress, 16)

    If getClientSocket = -1 Then
       getClientSocket = 0
       Exit Function
    End If

    rc = setsockopt(getClientSocket, SOL_SOCKET, SO_RCVTIMEO, timeOutMs, 4)

End Function ' }

Function getStringFromSocket(s As Long) ' {
    Dim message   As String
    Dim buffer    As String * 1024
    Dim readBytes As Long

    message = ""

    Do
        buffer = ""
        readBytes = recv(s, buffer, Len(buffer), 0)

        If readBytes > 0 Then
           message = message & Trim(buffer)
        End If
    Loop While readBytes > 0

    getStringFromSocket = Trim(message)

End Function ' }

Function initWinsock() As Boolean ' {

    Dim wsaVersion As Long
        wsaVersion = 257


    Dim rc  As Long
    Dim wsa As WSADATA

    rc = WSAStartup(wsaVersion, wsa)

    If rc <> 0 Then
       initWinsock = False
       Exit Function
    End If

    initWinsock = True

End Function ' }`