After finishing working on the SQL server cloud and taking a course on TCP/IP protocol, I have decided to go back to WINSOCK or window sockets if you like that way. I have constructed the data structure based on the C++ guide on network and then translate it into VBA.
Yes, at the beginning there were a lot of errors, but I had to clear them step by step being a fellow chartered accountant, I thought that was the best method for me to handle such problems. The first project similar to Winsock called serial COM port is working perfect no one is complaining about it, but this one will continue to be used for local area network with some gadgets attached to the target computers as you know the COM ports cannot be shared over the internet without buying expensive firmware.
My new commands for Winsock are purely based on the module I have translated and amended on my computer, now I intend to start testing this one fulltime in May 2023.
The reasons why I’m writing this is to ask for assistance on the issues below:
Thank you in advance for any contribution!
Regards
Christopher
From Southern Africa
Yes, at the beginning there were a lot of errors, but I had to clear them step by step being a fellow chartered accountant, I thought that was the best method for me to handle such problems. The first project similar to Winsock called serial COM port is working perfect no one is complaining about it, but this one will continue to be used for local area network with some gadgets attached to the target computers as you know the COM ports cannot be shared over the internet without buying expensive firmware.
My new commands for Winsock are purely based on the module I have translated and amended on my computer, now I intend to start testing this one fulltime in May 2023.
The reasons why I’m writing this is to ask for assistance on the issues below:
- Can someone audit the sequence of my commands whether they are in agreement with the photo attached. Kindly note that the photo has also an error on the send and receive commands. The send command was supposed to come first then followed by the receive command.
- The hostname & port number here with my understanding it represents the server IP address & port number (The IP address of the gadget and port number where to send data)
- For the client side, the port number is supposed to be assigned automatically by the O/S while the IP address is the same server IP address.
Thank you in advance for any contribution!
Regards
Christopher
From Southern Africa
Code:
Function initWinsock() As Boolean ' {
'Initialize winsock here
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 ' }
Function OpenSocket(ByVal Hostname As String, ByVal PortNumber As Integer) As Integer
Dim x As Long
Dim I_SocketAddress As sockaddr_in
Dim ipAddress As Long
ipAddress = inet_addr(Hostname)
'Create a new socket
socketId = SOCKET(AF_INET, SOCK_STREAM, 0)
If socketId = SOCKET_ERROR Then
MsgBox ("ERROR: socket = " + Str$(socketId))
OpenSocket = COMMAND_ERROR
Exit Function
End If
'Open a connection to a server
I_SocketAddress.sin_family = AF_INET
I_SocketAddress.sin_port = htons(PortNumber)
I_SocketAddress.sin_addr = ipAddress
I_SocketAddress.sin_zero = String$(8, 0)
x = w_connect(socketId, I_SocketAddress, Len(I_SocketAddress))
If socketId = SOCKET_ERROR Then
MsgBox ("ERROR: connect = " + Str$(x))
OpenSocket = COMMAND_ERROR
Exit Function
End If
OpenSocket = socketId
'Binding a socket
Dim rc As Long
rc = bind(socketId, I_SocketAddress, 16)
If rc <> 0 Then
MsgBox "Could not bind, error = " & WSAGetLastError()
Exit Function
End If
rc = listen(socketId, 10) ' 10 = backlog
If rc <> 0 Then
MsgBox "Could not listen"
End If
End Function
Public Function 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 Function ' }
Public Function getStringFromSocket(s As Long) ' {
Dim message As String
Dim buffer As String * 2048
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 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 SendCommand(ByVal command As String) As Integer
' our communication command...
Dim strSend As String
Dim count As Integer
strSend = command + vbCrLf
count = send(socketId, ByVal strSend, Len(strSend), 0)
If count = SOCKET_ERROR Then
MsgBox ("ERROR: send = " + Str$(count))
SendCommand = COMMAND_ERROR
Exit Function
End If
SendCommand = NO_ERROR
End Function
Function RecvAscii(dataBuf As String, ByVal maxLength As Integer) As Integer
' our recv function..
Dim c As String * 1
Dim length As Integer
Dim count As Integer
dataBuf = ""
While length < maxLength
DoEvents
count = recv(socketId, c, 1, 0)
If count < 1 Then
RecvAscii = RECV_ERROR
dataBuf = Chr$(0)
Exit Function
End If
If c = Chr$(10) Then
dataBuf = dataBuf + Chr$(0)
RecvAscii = NO_ERROR
Exit Function
End If
length = length + count
dataBuf = dataBuf + c
Wend
RecvAscii = RECV_ERROR
End Function
Public Function CloseConnection()
Dim x As Long
' we close our connection here
x = closesocket(socketId)
If x = SOCKET_ERROR Then
MsgBox ("ERROR: closesocket = " + Str$(x))
Exit Function
End If
End Function
Public Function EndIt()
Dim x As Long
'Shutdown Winsock DLL
x = WSACleanup()
End Function
