时间戳

首页 > 解决方案 > 64位office中32位到64位的声明函数

vba - 64位office中32位到64位的声明函数

问题描述

所以我必须在PtrSafe函数调用之前加入并添加，因为我现在使用的是 64 位 Excel。到目前为止，PtrSafe除了我的mod_Ping. 我必须做一个#If Win64 Then……语句才能使这段代码在我的宏#else中#end if工作，因为如果我刚刚PtrSafe在每个函数调用之前添加，它将无法在这部分工作。

#If Win64 Then
Private Declare PtrSafe Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal HostName As String) As LongPtr
Private Declare PtrSafe Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired&, lpWSAdata As WSAdata) As LongPtr
Private Declare PtrSafe Function WSACleanup Lib "wsock32.dll" () As LongPtr
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As LongPtr)
Private Declare PtrSafe Function IcmpCreateFile Lib "icmp.dll" () As LongPtr
Private Declare PtrSafe Function IcmpCloseHandle Lib "icmp.dll" (ByVal HANDLE As LongPtr) As Boolean
Private Declare PtrSafe Function IcmpSendEcho Lib "ICMP" (ByVal IcmpHandle As LongPtr, ByVal DestAddress As LongPtr, ByVal RequestData As String, ByVal RequestSize As Integer, RequestOptns As IP_OPTION_INFORMATION, ReplyBuffer As IP_ECHO_REPLY, ByVal ReplySize As LongPtr, ByVal Timeout As LongPtr) As Boolean

Public Function Ping(sAddr As String, Optional Timeout As Integer = 2000) As Integer
  Dim hFile As LongPtr, lpWSAdata As WSAdata
  Dim hHostent As Hostent, AddrList As LongPtr
  Dim Address As LongPtr, rIP As String
  Dim OptInfo As IP_OPTION_INFORMATION
  Dim EchoReply As IP_ECHO_REPLY

  Call WSAStartup(&H101, lpWSAdata)

  If GetHostByName(sAddr + String(64 - Len(sAddr), 0)) <> SOCKET_ERROR Then
      CopyMemory hHostent.h_name, ByVal GetHostByName(sAddr + String(64 - Len(sAddr), 0)), Len(hHostent)
      CopyMemory AddrList, ByVal hHostent.h_addr_list, 4
      CopyMemory Address, ByVal AddrList, 4
  End If

  hFile = IcmpCreateFile()

  If hFile = 0 Then
      Ping = -2 ' MsgBox "Unable to Create File Handle"
      Exit Function
  End If

  OptInfo.TTL = 255

  If IcmpSendEcho(hFile, Address, String(32, "A"), 32, OptInfo, EchoReply, Len(EchoReply) + 8, Timeout) Then
      rIP = CStr(EchoReply.Address(0)) + "." + CStr(EchoReply.Address(1)) + "." + CStr(EchoReply.Address(2)) + "." + CStr(EchoReply.Address(3))
  Else
      Ping = -1 ' MsgBox "Timeout"
  End If

  If EchoReply.Status = 0 Then
      Ping = EchoReply.RoundTripTime
  Else
      Ping = -3
  End If

  IcmpCloseHandle hFile
  WSACleanup

End Function
#Else


Private Declare  Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal HostName As String) As Long
Private Declare  Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired&, lpWSAdata As WSAdata) As Long
Private Declare  Function WSACleanup Lib "wsock32.dll" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal HANDLE As Long) As Boolean
Private Declare Function IcmpSendEcho Lib "ICMP" (ByVal IcmpHandle As Long, ByVal DestAddress As Long, ByVal RequestData As String, ByVal RequestSize As Integer, RequestOptns As IP_OPTION_INFORMATION, ReplyBuffer As IP_ECHO_REPLY, ByVal ReplySize As Long, ByVal Timeout As Long) As Boolean

Public Function Ping(sAddr As String, Optional Timeout As Integer = 2000) As Integer
  Dim hFile As Long, lpWSAdata As WSAdata
  Dim hHostent As Hostent, AddrList As Long
  Dim Address As Long, rIP As String
  Dim OptInfo As IP_OPTION_INFORMATION
  Dim EchoReply As IP_ECHO_REPLY

  Call WSAStartup(&H101, lpWSAdata)

  If GetHostByName(sAddr + String(64 - Len(sAddr), 0)) <> SOCKET_ERROR Then
      CopyMemory hHostent.h_name, ByVal GetHostByName(sAddr + String(64 - Len(sAddr), 0)), Len(hHostent)
      CopyMemory AddrList, ByVal hHostent.h_addr_list, 4
      CopyMemory Address, ByVal AddrList, 4
  End If

  hFile = IcmpCreateFile()

  If hFile = 0 Then
      Ping = -2 ' MsgBox "Unable to Create File Handle"
      Exit Function
  End If

  OptInfo.TTL = 255

  If IcmpSendEcho(hFile, Address, String(32, "A"), 32, OptInfo, EchoReply, Len(EchoReply) + 8, Timeout) Then
      rIP = CStr(EchoReply.Address(0)) + "." + CStr(EchoReply.Address(1)) + "." + CStr(EchoReply.Address(2)) + "." + CStr(EchoReply.Address(3))
  Else
      Ping = -1 ' MsgBox "Timeout"
  End If

  If EchoReply.Status = 0 Then
      Ping = EchoReply.RoundTripTime
  Else
      Ping = -3
  End If

  IcmpCloseHandle hFile
  WSACleanup
#End If
End Function

正如你所看到的，我还必须将 longs 也更改LongPtr为。

当我打开这本工作簿时，它给了我错误，只有在 end sub end 函数或 end 属性之后才可能出现注释。奇怪的是，如果我忽略这一点并关闭调试器，工作簿就可以正常工作。

我的意思是#End if应该在那里结束初始#If调用，所以我不知道为什么我会得到一个编译错误。有什么我没有看到的吗？

标签： vbafunction64-bit

解决方案

我认为我们的问题是32 位Excel 将数据类型 Integer 更改为 Long 数据类型。
尝试替换Integer为LongPtr.

推荐阅读