VBA - Sockets - Ruby - Java - Interop Nirvana with Sockets!

I hope you have noticed that inter-operability features large on this blog. Interop is easy with C# because it has an excellent COM interop library. Python and other languages also have COM APIs (not always as comprehensive as C#). But Java and Ruby do not have COM APIs callable from VBA. But this month we have shown that it is possible to use Sockets to connect with other processes (in the demos on the same machine but in real life potentially on remote machines). Thus, using sockets Excel VBA call anything, literally anything (so long the target langauge has a sockets API).

In the previous two articles I wrote sockets servers in Ruby then Java which ran simple calculations. They were just warm-up and test-beds to be honest. What I really wanted to show was VBA calling Ruby and Java.

So in the code below if you run the procedure TestWS2SendAndReceive() at line 159 then you can see the code will attempt to call the Java and Ruby servers, make sure you have these running. If all works then you should get output in the Immediate window

1+3 = 4.0
6*7 = 42.0

modVBASocketsClient Standard Module

1. Option Explicit
2.  
3. Option Private Module
4.  
5.  
6. 'reference Windows Sockets 2 - Windows applications _ Microsoft Docs
7. 'http://msdn.microsoft.com/en-us/library/windows/desktop/ms740673(v=vs.85).aspx
8. Private Const INVALID_SOCKET = -1
9. Private Const WSADESCRIPTION_LEN = 256
10. Private Const SOCKET_ERROR As Long = -1 'const #define SOCKET_ERROR            (-1)
11.  
12. Private Enum AF
13.     AF_UNSPEC = 0
14.     AF_INET = 2
15.     AF_IPX = 6
16.     AF_APPLETALK = 16
17.     AF_NETBIOS = 17
18.     AF_INET6 = 23
19.     AF_IRDA = 26
20.     AF_BTH = 32
21. End Enum
22.  
23. Private Enum sock_type
24.     SOCK_STREAM = 1
25.     SOCK_DGRAM = 2
26.     SOCK_RAW = 3
27.     SOCK_RDM = 4
28.     SOCK_SEQPACKET = 5
29. End Enum
30.  
31. Private Enum Protocol
32.     IPPROTO_ICMP = 1
33.     IPPROTO_IGMP = 2
34.     BTHPROTO_RFCOMM = 3
35.     IPPROTO_TCP = 6
36.     IPPROTO_UDP = 17
37.     IPPROTO_ICMPV6 = 58
38.     IPPROTO_RM = 113
39. End Enum
40.  
41. 'Private Type sockaddr
42. '    sa_family As Integer
43. '    sa_data(0 To 13) As Byte
44. 'End Type
45.  
46. Private Type sockaddr_in
47.     sin_family As Integer
48.     sin_port(0 To 1) As Byte
49.     sin_addr(0 To 3) As Byte
50.     sin_zero(0 To 7) As Byte
51. End Type
52.  
53.  
54. 'typedef UINT_PTR        SOCKET;
55. Private Type udtSOCKET
56.     pointer As Long
57. End Type
58.  
59.  
60.  
61. ' typedef struct WSAData {
62. '  WORD           wVersion;
63. '  WORD           wHighVersion;
64. '  char           szDescription[WSADESCRIPTION_LEN+1];
65. '  char           szSystemStatus[WSASYS_STATUS_LEN+1];
66. '  unsigned short iMaxSockets;
67. '  unsigned short iMaxUdpDg;
68. '  char FAR       *lpVendorInfo;
69. '} WSADATA, *LPWSADATA;
70.  
71. Private Type udtWSADATA
72.     wVersion As Integer
73.     wHighVersion As Integer
74.     szDescription(0 To WSADESCRIPTION_LEN) As Byte
75.     szSystemStatus(0 To WSADESCRIPTION_LEN) As Byte
76.     iMaxSockets As Integer
77.     iMaxUdpDg As Integer
78.     lpVendorInfo As Long
79. End Type
80.  
81. 'int errorno = WSAGetLastError()
82. Private Declare Function WSAGetLastError Lib "Ws2_32" () As Integer
83.  
84. '   int WSAStartup(
85. '  __in   WORD wVersionRequested,
86. '  __out  LPWSADATA lpWSAData
87. ');
88. Private Declare Function WSAStartup Lib "Ws2_32" _
89.     (ByVal wVersionRequested As Integer, ByRef lpWSAData As udtWSADATA) As Long 'winsockErrorCodes2
90.  
91.  
92. '    SOCKET WSAAPI socket(
93. '  __in  int af,
94. '  __in  int type,
95. '  __in  int protocol
96. ');
97.  
98. Private Declare Function ws2_socket Lib "Ws2_32" Alias "socket" _
99.     (ByVal AF As Long, ByVal stype As Long, ByVal Protocol As Long) As LongPtr
100.  
101. Private Declare Function ws2_closesocket Lib "Ws2_32" Alias "closesocket" _
102.     (ByVal socket As Long) As Long
103.  
104. 'int recv(
105. '  SOCKET s,
106. '  char   *buf,
107. '  int    len,
108. '  int    flags
109. ');
110. Private Declare Function ws2_recv Lib "Ws2_32" Alias "recv" _
111.     (ByVal socket As Long, ByVal buf As LongPtr,
112.      ByVal length As Long, ByVal flags As Long) As Long
113.  
114. 'int WSAAPI connect(
115. '  SOCKET         s,
116. '  const sockaddr *name,
117. '  int            namelen
118. ');
119.  
120. Private Declare Function ws2_connect Lib "Ws2_32" Alias "connect" _
121.     (ByVal S As LongPtr, ByRef name As sockaddr_in, ByVal namelen As Long) As Long
122.  
123. 'int WSAAPI send(
124. '  SOCKET     s,
125. '  const char *buf,
126. '  int        len,
127. '  int        flags
128. ');
129. Private Declare Function ws2_send Lib "Ws2_32" Alias "send" _
130.     (ByVal S As LongPtr, ByVal buf As LongPtr, ByVal buflen As Long, ByVal flags As Long) As Long
131.  
132.  
133. Private Declare Function ws2_shutdown Lib "Ws2_32" Alias "shutdown" _
134.         (ByVal S As Long, ByVal how As Long) As Long
135.  
136. Private Declare Sub WSACleanup Lib "Ws2_32" ()
137.  
138. Private Enum eShutdownConstants
139.     SD_RECEIVE = 0  '#define SD_RECEIVE      0x00
140.     SD_SEND = 1     '#define SD_SEND         0x01
141.     SD_BOTH = 2     '#define SD_BOTH         0x02
142. End Enum
143.  
144. Sub TestPortLongToBytes()
145.     'redis is on port number 6379
146.     Dim abytPortAsBytes() As Byte
147.     abytPortAsBytes() = PortLongToBytes(6379)
148.     Debug.Assert abytPortAsBytes(0) = 24
149.     Debug.Assert abytPortAsBytes(1) = 235
150. End Sub
151.  
152. Private Function PortLongToBytes(ByVal lPort As Integer) As Byte()
153.     ReDim abytReturn(0 To 1) As Byte
154.     abytReturn(0) = lPort \ 256
155.     abytReturn(1) = lPort Mod 256
156.     PortLongToBytes = abytReturn()
157. End Function
158.  
159. Private Sub TestWS2SendAndReceive()
160.  
161.     Dim sResponse As String
162.     Const clJavaPort As Long = 6666
163.     Const clRubyPort As Long = 3000
164.     If WS2SendAndReceive(clJavaPort, "1+3" & vbCrLf, sResponse) Then
165.         Debug.Print sResponse
166.     End If
167.     If WS2SendAndReceive(clRubyPort, "6*7" & vbCrLf, sResponse) Then
168.         Debug.Print sResponse
169.     End If
170. End Sub
171.  
172.  
173. Public Function WS2SendAndReceive(ByVal lPort As Long,
174.             ByVal sText As String, ByRef psResponse As String) As Boolean
175.     'https://docs.microsoft.com/en-gb/windows/desktop/api/winsock/nf-winsock-recv
176.     If Right$(sText, 2) <> vbCrLf Then Err.Raise vbObjectError, , "Best suffix your sends with a new line (vbCrLf)"
177.     psResponse = ""
178.     '//----------------------
179.     '// Declare and initialize variables.
180.     Dim iResult As Integer : iResult = 0
181.     Dim wsaData As udtWSADATA
182.  
183.     Dim ConnectSocket As LongPtr
184.  
185.     Dim clientService As sockaddr_in
186.  
187.     Dim sendBuf() As Byte
188.     sendBuf = StrConv(sText, vbFromUnicode)
189.  
190.     Const recvbuflen As Long = 512
191.     Dim recvbuf(0 To recvbuflen - 1) As Byte
192.  
193.     '//----------------------
194.     '// Initialize Winsock
195.     Dim eResult As Long 'winsockErrorCodes2
196.     eResult = WSAStartup(&H202, wsaData)
197.     If eResult <> 0 Then
198.         Debug.Print "WSAStartup failed with error: " & eResult
199.         WS2SendAndReceive = False
200.         GoTo SingleExit
201.     End If
202.  
203.  
204.     '//----------------------
205.     '// Create a SOCKET for connecting to server
206.     ConnectSocket = ws2_socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
207.     If ConnectSocket = INVALID_SOCKET Then
208.         Dim eLastError As Long 'winsockErrorCodes2
209.         eLastError = WSAGetLastError()
210.         Debug.Print "socket failed with error: " & eLastError
211.         Call WSACleanup
212.         WS2SendAndReceive = False
213.         GoTo SingleExit
214.     End If
215.  
216.  
217.     '//----------------------
218.     '// The sockaddr_in structure specifies the address family,
219.     '// IP address, and port of the server to be connected to.
220.     clientService.sin_family = AF_INET
221.  
222.     clientService.sin_addr(0) = 127
223.     clientService.sin_addr(1) = 0
224.     clientService.sin_addr(2) = 0
225.     clientService.sin_addr(3) = 1
226.  
227.     Dim abytPortAsBytes() As Byte
228.     abytPortAsBytes() = PortLongToBytes(lPort)
229.  
230.     clientService.sin_port(1) = 235  '* 6379
231.     clientService.sin_port(0) = 24
232.  
233.     clientService.sin_port(1) = abytPortAsBytes(1)
234.     clientService.sin_port(0) = abytPortAsBytes(0)
235.  
236.     '//----------------------
237.     '// Connect to server.
238.  
239.     iResult = ws2_connect(ConnectSocket, clientService, LenB(clientService))
240.     If (iResult = SOCKET_ERROR) Then
241.  
242.         eLastError = WSAGetLastError()
243.  
244.         Debug.Print "connect failed with error: " & eLastError
245.         Call ws2_closesocket(ConnectSocket)
246.         Call WSACleanup
247.         WS2SendAndReceive = False
248.         GoTo SingleExit
249.     End If
250.  
251.     '//----------------------
252.     '// Send an initial buffer
253.     Dim sendbuflen As Long
254.     sendbuflen = UBound(sendBuf) - LBound(sendBuf) + 1
255.     iResult = ws2_send(ConnectSocket, VarPtr(sendBuf(0)), sendbuflen, 0)
256.     If (iResult = SOCKET_ERROR) Then
257.         eLastError = WSAGetLastError()
258.         Debug.Print "send failed with error: " & eLastError
259.  
260.         Call ws2_closesocket(ConnectSocket)
261.         Call WSACleanup
262.         WS2SendAndReceive = False
263.         GoTo SingleExit
264.     End If
265.  
266.     'Debug.Print "Bytes Sent: ", iResult
267.  
268.     '// shutdown the connection since no more data will be sent
269.     iResult = ws2_shutdown(ConnectSocket, SD_SEND)
270.     If (iResult = SOCKET_ERROR) Then
271.  
272.         eLastError = WSAGetLastError()
273.         Debug.Print "shutdown failed with error: " & eLastError
274.  
275.         Call ws2_closesocket(ConnectSocket)
276.         Call WSACleanup
277.         WS2SendAndReceive = False
278.         GoTo SingleExit
279.     End If
280.  
281.     ' receive only one message (TODO handle when buffer is not large enough)
282.  
283.     iResult = ws2_recv(ConnectSocket, VarPtr(recvbuf(0)), recvbuflen, 0)
284.     If (iResult > 0) Then
285.         'Debug.Print "Bytes received: ", iResult
286.     ElseIf (iResult = 0) Then
287.         Debug.Print "Connection closed"
288.         WS2SendAndReceive = False
289.         Call ws2_closesocket(ConnectSocket)
290.         Call WSACleanup
291.         GoTo SingleExit
292.     Else
293.         eLastError = WSAGetLastError()
294.         Debug.Print "recv failed with error: " & eLastError
295.     End If
296.  
297.     psResponse = Left$(StrConv(recvbuf, vbUnicode), iResult)
298.  
299.     'Debug.Print psResponse
300.  
301.     '// close the socket
302.     iResult = ws2_closesocket(ConnectSocket)
303.     If (iResult = SOCKET_ERROR) Then
304.  
305.         eLastError = WSAGetLastError()
306.         Debug.Print "close failed with error: " & eLastError
307.  
308.         Call WSACleanup
309.         WS2SendAndReceive = False
310.         GoTo SingleExit
311.     End If
312.  
313.     Call WSACleanup
314.     WS2SendAndReceive = True
315.  
316. SingleExit:
317.     Exit Function
318. ErrHand:
319.  
320. End Function