Так что мне пришлось войти и добавить 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
, поэтому я не знаю, почему я получу за это ошибку компиляции.Есть что-то, чего я не вижу?