问题描述
我正在解决与将VBA代码从32位移植到64位excel有关的问题。我想向您保证，我已经两个星期试图自己解决它，试图修改代码，阅读论坛，文档，网页的色调，在Microsoft网站上查找VBA参考。我正在向前迈出小步，但最终我坚持了我无法应对的一步。
我的宏是基于Internet上的代码段创建的。通常，它被编写为连接到需要从中提取数据的服务器。它发送一个字符串并接收回来的字符串。
此宏在32位excel上运行正常，没有任何问题，但在64位excel上运行不正常。当然，我修改了函数声明，包括“ PtrSafe”修饰符，并在需要时将“ Long”数据类型更改为“ LongPtr”。主要在我期望功能需要指针或内存地址的地方。不幸的是，我无法访问'wsock32.dll'内的内容的任何详细定义，因此我的声明只是基于我可以从互联网论坛上获取的信息进行的猜测...我试图利用'ws2_32.dll'，但是使用“ wsock32.dll”更成功。我猜对于我的应用程序“较旧”的winsock就足够了（但是这里可能是个问题……）。
为了进行问题调试，我将宏重新编写为最简单的代码，在其中逐步进行测试。此时，我可以初始化winsock，通过主机名获取地址（这应该很好用，因为我的代码以可读的方式为我提供了可以从cmd窗口中的ping获得的相同IP地址），初始化了套接字。目前，我一直无法连接到套接字。我只是不知道我的代码有什么问题。我在这里提供的代码已在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,"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,"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
解决方法
暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！
如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。
小编邮箱:dio#foxmail.com (将#修改为@）