Функции объявления от 32 до 64 бит в 64-битном офисе - PullRequest
0 голосов

Так что мне пришлось войти и добавить 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

Как видите, мне также пришлось изменить длинную позицию на LongPtr.

Когда я открываю эту рабочую книгу, она дает мне ошибку, только комментарии могут появляться после функции end sub end или свойства end.Странно то, что если я просто проигнорирую это и закрою отладчик, книга будет работать нормально.

Я имею в виду, что #End if должен быть там, чтобы завершить начальный вызов #If, поэтому я не знаю, почему я получу за это ошибку компиляции.Есть что-то, чего я не вижу?

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...