Winsock Library either C++ or Any Language required (1 Viewer)

[nector]

Hello there!

Can someone assist me with a full winsock2 library +functions in any language I want to try and translate it into VBA because my project is in MS Access and so far I have not seen any winsock2 full code working. The only solution here is to get a working code in any language and try to translate into VBA, I know this is not a simple thing it will require huge number of hours to accomplish that, but it is better to do it once and for all. For example, for C++ below is my translation sample:

#ifndef UNICODE
#define UNICODE 1
#endif

// link with Ws2_32.lib
#pragma comment(lib,"Ws2_32.lib")

#include <winsock2.h>
#include <ws2tcpip.h>
#include <stdio.h>
#include <stdlib.h>   // Needed for _wtoi

VBA standard

#If Not UNICODE Then
    UNICODE = 1
#End If

Private Declare Function Ws2_32 Lib "Ws2_32.dll" Alias "WSAStartup" (ByVal wVersionRequested As Long, lpWSAData As WSAData) As Long
Private Declare Function Ws2_32 Lib "Ws2_32.dll" Alias "WSACleanup" () As Long
Private Declare Function Ws2_32 Lib "Ws2_32.dll" Alias "getaddrinfo" (ByVal pNodeName As String, ByVal pServiceName As String, lpHints As addrinfo, lpResult As Long) As Long
Private Declare Function Ws2_32 Lib "Ws2_32.dll" Alias "freeaddrinfo" (lpAddrInfo As addrinfo) As Long
Private Declare Function Ws2_32 Lib "Ws2_32.dll" Alias "getnameinfo" (ByVal sa As SOCKADDR, ByVal salen As Long, ByVal host As String, ByVal hostlen As Long, ByVal serv As String, ByVal servlen As Long, ByVal flags As Long) As Long

If I can have a full library + Functions I can try translating it into VBA , I have tried to check on the net but it appears nothing is coming through.

The major purpose here is to learn more on programing and see what happens after

 

[sonic8]

Can someone assist me with a full winsock2 library +functions in any language

It will be hard to find any *full* example code using *all* of the Winsock code. - This is something usually only tool/component providers do for a commercial product and they will not disclose the source code. Other developers usually only have a need to implement a subset of the full functionality.

Microsoft's Getting started with Winsock page contains links to a lot of working examples. I guess, it will be hard to find a more complete resource.

 

[sonic8]

#If Not UNICODE Then
UNICODE = 1
#End If

This adaptation is incorrect. - I'm not sure if is even possible to replicate the original code for the UNICODE compiler constant in VBA.

You should be aware of the Unicode vs. ANSI issue when working on your own Winsock code. However, I don't think using a compiler constant is the best (or even viable) approach to deal with the issue in an VBA application using Winsock.

 

[nector]

Thank you so much I have already translated the functions from C++ as follows

(1) Initialization
(2) Create Socket
(3) Connect
(4) Bind
(5) Listening

Any let me see how far I will go on this one

 

[cheekybuddha]

Here's a link to Randy Birch's fantastic VB6 site where he uses some winsock api's. Although it's VB6, it mainly translates directly to VBA.

There are some useful const and type definitions which might help you, or at least guide you in wht is required for creating any others

 

[Isaac]

Winsock is THE BEST - even better than psftp.exe, if that's possible.

Just install the comand-line-enabled executable and pay attention to the documentation, and then of course (via command line) it's totally able to be powered via VBA.

Have used it with great success in VBA projects not long ago

 

[Isaac]

Oops - I think I may have misunderstood.
All my comments pertain to WinSCP actually. Sorry.

Not sure if I should delete comment or if the mention of WinSCP is actually helpful.

 

[nector]

Here's a link to Randy Birch's fantastic VB6 site where he uses some winsock api's. Although it's VB6, it mainly translates directly to VBA.

There are some useful const and type definitions which might help you, or at least guide you in wht is required for creating any others

Thank you so much

cheekybuddha​

This will help alot to learn the concept

 

[nector]

Well I can now see the break through coming shortly, after a lot of translation. I added the translated C++ code to VBA below , after puting a fake IP Address the system is able to detect that fake sockect.

Function GetDataFromServer(ByVal sHostName As String, ByVal iPortNumber As Integer) As Long
    Dim lResult As Long ' General variable to be used when checking the status from winsock functions
   
    ' Initialise the winsock
    Dim CurrentWinsockInfo As WSAData
    lResult = WSAStartup(MAKEWORD(2, 2), CurrentWinsockInfo)
    If lResult <> 0 Then
        Err.Raise GENERAL_ERROR, "WinsockInitInterface", "Unable to initialize Winsock!"
    End If
   
    ' Get information about the server to connect to.
    Dim lHostInfoPointer As LongPtr    ' pointer to info about the host computer
    lHostInfoPointer = gethostbyname(sHostName & vbNullChar)
    If lHostInfoPointer = 0 Then
        Err.Raise GENERAL_ERROR, "WinsockOpenTheSocketHostName", "Unable to resolve host!"
    End If
   
    ' Copy information about the server into the structure.
    Dim hostinfo As hostent         ' info about the host computer
    CopyMemory hostinfo, ByVal lHostInfoPointer, LenB(hostinfo)
    If hostinfo.h_addrtype <> AF_INET Then
        Err.Raise GENERAL_ERROR, "WinsockOpenTheSocketHostName", "Couldn't get IP address of " & sHostName
    End If
    ' Get the server's IP address out of the structure.
    Dim lIPAddressPointer As LongPtr   ' pointer to host's IP address
    Dim lIPAddress As LongPtr          ' host's IP address
    CopyMemory lIPAddressPointer, ByVal hostinfo.h_addr_list, LenB(lIPAddressPointer)
    CopyMemory lIPAddress, ByVal lIPAddressPointer, LenB(lIPAddress)
   
        ' Convert the IP address into a human-readable string.
        Dim lIPStringPointer As LongPtr     ' pointer to an IP address formatted as a string
        Dim sIPString As String             ' holds a human-readable IP address string
        lIPStringPointer = inet_ntoa(lIPAddress)
        sIPString = Space(lstrlen(lIPStringPointer))
        lResult = lstrcpy(sIPString, lIPStringPointer)
        Debug.Print sHostName & " IP: " & sIPString & " : " & iPortNumber
       
    ' Create a new socket
    Dim lsocketID As Long
    lsocketID = socket(AF_INET, SOCK_STREAM, 0)
    If lsocketID = SOCKET_ERROR Then
        Err.Raise GENERAL_ERROR, "WinsockOpenTheSocket", "Unable to create the socket!"
    End If
   
    ' Setup IP address and Port number
    Dim I_SocketAddress As sockaddr
    With I_SocketAddress
        .sin_family = AF_INET
        .sin_port = htons(iPortNumber)
        .sin_addr = lIPAddress
        .sin_zero = String$(8, 0)
    End With
   
    ' Connect to the socket
    lResult = connect(lsocketID, I_SocketAddress, LenB(I_SocketAddress))
    Debug.Print Err.LastDllError
    If lResult = SOCKET_ERROR Then
        Call closesocket(lsocketID)
        Call WSACleanup
        Err.Raise GENERAL_ERROR, "WinsockOpenTheSocket", "Unable to connect to the socket!"
    End If
   
End Function

Public Function MAKEWORD(ByVal bLow As Byte, ByVal bHigh As Byte) As Integer
    MAKEWORD = Val("&H" & Right("00" & Hex(bHigh), 2) & Right("00" & Hex(bLow), 2))
End Function

'send command

Function SendCommand(ByVal command As String) As Integer
Dim strSend As String
Dim socketid As Long
Dim COMMAND_ERROR As Integer
Dim Count As Integer
Dim NO_ERROR 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

'Receive command
Function RecvAscii(dataBuf As String, ByVal maxLength As Integer) As Integer
Dim socketid As Long
Dim c As String * 2048
Dim length As Integer
Dim Count As Integer
Dim RECV_ERROR As String
Dim NO_ERROR As Integer
dataBuf = ""
While length < maxLength
DoEvents
Count = recv(socketid, c, 1, 0) '
If Count < 1 Then '
RecvAscii = RECV_ERROR '...................(1)
dataBuf = Chr$(0) '
Exit Function '
End If '
If c = Chr$(10) Then '
dataBuf = dataBuf + Chr$(0) '...................(2)
RecvAscii = NO_ERROR '
Exit Function '
End If '
length = length + Count '...................(3)
dataBuf = dataBuf + c '
Wend
RecvAscii = RECV_ERROR
End Function