Ping machines on Access 2016 64-bit

[Jürgen Meyer]

Windows 10 1809 64-bit and Access 2016 32-bit or 64-bit
The following code runs fine on a 32-bit Access, but crashes on 64 bit without
an error message.

I guess, that there is something wrong with my Declares but I can't find the
mistake.
Who sees the problem?

'------------------------------------------------
' Get IPs
'------------------------------------------------
#If Win64 Then
Private Type WSAdata
wVersion As Integer
wHighVersion As Integer
szDescription(0 To 255) As Byte
szSystemStatus(0 To 128) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As LongPtr
End Type

Private Type HOSTENT
h_name As LongPtr
h_aliases As LongPtr
h_addrtype As Integer
h_length As Integer
h_addr_list As LongPtr
End Type

Private Type IP_optINFORMATION
TTL As Byte
Tos As Byte
Flags As Byte
OptionsSize As LongPtr
OptionsData As String * 128
End Type

Private Type IP_ECHO_REPLY
Address(0 To 3) As Byte
Status As LongPtr
RoundTripTime As LongPtr
DataSize As Integer
Reserved As Integer
Data As LongPtr
Options As IP_optINFORMATION
End Type

Private Declare PtrSafe Function CopyMemory Lib "kernel32.dll" Alias
"RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
As LongPtr

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 IcmpCreateFile Lib "icmp.dll" () As LongPtr

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_optINFORMATION, ReplyBuffer As IP_ECHO_REPLY, _
ByVal ReplySize As LongPtr, ByVal TimeOut As LongPtr) As Boolean

Dim hHostent As HOSTENT, AddrList As LongPtr
Dim hFile As LongPtr, lpWSAdata As WSAdata
Dim Address As LongPtr, rIP As String

#Else
Private Type WSAdata
wVersion As Integer
wHighVersion As Integer
szDescription(0 To 255) As Byte
szSystemStatus(0 To 128) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type

Private Type HOSTENT
h_name As Long
h_aliases As Long
h_addrtype As Integer
h_length As Integer
h_addr_list As Long
End Type

Private Type IP_optINFORMATION
TTL As Byte
Tos As Byte
Flags As Byte
OptionsSize As Long
OptionsData As String * 128
End Type

Private Type IP_ECHO_REPLY
Address(0 To 3) As Byte
Status As Long
RoundTripTime As Long
DataSize As Integer
Reserved As Integer
Data As Long
Options As IP_optINFORMATION
End Type

Private Declare PtrSafe Function CopyMemory Lib "kernel32.dll" Alias
"RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) As
Long

Private Declare PtrSafe Function GetHostByName Lib "wsock32.dll" Alias
"gethostbyname" (ByVal HostName As String) As Long

Private Declare PtrSafe Function WSAStartup Lib "wsock32.dll" (ByVal
wVersionRequired&, lpWSAdata As WSAdata) As Long

Private Declare PtrSafe Function IcmpCreateFile Lib "icmp.dll" () As Long

Private Declare PtrSafe Function IcmpSendEcho Lib "ICMP" (ByVal IcmpHandle As
Long, ByVal DestAddress As Long, _
ByVal RequestData As String, ByVal RequestSize As Integer, _
RequestOptns As IP_optINFORMATION, ReplyBuffer As IP_ECHO_REPLY, _
ByVal ReplySize As Long, ByVal TimeOut As Long) As Boolean

Dim hHostent As HOSTENT, AddrList As Long
Dim hFile As Long, lpWSAdata As WSAdata
Dim Address As Long, rIP As String
#End If

Private Const SOCKET_ERROR = 0

Function Test()
Dim Server As String
Server = "Laptop1"
Call Ping(Server)
End Function

Public Function Ping(ByVal Server As String)

Dim OptInfo As IP_optINFORMATION
Dim EchoReply As IP_ECHO_REPLY
Dim HostName As String

Ping = -1 'Return value set to -1

Server = Replace(Server, "http://", vbNullString)
Server = Replace(Server, "ftp://", vbNullString)
Server = Replace(Server, "/", vbNullString)
If InStr(1, Server, ":") <> 0 Then
Server = Mid$(Server, 1, InStr(1, Server, ":") - 1)
End If

Call WSAStartup(&H101, lpWSAdata)

If GetHostByName(Server + String(64 - Len(Server), 0)) <> SOCKET_ERROR Then
CopyMemory hHostent.h_name, ByVal GetHostByName(Server + String(64 -
Len(Server), 0)), Len(hHostent)

Stop
'In the next two lines Access crashes using 64 bit
CopyMemory AddrList, ByVal hHostent.h_addr_list, 4
CopyMemory Address, ByVal AddrList, 4
End If

hFile = IcmpCreateFile()
If hFile = 0 Then
'Cancel on error
Exit Function
End If

OptInfo.TTL = 255

'Send Ping
If IcmpSendEcho(hFile, Address, String(32, "0"), 32, OptInfo, EchoReply,
Len(EchoReply) + 8, 1000) Then
rIP = CStr(EchoReply.Address(0)) + "." + CStr(EchoReply.Address(1)) + "." +
CStr(EchoReply.Address(2)) + "." + CStr(EchoReply.Address(3))
If EchoReply.Status = 0 Then Ping = EchoReply.RoundTripTime
End If
End Function


Regards
Juergen

[Ron Paii]

That's a lot of code to review, have you tried stepping though the code to see what line is failing?

Try reviewing Microsoft's information for 32bit/64bit coding in VBA.

https://docs.microsoft.com/en-us/office/vba/Language/Concepts/Getting-Started/64-bit-visual-basic-for-applications-overview

You may want to use
#If VBA7 Then instead of Win64

[Jürgen Meyer]

On Mon, 20 May 2019 07:07:36 -0700 (PDT), "Ron Paii" posted:

Thanks for answering

>That's a lot of code to review, have you tried stepping though the code to see what line is failing?

Yes
You will find it in the code

I wrote:

> 'In the next two lines Access crashes using 64 bit

>I placed a Stop there

> CopyMemory AddrList, ByVal hHostent.h_addr_list, 4
> CopyMemory Address, ByVal AddrList, 4

> #If VBA7 Then instead of Win64

I tried this too.
No difference

Juergen

[Jürgen Meyer]

Is the problem reproduceable?
Possibly it happens only on my PC.
Pls. copy and try

regards
Juergen

[Ron Paii]

Search the web for rtlmovememory in 64bit VBA. It must not be happy with the memory objects you are passing. I would create a test function to see if you can pass other memory objects to the system function.

[Jürgen Meyer]

On Wed, 22 May 2019 15:05:09 +0200, "Jürgen Meyer" posted:

I now have seen in the event protocol that Access is calling the
C:\Windows\SYSTEM32\ntdll.dll before crashing

In my opinion, Access should call C:\Windows\SysWOW64\ntdll.dll
Might this cause the problem?

No one tried the code until now?

Juergen

[Ron Paii]

C:\Windows\SYSTEM32\ntdll.dll would be the 64bit version. SysWOW64 stores the 32bit versions

[Jürgen Meyer]

>C:\Windows\SYSTEM32\ntdll.dll would be the 64bit version. SysWOW64 stores the 32bit versions

Tnx for information
I didn't know that.

So the call is correct and there must be another reason for that behaviour.

Juergen

[internet...@foobox.com]

Don't you just love Microsoft! Who else would have thought of putting the 64 bit version in SYSTEM32 and the 32 bit version in SYSWOW64 ?

[Ron Paii]

It probably for backward compatibly with 32bit systems. "Program Files (x86) and "SYSWOW64" only exist on 64bit windows. Not changing folder names save a lot of software edits. If I remember correctly "System32" was add during the transition from 16bit to 32bit windows. For some "Fun" reading lookup "Thunking 32bit to 16bit".

[Jürgen Meyer]

On Wed, 22 May 2019 12:00:05 -0700 (PDT), "Ron Paii" posted:

Ok, but why it runs fine on 32 bit?
The same objects are passed.

Just upgraded from Windows 1809 to 1903
Still the same problem.
In the Event Protocol I see:

Name der fehlerhaften Anwendung: MSACCESS.EXE, Version: 16.0.4813.1000,
Zeitstempel: 0x5c476102
Name des fehlerhaften Moduls: ntdll.dll, Version: 10.0.18362.113, Zeitstempel:
0x3817fba9
Ausnahmecode: 0xc0000005
Fehleroffset: 0x00000000000a2e20
ID des fehlerhaften Prozesses: 0x18d0
Startzeit der fehlerhaften Anwendung: 0x01d516050d1876e2
Pfad der fehlerhaften Anwendung: C:\Program Files\Microsoft
Office\Office16\MSACCESS.EXE
Pfad des fehlerhaften Moduls: C:\WINDOWS\SYSTEM32\ntdll.dll

Sorry, I have German versions of Windows and Access

Ausnahmecode: Exception code
fehlerhaften = faulty
Fehleroffset = Error Offset
Pfad = path

Juergen