2

我正在努力解决与将 VBA 代码从 32 位移植到 64 位 excel 相关的问题。我想保证我已经尝试自己解决它两周，尝试修改代码，阅读论坛、文档、网页的音调，在 Microsoft 网站上寻找 VBA 参考。我正在向前迈出一小步，但最终我坚持了一步，我无法应对。

我的宏是根据互联网上的代码片段创建的。一般来说，它是为了连接到需要从中提取数据的服务器而编写的。它发送一个字符串并接收回字符串。

该宏在 32 位 excel 上运行良好，没有问题，但在 64 位 excel 上无法运行。当然，我修改了包括“PtrSafe”修饰符在内的函数声明，并在发现有必要时将“Long”数据类型更改为“LongPtr”。主要是在我期望函数需要指针或内存地址的地方。不幸的是，我无法访问“wsock32.dll”内部的任何详细定义，因此我的声明是基于我可以从互联网论坛获取的信息的猜测......我试图利用“ws2_32.dll”，但是'wsock32.dll' 更成功。我想我的应用程序'旧'winsock就足够了（但也许这是这里的一个问题......）。

为了按问题进行调试，我将宏重写为最简单的代码，在其中我正在逐步测试正在发生的事情。此时我可以初始化winsock，通过主机名获取地址（这应该很好用，因为我的代码以人类可读的方式为我提供了相同的IP地址，我可以从cmd窗口中的ping获得），初始化套接字. 目前我被困在连接到套接字上。我只是不知道我的代码有什么问题。我在这里展示的代码在 32 位 excel 2016 上进行了检查，它能够连接到套接字。当我尝试在 64 位 excel 上运行它时，我收到错误 10049。

请问我可以寻求支持吗？

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
4

0 回答 0