Reputation: 313

32bit to 64bit Declaring Functions in 64 bit office

So I had to go in and add in PtrSafe before function calls since I am now using 64bit Excel. So far doing the PtrSafe changes has worked fine except for my mod_Ping. I had to do a #If Win64 Then … #else … #end if statements to make this code work in my macros because it would not work in this part if I had just added in the PtrSafe before each function call.

#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

As you can see I had to also change the longs to LongPtr as well.

When I open up this work book it gives me error only comments may appear after end sub end function or end property. The strange thing is, if i just ignore this and close out the debugger the workbook works fine.

I mean the #End if should be there to end the initial #If calling so I don't know why I would get a compile error for it. Is there something I am not seeing?

Upvotes: 2