VBA Excel 365 64-bit Winsock implementation problem

1.7k views Asked by At

I am struggling with an issues related to porting VBA code from 32-bit into 64-bit excel. I would like to assure that I am trying to resolve it by myself already for two weeks, trying to modify the code, reading tones of forums, documents, web pages, looking for VBA reference on Microsoft webs. I am doing small steps forward, but ultimately I stuck on one step which I am not able to deal with.

My macro was created based on code snippets found on internet. In general it was written to connect to a server from which it needs to pull data. It sends a string and receives string back.

This macro was working well on 32-bit excel with no issues, but it is not working on 64-bit excel. Of course I modified declaration of functions including 'PtrSafe' modifier and changed 'Long' data type to 'LongPtr' whenever I found it necessary. Mainly in places where I expect function is requiring a pointer or memory address. Unfortunately I was not able to access any detailed definition what is inside 'wsock32.dll' therefore my declarations are rather guesses based on information which I could grab from internet forums... I was trying to utilize 'ws2_32.dll', but was more successful with 'wsock32.dll'. I guess for my application 'older' winsock is enough (but maybe this is an issue here...).

In order to debug by problem I've re-written the macro into simplest possible code in which I am testing step by step what is going on. At this point in time I am able to initialise winsock, get address by host name (this supposed to work well, since my code gives me the same IP address in human readable way which I can get from ping in cmd window), initialise socket. Currently I am stuck on connecting to the socket. I just have no idea what is wrong with my code. Code which I am presenting here was checked on 32-bit excel 2016 and it is able to connect to the socket. When I try to run it on 64-bit excel I get an error 10049.

May I ask for support, please?

Option Explicit
Option Compare Text

'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
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" (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 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

Sub test()
    Dim lResVal As Long
    lResVal = GetDataFromServer(ServHost, ServPort)
End Sub

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
0

There are 0 answers