CodeGuru Home VC++ / MFC / C++ .NET / C# Visual Basic VB Forums Developer.com
Results 1 to 3 of 3
  1. #1
    Join Date
    Nov 2023
    Location
    Africa
    Posts
    2

    Red face Winsock with VBA failing to connect

    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.

    Code:
    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

  2. #2
    2kaud's Avatar
    2kaud is offline Super Moderator Power Poster
    Join Date
    Dec 2012
    Location
    England
    Posts
    7,821

    Re: Winsock with VBA failing to connect

    [You will probably get more responses if you post on this site's sister site https://www.vbforums.com/forumdispla...ce-Development ]
    All advice is offered in good faith only. All my code is tested (unless stated explicitly otherwise) with the latest version of Microsoft Visual Studio (using the supported features of the latest standard) and is offered as examples only - not as production quality. I cannot offer advice regarding any other c/c++ compiler/IDE or incompatibilities with VS. You are ultimately responsible for the effects of your programs and the integrity of the machines they run on. Anything I post, code snippets, advice, etc is licensed as Public Domain https://creativecommons.org/publicdomain/zero/1.0/ and can be used without reference or acknowledgement. Also note that I only provide advice and guidance via the forums - and not via private messages!

    C++23 Compiler: Microsoft VS2022 (17.6.5)

  3. #3
    Join Date
    Nov 2023
    Location
    Africa
    Posts
    2

    Re: Winsock with VBA failing to connect

    Quote Originally Posted by 2kaud View Post
    [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

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  





Click Here to Expand Forum to Full Width

Featured