I am sending semi automated emails within my access database using our companies internal smtp server.
One of the issues I had was capturing whether people were connected to the lan to be able to send these emails.
I decided to use a ping to test whether the server was giving a response, if it was then they must be connected and if not then they arent.
The ping code is as follows: - Option Explicit
-
'Ping function. Original Source code taken from www.allapi.com.
-
'Modified into a function and tested for VBA compatability by Jeminar 22May04
-
-
-
Const SOCKET_ERROR = 0
-
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_OPTION_INFORMATION
-
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_OPTION_INFORMATION
-
End Type
-
Private Declare Function gethostbyname Lib "wsock32.dll" (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(ByVal hostname As String) As Long
-
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(hostname + String(64 - Len(hostname), 0)) <> SOCKET_ERROR Then
-
CopyMemory hHostent.h_name, ByVal gethostbyname(hostname + String(64 - Len(hostname), 0)), Len(hHostent)
-
CopyMemory AddrList, ByVal hHostent.h_addr_list, 4
-
CopyMemory Address, ByVal AddrList, 4
-
End If
-
hFile = IcmpCreateFile()
-
If hFile = 0 Then
-
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, 2000) Then
-
rIP = CStr(EchoReply.Address(0)) + "." + CStr(EchoReply.Address(1)) + "." + _
-
CStr(EchoReply.Address(2)) + "." + CStr(EchoReply.Address(3))
-
Else
-
End If
-
If EchoReply.status = 0 Then
-
Ping = EchoReply.RoundTripTime
-
Else
-
Ping = -1
-
End If
-
Call IcmpCloseHandle(hFile)
-
Call WSACleanup
-
End Function
-
-
This worked perfeclty fine when I was working from home, the ping was not being returned so ofcourse the smtp server was unavailable.
I also tested the ping against different websites and I was returned pings with as expected latency values.
I have now come in to work and my code, even though connected to the network is returning 0 for the ping of the smtp.
This is causing my email sending script to believe that there is not a connection to the smtp server: - SMTPName = ELookup("[SettingValue]", "tblDBSettings", "[SettingName]='SMTPServer'")
-
-
'Check to see if we are connected to the smtp server if not then exit this function
-
If Ping(" & SMTPName & ") = -1 Then
-
MsgBox "You are not connected to the network. For further help contact database admin.", vbInformation, "Error in Email"
-
Exit Function
-
Else
-
SMTPUser = ELookup("[SettingValue]", "tblDBSettings", "[SettingName]='SMTPUser'")
-
SMTPPass = ELookup("[SettingValue]", "tblDBSettings", "[SettingName]='SMTPPass'")
-
End If
However as the above code shows I explicity state -1 value has to be returned. But for some reason 0 also causes the msgbox to pop up :|
I have tried pinging various websites using the code in the 1st part of this post and they all return -1, whereas they did not when I was at home. Any ideas why this might be happening?
=== Edit
After a bit more testing it seems the value returning 0 jsut means there is 0 latency due to the nserver being within my network: - ?GetHostNameFromIP("137.xxx.xx.101")
-
NUTS1ETA
-
?GetHostNameFromIP("137.xxx.xx.83")
-
w7bc-p1595.xxx.xxxxx.net
-
?ping("w7bc-p1595.xxx.xxxxx.net")
-
output: 0
-
?ping("NUTS1ETA")
-
output: 0
-
?ping("http://www.yahoo.com")
-
output: -1
-
?ping("yahoo.com")
-
output: -1
NUTS1ETA is the SMTP server where the full address is: NUTS1ETA.xxx.xxxxx.net
w7bc-p1595 is my computer. Both pings and lookups via IP cause a value of 0 to be returned. Weirdly though I do not know why I can not ping normal websites such as www.yahoo.com etc.. they all return a -1 yet when I am at home they return a value such as 40, 74, 88 etc etc which I assumed were milliseconds for the ping reply.
I forgot to update this thread with the working code. Note there are a quite a few functions in this.
The most basic is PingHost which I adapted to be more userfriendly than the Ping function. Just supply a host name and it will return the result.
To work out what the result translates in to use the constants at the top of the script. For example a ping of 11010 result would be Ip_status_base + 10 = ip request timed out
A result of 0 is a succesful ping and you know the connection is free and returning data. - Option Compare Database
-
Option Explicit
-
-
-
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
-
' Copyright ©1996-2009 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 IP_STATUS_BASE As Long = 11000
-
Private Const IP_BUF_TOO_SMALL As Long = (IP_STATUS_BASE + 1)
-
Private Const IP_DEST_NET_UNREACHABLE As Long = (IP_STATUS_BASE + 2)
-
Private Const IP_DEST_HOST_UNREACHABLE As Long = (IP_STATUS_BASE + 3)
-
Private Const IP_DEST_PROT_UNREACHABLE As Long = (IP_STATUS_BASE + 4)
-
Private Const IP_DEST_PORT_UNREACHABLE As Long = (IP_STATUS_BASE + 5)
-
Private Const IP_NO_RESOURCES As Long = (IP_STATUS_BASE + 6)
-
Private Const IP_BAD_OPTION As Long = (IP_STATUS_BASE + 7)
-
Private Const IP_HW_ERROR As Long = (IP_STATUS_BASE + 8)
-
Private Const IP_PACKET_TOO_BIG As Long = (IP_STATUS_BASE + 9)
-
Private Const IP_REQ_TIMED_OUT As Long = (IP_STATUS_BASE + 10)
-
Private Const IP_BAD_REQ As Long = (IP_STATUS_BASE + 11)
-
Private Const IP_BAD_ROUTE As Long = (IP_STATUS_BASE + 12)
-
Private Const IP_TTL_EXPIRED_TRANSIT As Long = (IP_STATUS_BASE + 13)
-
Private Const IP_TTL_EXPIRED_REASSEM As Long = (IP_STATUS_BASE + 14)
-
Private Const IP_PARAM_PROBLEM As Long = (IP_STATUS_BASE + 15)
-
Private Const IP_SOURCE_QUENCH As Long = (IP_STATUS_BASE + 16)
-
Private Const IP_OPTION_TOO_BIG As Long = (IP_STATUS_BASE + 17)
-
Private Const IP_BAD_DESTINATION As Long = (IP_STATUS_BASE + 18)
-
Private Const IP_ADDR_DELETED As Long = (IP_STATUS_BASE + 19)
-
Private Const IP_SPEC_MTU_CHANGE As Long = (IP_STATUS_BASE + 20)
-
Private Const IP_MTU_CHANGE As Long = (IP_STATUS_BASE + 21)
-
Private Const IP_UNLOAD As Long = (IP_STATUS_BASE + 22)
-
Private Const IP_ADDR_ADDED As Long = (IP_STATUS_BASE + 23)
-
Private Const IP_GENERAL_FAILURE As Long = (IP_STATUS_BASE + 50)
-
Private Const MAX_IP_STATUS As Long = (IP_STATUS_BASE + 50)
-
Private Const IP_PENDING As Long = (IP_STATUS_BASE + 255)
-
Private Const PING_TIMEOUT As Long = 500
-
Private Const WS_VERSION_REQD As Long = &H101
-
Private Const MIN_SOCKETS_REQD As Long = 1
-
Private Const SOCKET_ERROR As Long = -1
-
Private Const INADDR_NONE As Long = &HFFFFFFFF
-
Private Const MAX_WSADescription As Long = 256
-
Private Const MAX_WSASYSStatus As Long = 128
-
-
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 Type ICMP_OPTIONS
-
Ttl As Byte
-
Tos As Byte
-
Flags As Byte
-
OptionsSize As Byte
-
OptionsData As Long
-
End Type
-
-
Private Type ICMP_ECHO_REPLY
-
Address As Long
-
status As Long
-
RoundTripTime As Long
-
DataSize As Long
-
'Reserved As Integer
-
DataPointer As Long
-
Options As ICMP_OPTIONS
-
Data As String * 250
-
End Type
-
-
Private Declare Function gethostbyname Lib "wsock32" _
-
(ByVal hostname As String) As Long
-
-
Private Declare Sub CopyMemory Lib "kernel32" _
-
Alias "RtlMoveMemory" _
-
(xDest As Any, _
-
xSource As Any, _
-
ByVal nbytes As Long)
-
-
Private Declare Function lstrlenA Lib "kernel32" _
-
(lpString As Any) As Long
-
-
Private Declare Function WSAStartup Lib "wsock32" _
-
(ByVal wVersionRequired As Long, _
-
lpWSADATA As WSADATA) As Long
-
-
Private Declare Function WSACleanup Lib "wsock32" () As Long
-
-
Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
-
-
Private Declare Function IcmpCloseHandle Lib "icmp.dll" _
-
(ByVal IcmpHandle As Long) As Long
-
-
Private Declare Function IcmpSendEcho Lib "icmp.dll" _
-
(ByVal IcmpHandle As Long, _
-
ByVal DestinationAddress As Long, _
-
ByVal RequestData As String, _
-
ByVal RequestSize As Long, _
-
ByVal RequestOptions As Long, _
-
ReplyBuffer As ICMP_ECHO_REPLY, _
-
ByVal ReplySize As Long, _
-
ByVal TimeOut As Long) As Long
-
-
Private Declare Function inet_addr Lib "wsock32" _
-
(ByVal s As String) As Long
-
-
Private Declare Function inet_ntoa Lib "wsock32.dll" _
-
(ByVal addr As Long) As Long
-
-
Private Declare Function lstrcpyA Lib "kernel32" _
-
(ByVal RetVal As String, _
-
ByVal Ptr As Long) As Long
-
-
-
Public Function pinghost(host As String) As String
-
-
Dim ECHO As ICMP_ECHO_REPLY
-
Dim pos As Long
-
Dim success As Long
-
Dim sIPAddress As String
-
-
If SocketsInitialize() Then
-
'convert the host name into an IP address
-
sIPAddress = GetIPFromHostName(host)
-
'ping the ip passing the address, text
-
'to use, and the ECHO structure
-
success = ping(sIPAddress, "Some text to send", ECHO)
-
'display the results
-
pinghost = success
-
SocketsCleanup
-
Else
-
Exit Function
-
End If
-
-
End Function
-
-
-
Private Function ping(sAddress As String, _
-
sDataToSend As String, _
-
ECHO As ICMP_ECHO_REPLY) As Long
-
'If Ping fails .Status will be the error code
-
Dim hPort As Long
-
Dim dwAddress As Long
-
-
'convert the address into a long representation
-
dwAddress = inet_addr(sAddress)
-
-
'if dwAddress is valid
-
If dwAddress <> INADDR_NONE Then
-
-
'open a port
-
hPort = IcmpCreateFile()
-
-
'and if successful,
-
If hPort Then
-
-
'ping it.
-
Call IcmpSendEcho(hPort, _
-
dwAddress, _
-
sDataToSend, _
-
Len(sDataToSend), _
-
0, _
-
ECHO, _
-
Len(ECHO), _
-
PING_TIMEOUT)
-
-
'return the status as ping success
-
ping = ECHO.status
-
-
'close the port handle
-
Call IcmpCloseHandle(hPort)
-
-
End If 'If hPort
-
-
Else
-
-
'the address format was probably invalid
-
ping = INADDR_NONE
-
-
End If
-
-
End Function
-
-
-
-
-
-
Private Function GetIPFromHostName(ByVal sHostName As String) As String
-
-
'converts a host name to an IP address
-
Dim ptrHosent As Long 'address of HOSENT structure
-
Dim ptrName As Long 'address of name pointer
-
Dim ptrAddress As Long 'address of address pointer
-
Dim ptrIPAddress As Long
-
Dim ptrIPAddress2 As Long
-
-
ptrHosent = gethostbyname(sHostName & vbNullChar)
-
-
If ptrHosent <> 0 Then
-
-
ptrName = ptrHosent
-
-
ptrAddress = ptrHosent + 12
-
-
'get the IP address
-
CopyMemory ptrName, ByVal ptrName, 4
-
CopyMemory ptrAddress, ByVal ptrAddress, 4
-
CopyMemory ptrIPAddress, ByVal ptrAddress, 4
-
CopyMemory ptrIPAddress2, ByVal ptrIPAddress, 4
-
-
GetIPFromHostName = GetInetStrFromPtr(ptrIPAddress2)
-
-
End If
-
-
End Function
-
-
-
Private Function GetStrFromPtrA(ByVal lpszA As Long) As String
-
-
GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
-
Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
-
-
End Function
-
-
-
Private Function GetInetStrFromPtr(Address As Long) As String
-
-
GetInetStrFromPtr = GetStrFromPtrA(inet_ntoa(Address))
-
-
End Function
-
-
-
Private Sub SocketsCleanup()
-
-
If WSACleanup() <> 0 Then
-
MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
-
End If
-
-
End Sub
-
-
-
Private Function SocketsInitialize() As Boolean
-
-
Dim WSAD As WSADATA
-
-
SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
-
-
End Function
-
-
6 8148
Ping(" & SMTPName & ")
should be
Ping("" & SMTPName & "")
I don't know why you are concatenating empty strings though.
NeoPa 32,556
Expert Mod 16PB
I couldn't find any valid link that the source came from. This is not really a VBA or Access issue. It's the code itself you're using. I would suggest going back to where you got it and seeing if there is any documentation on usage and interpretation of results. I believe you may be misinterpreting what you're getting, but I can't proceed further without access to the original pages.
As neopa suggested it is the code. I have been doing a bit more research around all of this and the problem was that the original code was adapted from some vbnet script. Atfer digging around I found some very similar code which needed to also be adapted (my first ever try) and discovered that the -1 and the 0 are not actually a ping as in ms returned values but they are codes.
There are around 15 different codes that can be returned where -1 is a socket error which means a connection can not even be made to the host/ip you are trying to ping.
0 is a succesful connection and everything else above 0 references another error code I think the highest is around 25.
Now moving on to my network when I run a ping command through the comamnd prompt I can not return a result. I think this is purely down to my network blocking outgoing pings or something along those lines. Luckily this is no issue for pinging servers currently within my domain area where the smtp server is
I will post up my adapted code when I am at work tomorrow which also can output other information regarding the ping such as the latency, ip address and traceroute.
NeoPa 32,556
Expert Mod 16PB
That sounds like a good result. Let us know if further help is sought after posting the code, or whether (as I think you're saying) the issue is now successfully resolved.
I forgot to update this thread with the working code. Note there are a quite a few functions in this.
The most basic is PingHost which I adapted to be more userfriendly than the Ping function. Just supply a host name and it will return the result.
To work out what the result translates in to use the constants at the top of the script. For example a ping of 11010 result would be Ip_status_base + 10 = ip request timed out
A result of 0 is a succesful ping and you know the connection is free and returning data. - Option Compare Database
-
Option Explicit
-
-
-
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
-
' Copyright ©1996-2009 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 IP_STATUS_BASE As Long = 11000
-
Private Const IP_BUF_TOO_SMALL As Long = (IP_STATUS_BASE + 1)
-
Private Const IP_DEST_NET_UNREACHABLE As Long = (IP_STATUS_BASE + 2)
-
Private Const IP_DEST_HOST_UNREACHABLE As Long = (IP_STATUS_BASE + 3)
-
Private Const IP_DEST_PROT_UNREACHABLE As Long = (IP_STATUS_BASE + 4)
-
Private Const IP_DEST_PORT_UNREACHABLE As Long = (IP_STATUS_BASE + 5)
-
Private Const IP_NO_RESOURCES As Long = (IP_STATUS_BASE + 6)
-
Private Const IP_BAD_OPTION As Long = (IP_STATUS_BASE + 7)
-
Private Const IP_HW_ERROR As Long = (IP_STATUS_BASE + 8)
-
Private Const IP_PACKET_TOO_BIG As Long = (IP_STATUS_BASE + 9)
-
Private Const IP_REQ_TIMED_OUT As Long = (IP_STATUS_BASE + 10)
-
Private Const IP_BAD_REQ As Long = (IP_STATUS_BASE + 11)
-
Private Const IP_BAD_ROUTE As Long = (IP_STATUS_BASE + 12)
-
Private Const IP_TTL_EXPIRED_TRANSIT As Long = (IP_STATUS_BASE + 13)
-
Private Const IP_TTL_EXPIRED_REASSEM As Long = (IP_STATUS_BASE + 14)
-
Private Const IP_PARAM_PROBLEM As Long = (IP_STATUS_BASE + 15)
-
Private Const IP_SOURCE_QUENCH As Long = (IP_STATUS_BASE + 16)
-
Private Const IP_OPTION_TOO_BIG As Long = (IP_STATUS_BASE + 17)
-
Private Const IP_BAD_DESTINATION As Long = (IP_STATUS_BASE + 18)
-
Private Const IP_ADDR_DELETED As Long = (IP_STATUS_BASE + 19)
-
Private Const IP_SPEC_MTU_CHANGE As Long = (IP_STATUS_BASE + 20)
-
Private Const IP_MTU_CHANGE As Long = (IP_STATUS_BASE + 21)
-
Private Const IP_UNLOAD As Long = (IP_STATUS_BASE + 22)
-
Private Const IP_ADDR_ADDED As Long = (IP_STATUS_BASE + 23)
-
Private Const IP_GENERAL_FAILURE As Long = (IP_STATUS_BASE + 50)
-
Private Const MAX_IP_STATUS As Long = (IP_STATUS_BASE + 50)
-
Private Const IP_PENDING As Long = (IP_STATUS_BASE + 255)
-
Private Const PING_TIMEOUT As Long = 500
-
Private Const WS_VERSION_REQD As Long = &H101
-
Private Const MIN_SOCKETS_REQD As Long = 1
-
Private Const SOCKET_ERROR As Long = -1
-
Private Const INADDR_NONE As Long = &HFFFFFFFF
-
Private Const MAX_WSADescription As Long = 256
-
Private Const MAX_WSASYSStatus As Long = 128
-
-
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 Type ICMP_OPTIONS
-
Ttl As Byte
-
Tos As Byte
-
Flags As Byte
-
OptionsSize As Byte
-
OptionsData As Long
-
End Type
-
-
Private Type ICMP_ECHO_REPLY
-
Address As Long
-
status As Long
-
RoundTripTime As Long
-
DataSize As Long
-
'Reserved As Integer
-
DataPointer As Long
-
Options As ICMP_OPTIONS
-
Data As String * 250
-
End Type
-
-
Private Declare Function gethostbyname Lib "wsock32" _
-
(ByVal hostname As String) As Long
-
-
Private Declare Sub CopyMemory Lib "kernel32" _
-
Alias "RtlMoveMemory" _
-
(xDest As Any, _
-
xSource As Any, _
-
ByVal nbytes As Long)
-
-
Private Declare Function lstrlenA Lib "kernel32" _
-
(lpString As Any) As Long
-
-
Private Declare Function WSAStartup Lib "wsock32" _
-
(ByVal wVersionRequired As Long, _
-
lpWSADATA As WSADATA) As Long
-
-
Private Declare Function WSACleanup Lib "wsock32" () As Long
-
-
Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
-
-
Private Declare Function IcmpCloseHandle Lib "icmp.dll" _
-
(ByVal IcmpHandle As Long) As Long
-
-
Private Declare Function IcmpSendEcho Lib "icmp.dll" _
-
(ByVal IcmpHandle As Long, _
-
ByVal DestinationAddress As Long, _
-
ByVal RequestData As String, _
-
ByVal RequestSize As Long, _
-
ByVal RequestOptions As Long, _
-
ReplyBuffer As ICMP_ECHO_REPLY, _
-
ByVal ReplySize As Long, _
-
ByVal TimeOut As Long) As Long
-
-
Private Declare Function inet_addr Lib "wsock32" _
-
(ByVal s As String) As Long
-
-
Private Declare Function inet_ntoa Lib "wsock32.dll" _
-
(ByVal addr As Long) As Long
-
-
Private Declare Function lstrcpyA Lib "kernel32" _
-
(ByVal RetVal As String, _
-
ByVal Ptr As Long) As Long
-
-
-
Public Function pinghost(host As String) As String
-
-
Dim ECHO As ICMP_ECHO_REPLY
-
Dim pos As Long
-
Dim success As Long
-
Dim sIPAddress As String
-
-
If SocketsInitialize() Then
-
'convert the host name into an IP address
-
sIPAddress = GetIPFromHostName(host)
-
'ping the ip passing the address, text
-
'to use, and the ECHO structure
-
success = ping(sIPAddress, "Some text to send", ECHO)
-
'display the results
-
pinghost = success
-
SocketsCleanup
-
Else
-
Exit Function
-
End If
-
-
End Function
-
-
-
Private Function ping(sAddress As String, _
-
sDataToSend As String, _
-
ECHO As ICMP_ECHO_REPLY) As Long
-
'If Ping fails .Status will be the error code
-
Dim hPort As Long
-
Dim dwAddress As Long
-
-
'convert the address into a long representation
-
dwAddress = inet_addr(sAddress)
-
-
'if dwAddress is valid
-
If dwAddress <> INADDR_NONE Then
-
-
'open a port
-
hPort = IcmpCreateFile()
-
-
'and if successful,
-
If hPort Then
-
-
'ping it.
-
Call IcmpSendEcho(hPort, _
-
dwAddress, _
-
sDataToSend, _
-
Len(sDataToSend), _
-
0, _
-
ECHO, _
-
Len(ECHO), _
-
PING_TIMEOUT)
-
-
'return the status as ping success
-
ping = ECHO.status
-
-
'close the port handle
-
Call IcmpCloseHandle(hPort)
-
-
End If 'If hPort
-
-
Else
-
-
'the address format was probably invalid
-
ping = INADDR_NONE
-
-
End If
-
-
End Function
-
-
-
-
-
-
Private Function GetIPFromHostName(ByVal sHostName As String) As String
-
-
'converts a host name to an IP address
-
Dim ptrHosent As Long 'address of HOSENT structure
-
Dim ptrName As Long 'address of name pointer
-
Dim ptrAddress As Long 'address of address pointer
-
Dim ptrIPAddress As Long
-
Dim ptrIPAddress2 As Long
-
-
ptrHosent = gethostbyname(sHostName & vbNullChar)
-
-
If ptrHosent <> 0 Then
-
-
ptrName = ptrHosent
-
-
ptrAddress = ptrHosent + 12
-
-
'get the IP address
-
CopyMemory ptrName, ByVal ptrName, 4
-
CopyMemory ptrAddress, ByVal ptrAddress, 4
-
CopyMemory ptrIPAddress, ByVal ptrAddress, 4
-
CopyMemory ptrIPAddress2, ByVal ptrIPAddress, 4
-
-
GetIPFromHostName = GetInetStrFromPtr(ptrIPAddress2)
-
-
End If
-
-
End Function
-
-
-
Private Function GetStrFromPtrA(ByVal lpszA As Long) As String
-
-
GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
-
Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
-
-
End Function
-
-
-
Private Function GetInetStrFromPtr(Address As Long) As String
-
-
GetInetStrFromPtr = GetStrFromPtrA(inet_ntoa(Address))
-
-
End Function
-
-
-
Private Sub SocketsCleanup()
-
-
If WSACleanup() <> 0 Then
-
MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
-
End If
-
-
End Sub
-
-
-
Private Function SocketsInitialize() As Boolean
-
-
Dim WSAD As WSADATA
-
-
SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
-
-
End Function
-
-
NeoPa 32,556
Expert Mod 16PB
I appreciate your setting my post as the best answer Munkee, but in this instance I doubt it will prove very helpful to others on a similar quest (I'm glad it helped you of course :-)). For that reason I'm going to reset the Best Answer. I suggest you go ahead and set your most recent post (#6) as the Best Answer instead. That has more useful information in it and is more likely to prove useful to searchers after similar material.
Sign in to post your reply or Sign up for a free account.
Similar topics
by: Andy Turner |
last post by:
Hi, I'm trying to setup PHP so it will use a remote SMTP server.
I'm going to sound like a newbie but how? I know you need to alter
php.ini, change SMTP from localhost to the SMTP server and the...
|
by: Nancy |
last post by:
Hi, Guys,
Is there any other way to use python or mod_python writing a web page?
I mean, not use "form.py/email", no SMTP server.
<form action="form.py/email" method="POST"> ...
Thanks a lot.
...
|
by: M P |
last post by:
Need help! Whats wrong with my code? My plan is this, I have my IIS5.0 on
Server A and then I will use SMTP service of Server B. I already configured
IIS to use Server B as its SMTP Server but I...
|
by: ahager via DotNetMonster.com |
last post by:
I am receiving this messaage in a console application I wrote, I am
authenticating, and my network admin swears their is nothing wrong with the
smtp server. Any ideas?
public void Mail_update()...
|
by: antonyliu2002 |
last post by:
I've set up the virtual smtp server on my IIS 5.1 like so:
1. Assign IP address to "All Unassigned", and listen to port 25.
2. Access Connection granted to "127.0.0.1".
3. Relay only allow...
|
by: Charles Arthur |
last post by:
How do i turn on java script on a villaon, callus and itel keypad mobile phone
|
by: ryjfgjl |
last post by:
If we have dozens or hundreds of excel to import into the database, if we use the excel import function provided by database editors such as navicat, it will be extremely tedious and time-consuming...
|
by: emmanuelkatto |
last post by:
Hi All, I am Emmanuel katto from Uganda. I want to ask what challenges you've faced while migrating a website to cloud.
Please let me know.
Thanks!
Emmanuel
|
by: BarryA |
last post by:
What are the essential steps and strategies outlined in the Data Structures and Algorithms (DSA) roadmap for aspiring data scientists? How can individuals effectively utilize this roadmap to progress...
|
by: Hystou |
last post by:
There are some requirements for setting up RAID:
1. The motherboard and BIOS support RAID configuration.
2. The motherboard has 2 or more available SATA protocol SSD/HDD slots (including MSATA, M.2...
|
by: Hystou |
last post by:
Most computers default to English, but sometimes we require a different language, especially when relocating. Forgot to request a specific language before your computer shipped? No problem! You can...
|
by: Oralloy |
last post by:
Hello folks,
I am unable to find appropriate documentation on the type promotion of bit-fields when using the generalised comparison operator "<=>".
The problem is that using the GNU compilers,...
|
by: jinu1996 |
last post by:
In today's digital age, having a compelling online presence is paramount for businesses aiming to thrive in a competitive landscape. At the heart of this digital strategy lies an intricately woven...
|
by: Hystou |
last post by:
Overview:
Windows 11 and 10 have less user interface control over operating system update behaviour than previous versions of Windows. In Windows 11 and 10, there is no way to turn off the Windows...
| |