Winsock with VBA failing to connect

[nector2014]

I need help on the code below, I'm able to start Winsock with VBA library below or initialize , but I'm failing to connect to my local machine with IP address 127.0.0.1 & Port number 49414, before going to the server I wanted it if it was working okay on my machine.

Option Compare Database

Option Explicit

'Receiving data in 64 & 32 BITRemember to thoroughly test any modifications, as networking code
'can be quite sensitive to changes. Additionally, because the code
'involves direct memory operations and system API calls, it's important
'to ensure that your Access project is running in a trusted environment
'to avoid security issues.


'Define address families
Public Const AF_INET = 2               'internetwork: UDP, TCP, etc.

'Define socket types
Public Const SOCK_STREAM = 1           'Stream socket

'Define return codes
Public Const GENERAL_ERROR As Long = vbObjectError + 100
Public Const INVALID_SOCKET = &HFFFF
Public Const SOCKET_ERROR = -1
Public Const NO_ERROR = 0

' Define structure for the information returned from the WSAStartup() function
Public Const WSADESCRIPTION_LEN = 256
Public Const WSASYS_STATUS_LEN = 128
Public Const WSA_DescriptionSize = WSADESCRIPTION_LEN + 1
Public Const WSA_SysStatusSize = WSASYS_STATUS_LEN + 1
Type WSAData
   wVersion As Integer
   wHighVersion As Integer
   szDescription As String * WSA_DescriptionSize
   szSystemStatus As String * WSA_SysStatusSize
   iMaxSockets As Integer
   iMaxUdpDg As Integer
   lpVendorInfo As String * 200
End Type

' Define structure for host
Public Type hostent
    h_name As LongPtr
    h_aliases As LongPtr
    h_addrtype As Integer
    h_length As Integer
    h_addr_list As LongPtr
End Type

' Define structure for address
Public Type sockaddr
    sin_family As Integer
    sin_port As Integer
    sin_addr As LongPtr
    sin_zero As String * 8
End Type

'Declare Socket functions
#If Win64 Then
Public Declare PtrSafe Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired As Long, lpWSAData As WSAData) As Long
Public Declare PtrSafe Function WSACleanup Lib "wsock32.dll" () As Long
Public Declare PtrSafe Function gethostbyname Lib "wsock32.dll" (ByVal name As String) As LongPtr
Public Declare PtrSafe Function inet_ntoa Lib "wsock32.dll" (ByVal inaddr As LongPtr) As LongPtr
Public Declare PtrSafe Function Socket Lib "wsock32.dll" Alias "socket" (ByVal af As Long, ByVal socktype 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 connect Lib "wsock32.dll" (ByVal s As LongPtr, name As sockaddr, ByVal namelen As Long) As Long
Public Declare PtrSafe Function closesocket Lib "wsock32.dll" (ByVal s As LongPtr) As Long
Public Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare PtrSafe Function Send Lib "ws2_32.dll" Alias "send" (ByVal s As Long, ByVal buf As String, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare PtrSafe Function Recv Lib "ws2_32.dll" Alias "recv" (ByVal s As Long, ByRef buf As String, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare PtrSafe Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As Any) As Long
Public Declare PtrSafe Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
#Else
Public Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired As Long, lpWSAData As WSAData) As Long
Public Declare Function WSACleanup Lib "wsock32.dll" () As Long
Public Declare Function gethostbyname Lib "wsock32.dll" (ByVal name As String) As LongPtr
Public Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inaddr As LongPtr) As LongPtr
Public Declare Function Socket Lib "wsock32.dll" Alias "socket" (ByVal af As Long, ByVal socktype As Long, ByVal protocol As Long) As Long
Public Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
Public Declare Function connect Lib "wsock32.dll" (ByVal s As LongPtr, name As sockaddr, ByVal namelen As Long) As Long
Public Declare Function closesocket Lib "wsock32.dll" (ByVal s As LongPtr) As Long
Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function Send Lib "ws2_32.dll" Alias "send" (ByVal s As Long, ByVal buf As String, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function Recv Lib "ws2_32.dll" Alias "recv" (ByVal s As Long, ByRef buf As String, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As Any) As Long
Public Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
#End If
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
MsgBox "Port has now opened", vbCritical, "Please Move On"
End Function

'Sending data to the server
Function SendingData(ByVal Socks As Long, ByVal buffer As String, ByVal bufferlen As Long, ByVal flag As Long) As Long
    Dim lResult As Long
    lResult = Send(Socks, buffer, bufferlen, flag)
    Debug.Print Err.LastDllError
    If lResult = SOCKET_ERROR Then
        Call closesocket(Socks)
        Call WSACleanup
        Err.Raise GENERAL_ERROR, "SendingData", "Unable to send data to the server!"
    End If
    SendingData = lResult
End Function

'Receiving data from the server
Function ReceivingData(ByVal Sockets As Long, ByRef buffer As String, ByVal bufferlen As Long, ByVal flag As Long) As Long
    Dim lResult As Long
    lResult = Recv(Sockets, buffer, bufferlen, flag)
    Debug.Print Err.LastDllError
    If lResult = SOCKET_ERROR Then
        Call closesocket(Sockets)
        Call WSACleanup
        Err.Raise GENERAL_ERROR, "ReceivingData", "Unable to receive data from the server!"
    End If
    ReceivingData = lResult
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

'Close the socket and transport
Function ClosingNetwork(ByVal Socket As LongPtr) As Long
Call closesocket(Socket)
Call WSACleanup
MsgBox "Port has now closed", vbCritical, "Please Move On"
End Function

[2kaud]

[You will probably get more responses if you post on this site's sister site https://www.vbforums.com/forumdispla...ce-Development ]

[nector2014]

[You will probably get more responses if you post on this site's sister site https://www.vbforums.com/forumdispla...ce-Development ]

Okay I managed to clear within VBA thank you so much for the reply