The Excel Development Platform: VBA - Redis - Sockets - Low level TCP/IP code to interop with Redis

Monday 7 January 2019

VBA - Redis - Sockets - Low level TCP/IP code to interop with Redis

I'm going to show you some low level TCP/IP code to interoperate with Redis which is an open-source in-memory key-value store. Redis is a often used as a database cache to make cloud based applications more scalable by relieving the load on a relational database. I will give both C++ and VBA code that call a group of Win-32 Api functions known as Windows Sockets2 or Winsock.

Click here for separate Youtube window

This post follows on from the previous post where I detailed (both in text and video) ...

How to install Redis
How to get some data into and out of Redis using the command line tool, redis-cli
How to call Redis from a VB.NET console application
How to call Redis from VBA via a VB.Net COM Dll Interop Assembly

This post shows a solution that skips the .NET component and instead scripts directly against the Windows Sockets 2 Api.

Background to Sockets - TCP/IP

Redis does not have an HTTP interface and so we have to drop down a few layers and program Sockets. If you are new to Sockets then here is a little explanation. When I say drop down a few layers, the diagram below is very useful. It illustrates the OSI model. When dealing with HTTP we deal with the top layer of the OSI model, the Application layer or layer 7. Programming sockets means programming the Transport layer or layer 4 of the OSI model. If you program a lower layer then you can expect the code to be more complicated (unless of course you are given a high level abstraction like .NET framework does).

Forewarned of the increased complexity let's look at some sample code.

Starting with C++

So Windows API functions (except .NET platform) are 99% designed to be used by C++ developers. Typically when reading a Windows API documentation page the sample code will be given in C++. It is a useful skill therefore to be able to get the C++ sample up running so that you can step through and understand the code. You are best trying to run a sample from the most recently updated documentation page. Any compile errors can be googled and, of course, stackoverflow.com is your friend.

The C++ sample I began with was the recv defined in winsock.h and housed in ws2_32.dll.

Sometimes you need to disable warnings so in the sample code for the recv function I needed to added the following line at the top

#pragma warning(disable:4996)   //https://stackoverflow.com/questions/36683785/inet-addr-use-inet-pton-or-inetpton-instead-or-define-winsock-deprecated/47397620

Here is the full C++ code for pasting into a Win32 C++ Console program

// Win32CppWinSockets2Play.cpp : This file contains the 'main' function. Program execution begins and ends there.
//
#include "pch.h"
#include <iostream>
#include <winsock2.h>
#include <Ws2tcpip.h>
#include <stdio.h>
// Link with ws2_32.lib
#pragma comment(lib, "Ws2_32.lib")
#define DEFAULT_BUFLEN 512
#define DEFAULT_PORT 6379
//#define _WINSOCK_DEPRECATED_NO_WARNINGS
#pragma warning(disable:4996) //https://stackoverflow.com/questions/36683785/inet-addr-use-inet-pton-or-inetpton-instead-or-define-winsock-deprecated/47397620
int main()
{
//----------------------
// Declare and initialize variables.
int iResult;
WSADATA wsaData;
SOCKET ConnectSocket = INVALID_SOCKET;
struct sockaddr_in clientService;
int recvbuflen = DEFAULT_BUFLEN;
char *sendbuf = (char *)"keys *\r\n";
char recvbuf[DEFAULT_BUFLEN] = "";
//----------------------
// Initialize Winsock
iResult = WSAStartup(MAKEWORD(2, 2), &wsaData);
if (iResult != NO_ERROR) {
wprintf(L"WSAStartup failed with error: %d\n", iResult);
return 1;
}
//----------------------
// Create a SOCKET for connecting to server
ConnectSocket = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
if (ConnectSocket == INVALID_SOCKET) {
wprintf(L"socket failed with error: %ld\n", WSAGetLastError());
WSACleanup();
return 1;
}
//----------------------
// The sockaddr_in structure specifies the address family,
// IP address, and port of the server to be connected to.
clientService.sin_family = AF_INET;
clientService.sin_addr.s_addr = inet_addr("127.0.0.1");
clientService.sin_port = htons(DEFAULT_PORT);
//----------------------
// Connect to server.
iResult = connect(ConnectSocket, (SOCKADDR*)&clientService, sizeof(clientService));
if (iResult == SOCKET_ERROR) {
wprintf(L"connect failed with error: %d\n", WSAGetLastError());
closesocket(ConnectSocket);
WSACleanup();
return 1;
}
//----------------------
// Send an initial buffer
iResult = send(ConnectSocket, sendbuf, (int)strlen(sendbuf), 0);
if (iResult == SOCKET_ERROR) {
wprintf(L"send failed with error: %d\n", WSAGetLastError());
closesocket(ConnectSocket);
WSACleanup();
return 1;
}
printf("Bytes Sent: %d\n", iResult);
// shutdown the connection since no more data will be sent
iResult = shutdown(ConnectSocket, SD_SEND);
if (iResult == SOCKET_ERROR) {
wprintf(L"shutdown failed with error: %d\n", WSAGetLastError());
closesocket(ConnectSocket);
WSACleanup();
return 1;
}
// Receive until the peer closes the connection
do {
iResult = recv(ConnectSocket, recvbuf, recvbuflen, 0);
if (iResult > 0)
wprintf(L"Bytes received: %d\n", iResult);
else if (iResult == 0)
wprintf(L"Connection closed\n");
else
wprintf(L"recv failed with error: %d\n", WSAGetLastError());
} while (iResult > 0);
// close the socket
iResult = closesocket(ConnectSocket);
if (iResult == SOCKET_ERROR) {
wprintf(L"close failed with error: %d\n", WSAGetLastError());
WSACleanup();
return 1;
}
WSACleanup();
return 0;
std::cout << "Hello World!\n";
}
// Run program: Ctrl + F5 or Debug > Start Without Debugging menu
// Debug program: F5 or Debug > Start Debugging menu
// Tips for Getting Started:
// 1. Use the Solution Explorer window to add/manage files
// 2. Use the Team Explorer window to connect to source control
// 3. Use the Output window to see build output and other messages
// 4. Use the Error List window to view errors
// 5. Go to Project > Add New Item to create new code files, or Project > Add Existing Item to add existing code files to the project
// 6. In the future, to open this project again, go to File > Open > Project and select the .sln file

Transcribing from C++ to VBA

So Windows API functions are 99.9% designed to be used by C++ developers. VBA Developers must find function declarations with compatible signatures that match. for this Google is your friend but after a while one can get familiar with passing pointers by using VarPtr, StrPtr and ObjPtr.

Option Explicit
Option Private Module
'reference Windows Sockets 2 - Windows applications _ Microsoft Docs
'http://msdn.microsoft.com/en-us/library/windows/desktop/ms740673(v=vs.85).aspx
Private Const INVALID_SOCKET = -1
Private Const WSADESCRIPTION_LEN = 256
Private Const SOCKET_ERROR As Long = -1 'const #define SOCKET_ERROR (-1)
Private 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
Private Enum sock_type
SOCK_STREAM = 1
SOCK_DGRAM = 2
SOCK_RAW = 3
SOCK_RDM = 4
SOCK_SEQPACKET = 5
End Enum
Private Enum Protocol
IPPROTO_ICMP = 1
IPPROTO_IGMP = 2
BTHPROTO_RFCOMM = 3
IPPROTO_TCP = 6
IPPROTO_UDP = 17
IPPROTO_ICMPV6 = 58
IPPROTO_RM = 113
End Enum
'Private Type sockaddr
' sa_family As Integer
' sa_data(0 To 13) As Byte
'End Type
Private Type sockaddr_in
sin_family As Integer
sin_port(0 To 1) As Byte
sin_addr(0 To 3) As Byte
sin_zero(0 To 7) As Byte
End Type
'typedef UINT_PTR SOCKET;
Private Type udtSOCKET
pointer As Long
End Type
' typedef struct WSAData {
' WORD wVersion;
' WORD wHighVersion;
' char szDescription[WSADESCRIPTION_LEN+1];
' char szSystemStatus[WSASYS_STATUS_LEN+1];
' unsigned short iMaxSockets;
' unsigned short iMaxUdpDg;
' char FAR *lpVendorInfo;
'} WSADATA, *LPWSADATA;
Private Type udtWSADATA
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
'int errorno = WSAGetLastError()
Private Declare Function WSAGetLastError Lib "Ws2_32" () As Integer
' int WSAStartup(
' __in WORD wVersionRequested,
' __out LPWSADATA lpWSAData
');
Private Declare Function WSAStartup Lib "Ws2_32" _
(ByVal wVersionRequested As Integer, ByRef lpWSAData As udtWSADATA) As winsockErrorCodes2
' SOCKET WSAAPI socket(
' __in int af,
' __in int type,
' __in int protocol
');
Private Declare Function ws2_socket Lib "Ws2_32" Alias "socket" _
(ByVal AF As Long, ByVal stype As Long, ByVal Protocol As Long) As LongPtr
Private Declare Function ws2_closesocket Lib "Ws2_32" Alias "closesocket" _
(ByVal socket As Long) As Long
'int recv(
' SOCKET s,
' char *buf,
' int len,
' int flags
');
Private Declare Function ws2_recv Lib "Ws2_32" Alias "recv" _
(ByVal socket As Long, ByVal buf As LongPtr, _
ByVal length As Long, ByVal flags As Long) As Long
'int WSAAPI connect(
' SOCKET s,
' const sockaddr *name,
' int namelen
');
Private Declare Function ws2_connect Lib "Ws2_32" Alias "connect" _
(ByVal S As LongPtr, ByRef name As sockaddr_in, ByVal namelen As Long) As Long
'int WSAAPI send(
' SOCKET s,
' const char *buf,
' int len,
' int flags
');
Private Declare Function ws2_send Lib "Ws2_32" Alias "send" _
(ByVal S As LongPtr, ByVal buf As LongPtr, ByVal buflen As Long, ByVal flags As Long) As Long
Private Declare Function ws2_shutdown Lib "Ws2_32" Alias "shutdown" _
(ByVal S As Long, ByVal how As Long) As Long
Private Declare Sub WSACleanup Lib "Ws2_32" ()
Private Enum eShutdownConstants
SD_RECEIVE = 0 '#define SD_RECEIVE 0x00
SD_SEND = 1 '#define SD_SEND 0x01
SD_BOTH = 2 '#define SD_BOTH 0x02
End Enum
Private Sub TestWS2SendAndReceive()
Dim sResponse As String
If WS2SendAndReceive("KEYS *" & vbCrLf, sResponse) Then
Debug.Print VBA.Join(RedisResponseToTypedVariable(sResponse), ";")
End If
If WS2SendAndReceive("GET foo" & vbCrLf, sResponse) Then
Debug.Print RedisResponseToTypedVariable(sResponse)
End If
If WS2SendAndReceive("SET baz Barry" & vbCrLf, sResponse) Then
Debug.Assert RedisResponseToTypedVariable(sResponse) = "OK"
End If
If WS2SendAndReceive("SET foo BAR" & vbCrLf, sResponse) Then
Debug.Assert RedisResponseToTypedVariable(sResponse) = "OK"
End If
If WS2SendAndReceive("DEL baz" & vbCrLf, sResponse) Then
Debug.Print RedisResponseToTypedVariable(sResponse)
End If
If WS2SendAndReceive("GET baz" & vbCrLf, sResponse) Then
Debug.Print RedisResponseToTypedVariable(sResponse)
End If
If WS2SendAndReceive("GET foo" & vbCrLf, sResponse) Then
Debug.Print RedisResponseToTypedVariable(sResponse)
End If
If WS2SendAndReceive("KEYS *" & vbCrLf, sResponse) Then
Debug.Print VBA.Join(RedisResponseToTypedVariable(sResponse), ";")
End If
If WS2SendAndReceive("SET count 0" & vbCrLf, sResponse) Then
Debug.Assert RedisResponseToTypedVariable(sResponse) = "OK"
End If
If WS2SendAndReceive("INCR count" & vbCrLf, sResponse) Then
Debug.Assert RedisResponseToTypedVariable(sResponse) = "1"
End If
End Sub
Public Function WS2SendAndReceive(ByVal sCommand As String, ByRef psResponse As String) As Boolean
'https://docs.microsoft.com/en-gb/windows/desktop/api/winsock/nf-winsock-recv
psResponse = ""
'//----------------------
'// Declare and initialize variables.
Dim iResult As Integer : iResult = 0
Dim wsaData As udtWSADATA
Dim ConnectSocket As LongPtr
Dim clientService As sockaddr_in
Dim sendBuf() As Byte
sendBuf = StrConv(sCommand, vbFromUnicode)
Const recvbuflen As Long = 512
Dim recvbuf(0 To recvbuflen - 1) As Byte
'//----------------------
'// Initialize Winsock
Dim eResult As winsockErrorCodes2
eResult = WSAStartup(&H202, wsaData)
If eResult <> 0 Then
Debug.Print "WSAStartup failed with error: " & eResult
WS2SendAndReceive = False
GoTo SingleExit
End If
'//----------------------
'// Create a SOCKET for connecting to server
ConnectSocket = ws2_socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
If ConnectSocket = INVALID_SOCKET Then
Dim eLastError As winsockErrorCodes2
eLastError = WSAGetLastError()
Debug.Print "socket failed with error: " & eLastError
Call WSACleanup
WS2SendAndReceive = False
GoTo SingleExit
End If
'//----------------------
'// The sockaddr_in structure specifies the address family,
'// IP address, and port of the server to be connected to.
clientService.sin_family = AF_INET
clientService.sin_addr(0) = 127
clientService.sin_addr(1) = 0
clientService.sin_addr(2) = 0
clientService.sin_addr(3) = 1
clientService.sin_port(1) = 235 '* 6379
clientService.sin_port(0) = 24
'//----------------------
'// Connect to server.
iResult = ws2_connect(ConnectSocket, clientService, LenB(clientService))
If (iResult = SOCKET_ERROR) Then
eLastError = WSAGetLastError()
Debug.Print "connect failed with error: " & eLastError
Call ws2_closesocket(ConnectSocket)
Call WSACleanup
WS2SendAndReceive = False
GoTo SingleExit
End If
'//----------------------
'// Send an initial buffer
Dim sendbuflen As Long
sendbuflen = UBound(sendBuf) - LBound(sendBuf) + 1
iResult = ws2_send(ConnectSocket, VarPtr(sendBuf(0)), sendbuflen, 0)
If (iResult = SOCKET_ERROR) Then
eLastError = WSAGetLastError()
Debug.Print "send failed with error: " & eLastError
Call ws2_closesocket(ConnectSocket)
Call WSACleanup
WS2SendAndReceive = False
GoTo SingleExit
End If
'Debug.Print "Bytes Sent: ", iResult
'// shutdown the connection since no more data will be sent
iResult = ws2_shutdown(ConnectSocket, SD_SEND)
If (iResult = SOCKET_ERROR) Then
eLastError = WSAGetLastError()
Debug.Print "shutdown failed with error: " & eLastError
Call ws2_closesocket(ConnectSocket)
Call WSACleanup
WS2SendAndReceive = False
GoTo SingleExit
End If
' receive only one message (TODO handle when buffer is not large enough)
iResult = ws2_recv(ConnectSocket, VarPtr(recvbuf(0)), recvbuflen, 0)
If (iResult > 0) Then
'Debug.Print "Bytes received: ", iResult
ElseIf (iResult = 0) Then
Debug.Print "Connection closed"
WS2SendAndReceive = False
Call ws2_closesocket(ConnectSocket)
Call WSACleanup
GoTo SingleExit
Else
eLastError = WSAGetLastError()
Debug.Print "recv failed with error: " & eLastError
End If
psResponse = Left$(StrConv(recvbuf, vbUnicode), iResult)
'Debug.Print psResponse
'// close the socket
iResult = ws2_closesocket(ConnectSocket)
If (iResult = SOCKET_ERROR) Then
eLastError = WSAGetLastError()
Debug.Print "close failed with error: " & eLastError
Call WSACleanup
WS2SendAndReceive = False
GoTo SingleExit
End If
Call WSACleanup
WS2SendAndReceive = True
SingleExit:
Exit Function
ErrHand:
End Function
Public Function RedisResponseToTypedVariable(ByVal sResponse As String)
Dim lTotalLength As Long
lTotalLength = Len(sResponse)
Debug.Assert lTotalLength > 0
Dim vSplitResponse As Variant
vSplitResponse = VBA.Split(sResponse, vbCrLf)
Dim lReponseLineCount As Long
lReponseLineCount = UBound(vSplitResponse) - LBound(vSplitResponse)
Select Case Left(sResponse, 1)
Case "$"
RedisResponseToTypedVariable = vSplitResponse(1)
Case "+"
RedisResponseToTypedVariable = Mid$(vSplitResponse(0), 2)
Case ":"
'* response is an integer
RedisResponseToTypedVariable = CLng(Mid$(vSplitResponse(0), 2))
Case "-"
'* response is an error
Err.Raise vbObjectError, , Mid$(vSplitResponse(0), 2)
'Stop
Case "*"
'* multiple responses, build an array to return
Dim lResponseCount As Long
lResponseCount = CLng(Mid$(vSplitResponse(0), 2))
If lResponseCount > 0 Then
Debug.Assert lResponseCount = (lReponseLineCount - 1) / 2
ReDim vReturn(0 To lResponseCount - 1)
Dim lLoop As Long
For lLoop = 0 To lResponseCount - 1
vReturn(lLoop) = vSplitResponse((lLoop + 1) * 2)
Next lLoop
End If
RedisResponseToTypedVariable = vReturn
Case Else
Stop '* this should not happen
End Select
End Function

Appendix A - Useful Enums

So it turned out I did not need these enumerations as such but I may in the future so parking here for safekeeping

modGlobalEnums Standard Module

Option Explicit
Public Enum sckState
sckClosed = 0 ' Default. Closed
sckOpen = 1 ' Open
sckListening = 2 ' Listening
sckConnectionPending = 3 ' Connection pending
sckResolvingHost = 4 ' Resolving host
sckHostResolved = 5 ' Host resolved
sckConnecting = 6 ' Connecting
sckConnected = 7 ' Connected
sckClosing = 8 ' Peer is closing the connection
sckError = 9 ' Error
End Enum
''https://docs.microsoft.com/en-gb/windows/desktop/WinSock/windows-sockets-error-codes-2
Public Enum winsockErrorCodes2
WSA_SUCCESS = 0
WSA_INVALID_HANDLE = 6
WSA_NOT_ENOUGH_MEMORY = 8
WSA_INVALID_PARAMETER = 87
WSA_OPERATION_ABORTED = 995
WSA_IO_INCOMPLETE = 996
WSA_IO_PENDING = 997
WSA_E_INTR = 10004
WSA_E_BADF = 10009
WSA_E_ACCES = 10013
WSA_E_FAULT = 10014
WSA_E_INVAL = 10022
WSA_E_MFILE = 10024
WSA_E_WOULDBLOCK = 10035
WSA_E_INPROGRESS = 10036
WSA_E_ALREADY = 10037
WSA_E_NOTSOCK = 10038
WSA_E_DESTADDRREQ = 10039
WSA_E_MSGSIZE = 10040 '* Message too long.
WSA_E_PROTOTYPE = 10041
WSA_E_NOPROTOOPT = 10042
WSA_E_PROTONOSUPPORT = 10043
WSA_E_SOCKTNOSUPPORT = 10044
WSA_E_OPNOTSUPP = 10045
WSA_E_PFNOSUPPORT = 10046
WSA_E_AFNOSUPPORT = 10047
WSA_E_ADDRINUSE = 10048
WSA_E_ADDRNOTAVAIL = 10049
WSA_E_NETDOWN = 10050
WSA_E_NETUNREACH = 10051
WSA_E_NETRESET = 10052
WSA_E_CONNABORTED = 10053
WSA_E_CONNRESET = 10054 '* Connection reset by peer.
WSA_E_NOBUFS = 10055
WSA_E_ISCONN = 10056
WSA_E_NOTCONN = 10057
WSA_E_SHUTDOWN = 10058
WSA_E_TOOMANYREFS = 10059
WSA_E_TIMEDOUT = 10060
WSA_E_CONNREFUSED = 10061
WSA_E_LOOP = 10062
WSA_E_NAMETOOLONG = 10063
WSA_E_HOSTDOWN = 10064
WSA_E_HOSTUNREACH = 10065
WSA_E_NOTEMPTY = 10066
WSA_E_PROCLIM = 10067
WSA_E_USERS = 10068
WSA_E_DQUOT = 10069
WSA_E_STALE = 10070
WSA_E_REMOTE = 10071
WSASYSNOTREADY = 10091
WSAVERNOTSUPPORTED = 10092
WSANOTINITIALISED = 10093
WSA_E_DISCON = 10101
WSA_E_NOMORE = 10102
WSA_E_CANCELLED = 10103
WSA_E_INVALIDPROCTABLE = 10104
WSA_E_INVALIDPROVIDER = 10105
WSA_E_PROVIDERFAILEDINIT = 10106
WSASYSCALLFAILURE = 10107
WSASERVICE_NOT_FOUND = 10108
WSATYPE_NOT_FOUND = 10109
WSA_E_NO_MORE = 10110
WSA_E_CANCELLED_2 = 10111
WSA_E_REFUSED = 10112
WSAHOST_NOT_FOUND = 11001
WSATRY_AGAIN = 11002
WSANO_RECOVERY = 11003
WSANO_DATA = 11004
WSA_QOS_RECEIVERS = 11005
WSA_QOS_SENDERS = 11006
WSA_QOS_NO_SENDERS = 11007
WSA_QOS_NO_RECEIVERS = 11008
WSA_QOS_REQUEST_CONFIRMED = 11009
WSA_QOS_ADMISSION_FAILURE = 11010
WSA_QOS_POLICY_FAILURE = 11011
WSA_QOS_BAD_STYLE = 11012
WSA_QOS_BAD_OBJECT = 11013
WSA_QOS_TRAFFIC_CTRL_ERROR = 11014
WSA_QOS_GENERIC_ERROR = 11015
WSA_QOS_ESERVICETYPE = 11016
WSA_QOS_EFLOWSPEC = 11017
WSA_QOS_EPROVSPECBUF = 11018
WSA_QOS_EFILTERSTYLE = 11019
WSA_QOS_EFILTERTYPE = 11020
WSA_QOS_EFILTERCOUNT = 11021
WSA_QOS_EOBJLENGTH = 11022
WSA_QOS_EFLOWCOUNT = 11023
WSA_QOS_EUNKOWNPSOBJ = 11024
WSA_QOS_EPOLICYOBJ = 11025
WSA_QOS_EFLOWDESC = 11026
WSA_QOS_EPSFLOWSPEC = 11027
WSA_QOS_EPSFILTERSPEC = 11028
WSA_QOS_ESDMODEOBJ = 11029
WSA_QOS_ESHAPERATEOBJ = 11030
WSA_QOS_RESERVED_PETYPE = 11031
End Enum

2 comments:

Pablo11 January 2019 at 05:20
Hello! Congrats on your blog! It covers a lot of topics! I saw one of your older posts (and commented it too) and was wondering if you can help me out with some JavaScript code I can't crack..
ReplyDelete
Replies
Unknown15 January 2021 at 05:48
Great ,
Dim ConnectSocket As LongPtr i changed to long and works well.
thx
ReplyDelete
Replies

Add comment