On Wednesday, November 18, 2020 at 10:51:23 PM UTC, Peter T wrote:
"Andrey G" wrote in message
On Wednesday, November 18, 2020 at 10:02:17 AM UTC, Peter T wrote:
"Andrey G" wrote in message
...
On Thursday, November 12, 2020 at 11:37:20 AM UTC, Peter T wrote:
"Andrey G" wrote in message
Hi Peter,
I've tried running code with the last argument for CopyMemory
changed,
but
Excel still crashed. Please have a look below at the details of the
problem:
[snip]
'get the IP address
CopyMemory ptrAddress, ByVal ptrAddress, 8 '<----- Excel crashes
on this line!
CopyMemory ptrIPAddress, ByVal ptrAddress, 8
CopyMemory ptrIPAddress2, ByVal ptrIPAddress, 8
GetIPFromHostName = GetInetStrFromPtr(ptrIPAddress2)
End If
End Function
Hmm, not sure where the root of the problem is, though for me it
crashes
on
the second CopyMemory, I need to get the rest of the original example.
I'll
try and look at it over the W/E.
Peter T
Hi Peter,
Thank you very much for looking into it!
Just to be absolutely clear:
As I'd said I've inherited the file, using original code from he
http://vbnet.mvps.org/index.html?cod...byhostname.htm
Above I've posted simplified original code from he
http://vbnet.mvps.org/index.html?cod...k/iplookup.htm
In my case, Excel crashes on both occasions on CopyMemory line of
Function
GetIPFromHostName().
KR
Andrey
Sorry to take a while to get back, I got hijacked with work!
In your original code, as well as changing the lengths of the 3 pointers
from 4 to 8, also change
ptrAddress = ptrHosent + 12 ' 3x4
to
ptrAddress = ptrHosent + 24 ' 3x8
Peter T
No joy, I'm afraid - Excel is still crashing on the very same line.
I wonder if I made an error in declarations? The code I'd posted above is
the exact code I'm using.
Andrey G
I couldn't work with what you posted because it is incomplete, so I adapted
Randy Birch's originals from the links you posted and both working fine for
me in x64, with the 1224 change.
At a quick glance of what you posted 'addr' in the inet_ntoa API should be
As LongPtr not Long but there may well be others. Look for things like addr,
ptr, an h prefix for handle. These are typically what need to be changed
along with related API return types. Ensure your module is headed Option
Explicit and do debug/compile.
Note the 8-byte lengths and that 24 are specific for use with #Win64, not
#VBA7.
Peter T
Hi Peter,
I'm at the end of my tether now: I followed your instructions (at least I hope I did) and tried many times, but the stubborn thing is still crashing on exactly the same line!
As a final resort and a last attempt to make it work, I'm posting below my entire code in a hope that whatever is wrong might be noticeable to you.
------------------------------------------------------------------------------------------------------------------------------------
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
Private Const IP_SUCCESS As Long = 0
Private Const MAX_WSADescription As Long = 256
Private Const MAX_WSASYSStatus As Long = 128
Private Const WS_VERSION_REQD As Long = &H101
Private Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD As Long = 1
Private Const SOCKET_ERROR As Long = -1
Private Const ERROR_SUCCESS As Long = 0
Private Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription(0 To MAX_WSADescription) As Byte
szSystemStatus(0 To MAX_WSASYSStatus) As Byte
wMaxSockets As Long
wMaxUDPDG As Long
dwVendorInfo As Long
End Type
Private Declare PtrSafe Function gethostbyname Lib "wsock32.dll" _
(ByVal hostname As String) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(xDest As Any, _
xSource As Any, _
ByVal nbytes As LongPtr)
Private Declare PtrSafe Function lstrlenA Lib "kernel32" _
(lpString As Any) As Long
Private Declare PtrSafe Function WSAStartup Lib "wsock32.dll" _
(ByVal wVersionRequired As Long, _
lpWSADATA As WSADATA) As Long
Private Declare PtrSafe Function WSACleanup Lib "wsock32.dll" () As Long
Private Declare PtrSafe Function inet_ntoa Lib "wsock32.dll" _
(ByVal addr As LongPtr) As LongPtr
Private Declare PtrSafe Function lstrcpyA Lib "kernel32" _
(ByVal RetVal As String, _
ByVal Ptr As LongPtr) As LongPtr
Private Declare PtrSafe Function gethostname Lib "wsock32.dll" _
(ByVal szHost As String, _
ByVal dwHostLen As Long) As Long
Private Sub cmdGet_Click()
Dim sHostName As String
If SocketsInitialize() Then
'obtain and pass the host address to the function
Text1.Text = GetMachineName()
Text2.Text = GetIPFromHostName(Text1.Text)
SocketsCleanup
Else
MsgBox "Windows Sockets for 32 bit Windows " & _
"environments is not successfully responding."
End If
End Sub
Private Function SocketsInitialize() As Boolean
Dim WSAD As WSADATA
Dim success As Long
SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
End Function
Private Sub SocketsCleanup()
If WSACleanup() < 0 Then
MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
End If
End Sub
Private Function GetMachineName() As String
Dim sHostName As String * 256
If gethostname(sHostName, 256) = ERROR_SUCCESS Then
GetMachineName = Trim$(sHostName)
End If
End Function
Private Function GetIPFromHostName(ByVal sHostName As String) As String
'converts a host name to an IP address
Dim nbytes As LongPtr
Dim ptrHosent As LongPtr 'address of HOSENT structure
Dim ptrName As LongPtr 'address of name pointer
Dim ptrAddress As LongPtr 'address of address pointer
Dim ptrIPAddress As LongPtr
Dim ptrIPAddress2 As LongPtr
ptrHosent = gethostbyname(sHostName & vbNullChar)
If ptrHosent < 0 Then
'assign pointer addresses and offset
'Null-terminated list of addresses for the host.
'The Address is offset 12 bytes from the start of
'the HOSENT structure. Note: Here we are retrieving
'only the first address returned. To return more than
'one, define sAddress as a string array and loop through
'the 4-byte ptrIPAddress members returned. The last
'item is a terminating null. All addresses are returned
'in network byte order.
ptrAddress = ptrHosent + 24
'get the IP address
CopyMemory ptrAddress, ByVal ptrAddress, 8 '<----------------- Excel keeps crashing on this line!
CopyMemory ptrIPAddress, ByVal ptrAddress, 8
CopyMemory ptrIPAddress2, ByVal ptrIPAddress, 8
GetIPFromHostName = GetInetStrFromPtr(ptrIPAddress2)
End If
End Function
Private Function GetStrFromPtrA(ByVal lpszA As LongPtr) As String
GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
End Function
Private Function GetInetStrFromPtr(Address As LongPtr) As String
GetInetStrFromPtr = GetStrFromPtrA(inet_ntoa(Address))
End Function
------------------------------------------------------------------------------------------------------------------------------------
Many thanks,
Andrey G