Bugs in WIN NT PIng utility!

[Garry]

I am trying to Ping a server using a Vb app on Win NT workstation. My App works fine on Win 95 and the server is up and running fine. But I get bad destimnation error. I found out that this may be due to a bug in WIN NT that's what they say on Microsoft site and they have asked to downlaod new Service Pack . I did but still it did not help.

Can anybody tell me the reason?
I don't know if this is the right palce to ask.

Thanks !

Garry

[Crazy D @ Work]

Can you post some code so we can try it?
It's NT 4 you're using? Service Pack 5?
Vb6? Service Pack 3?
Is it a server on your network you're trying to ping?

Crazy D @ Work :-)

[Garry]

I am using WIN NT 4.0 Service Pack 6.0. here is some of the code and VB6.
yes the server is on the network.

ping call
1)Open "c:\pingserv.INI" For Input As #1
Do While Not EOF(1)
Line Input #1, servername
'If Not Ping(loudec1, lsReturnMsg) = 0 Then
' MsgBox " Pingserver"
If Not Ping(servername, lsReturnMsg) = 0 Then
MsgBox "Ping failed for servername. Return message: " & lsReturnMsg


Else
MsgBox "Ping successful for the servers. Return message: " & lsReturnMsg

poSendMail.SMTPHost = "xyz.abc.com"
MsgBox "After SMTPhost. "

poSendMail.From = "xyz.abc.com"
MsgBox "After from. "
poSendMail.FromDisplayName = "LOUDEC1"
poSendMail.Recipient = "xyz@abc.com"
poSendMail.RecipientDisplayName = "gb"
'poSendMail.ReplyToAddress = txtFrom.Text
poSendMail.Subject = "Ping_failed!"
poSendMail.Message = "Ping to servers has failed please check the server"
poSendMail.Send
End If
Loop
Close #1


End Sub
Private Sub Form_Initialize()

Set poSendMail = New SendMail.clsSendMail

End Sub
2) Function
Option Explicit

' IP_STATUS codes returned from IP APIs
Private Const IP_STATUS_BASE = 11000
Private Const IP_SUCCESS = 0
Private Const IP_BUF_TOO_SMALL = (11000 + 1)
Private Const IP_DEST_NET_UNREACHABLE = (11000 + 2)
Private Const IP_DEST_HOST_UNREACHABLE = (11000 + 3)
Private Const IP_DEST_PROT_UNREACHABLE = (11000 + 4)
Private Const IP_DEST_PORT_UNREACHABLE = (11000 + 5)
Private Const IP_NO_RESOURCES = (11000 + 6)
Private Const IP_BAD_OPTION = (11000 + 7)
Private Const IP_HW_ERROR = (11000 + 8)
Private Const IP_PACKET_TOO_BIG = (11000 + 9)
Private Const IP_REQ_TIMED_OUT = (11000 + 10)
Private Const IP_BAD_REQ = (11000 + 11)
Private Const IP_BAD_ROUTE = (11000 + 12)
Private Const IP_TTL_EXPIRED_TRANSIT = (11000 + 13)
Private Const IP_TTL_EXPIRED_REASSEM = (11000 + 14)
Private Const IP_PARAM_PROBLEM = (11000 + 15)
Private Const IP_SOURCE_QUENCH = (11000 + 16)
Private Const IP_OPTION_TOO_BIG = (11000 + 17)
Private Const IP_BAD_DESTINATION = (11000 + 18)

' The next group are status codes passed up on status
' indications to transport layer protocols.
Private Const IP_ADDR_DELETED = (11000 + 19)
Private Const IP_SPEC_MTU_CHANGE = (11000 + 20)
Private Const IP_MTU_CHANGE = (11000 + 21)
Private Const IP_UNLOAD = (11000 + 22)
Private Const IP_ADDR_ADDED = (11000 + 23)
Private Const IP_GENERAL_FAILURE = (11000 + 50)
Private Const MAX_IP_STATUS = 11000 + 50
Private Const IP_PENDING = (11000 + 255)

' Option information for network ping.
Private Type ip_option_information
Ttl As Byte 'Time To Live
Tos As Byte 'Type Of Service
Flags As Byte 'IP header flags
OptionsSize As Byte 'Size in bytes of options data
OptionsData As Long 'Pointer to options data
End Type

' Structure that is returned from the ping to give status
' and error information
Private Type icmp_echo_reply
Address As Long 'Replying address
Status As Long 'Reply IP_STATUS, values as defined above
RoundTripTime As Long 'RTT in milliseconds
DataSize As Integer 'Reply data size in bytes
Reserved As Integer 'Reserved for system use
DataPointer As Long 'Pointer to the reply data
Options As ip_option_information 'Reply options
Data As String * 250 'Reply data which should be a copy of the string sent, NULL terminated
' this field length should be large enough to contain the string sent
End Type

' Declares for function to be used from icmp.dll
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 Integer, _
RequestOptions As ip_option_information, _
ReplyBuffer As icmp_echo_reply, _
ByVal ReplySize As Long, _
ByVal TimeOut As Long) As Long

Private Const PING_TIMEOUT = 4000 ' number of milliseconds to wait for the reply
Private Const WSADESCRIPTION_LEN = 256
Private Const WSASYSSTATUS_LEN = 256
Private Const WSADESCRIPTION_LEN_1 = WSADESCRIPTION_LEN + 1
Private Const WSASYSSTATUS_LEN_1 = WSASYSSTATUS_LEN + 1
Private Const SOCKET_ERROR = -1

Private Type tagWSAData
wVersion As Integer
wHighVersion As Integer
szDescription As String * WSADESCRIPTION_LEN_1
szSystemStatus As String * WSASYSSTATUS_LEN_1
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As String * 200
End Type

Private Declare Function WSAStartup Lib "wsock32" (ByVal wVersionRequested As Integer, lpWSAData As tagWSAData) As Integer
Private Declare Function WSACleanup Lib "wsock32" () As Integer


Public Function Ping(sIPAddress As String, sReturnMessage As String) As Long

Dim hFile As Long ' handle for the icmp port opened
Dim lRet As Long ' hold return values as required
Dim lIPAddress As Long
Dim sMessage As String
Dim pOptions As ip_option_information
Dim pReturn As icmp_echo_reply
Dim iVal As Integer
Dim lPingRet As Long
Dim pWsaData As tagWSAData

sMessage = "Echo this string of data"

iVal = WSAStartup(&H101, pWsaData)

' Convert the IP address to a long, lIPAddress will be zero
' if the function failed. Normally you wouldn't ping if the address
' was not good to start with but we'll just try anyway and send
' the error back.
lIPAddress = ConvertIPAddressToLong(sIPAddress)

' Open up a file handle for doing the ping
hFile = IcmpCreateFile()

' Set the TTL (time to live), try values of 1 to 255
pOptions.Ttl = Val(200)

' Call the function that actually does the ping. It is
' a blocking call so we don't get control back until
' it completes.
lRet = IcmpSendEcho(hFile, _
lIPAddress, _
sMessage, _
Len(sMessage), _
pOptions, _
pReturn, _
Len(pReturn), _
PING_TIMEOUT)

If lRet = 0 Then
' The ping failed for some reason, hopefully the error
' is in the return buffer.

sReturnMessage = SetReturnMessage(pReturn.Status)
Ping = pReturn.Status
Else
' The ping succeeded, .Status will be 0, .RoundTripTime
' is the time in ms for the ping to complete, .Data is
' the data returned (NULL terminated), .Address is the
' Ip address that actually replied, .DataSize is the size
' of the string in .Data

If pReturn.Status <> 0 Then
sReturnMessage = SetReturnMessage(pReturn.Status)
Ping = pReturn.Status
Else
sReturnMessage = SetReturnMessage(pReturn.Status) & ". Completion time is " & pReturn.RoundTripTime & "ms."
Ping = pReturn.Status
End If
End If

' Close the file handle that was used
lRet = IcmpCloseHandle(hFile)
iVal = WSACleanup()
End Function


' ConvertIPAddressToLong
'
' Converts a dotted IP address (eg: "123.123.123.123") to a long
' integer for use in sending a ping. This routine converts
' the string as required by an Intel system.
'
' Essentially we take the 4 numbers, flip them around and make
' a long by shifting all the parts into the correct byte. We
' do it here by making a hex string and converting it to a long.
' Not pretty but it works (most of the time<g>).
'
' When we get in "a.b.c.d" what we want out is Val(&Hddccbbaa).

Private Function ConvertIPAddressToLong(sAddress As String) As Long

Dim sTemp As String
Dim lAddress As Long
Dim iValCount As Integer
Dim lDotValues(1 To 4) As String

' Set up the initial storage and counter
sTemp = sAddress
iValCount = 0

' Keep going while we still have dots in the string
While InStr(sTemp, ".") > 0
iValCount = iValCount + 1 ' count the number
lDotValues(iValCount) = Mid(sTemp, 1, InStr(sTemp, ".") - 1) ' pick it off and convert it
sTemp = Mid(sTemp, InStr(sTemp, ".") + 1) ' chop off the number and the dot
Wend

' The string only has the last number in it now
iValCount = iValCount + 1
lDotValues(iValCount) = sTemp

' If we didn't get four pieces then the IP address is no good
If iValCount <> 4 Then
ConvertIPAddressToLong = 0
Exit Function
End If

' Check for numbers outside of valid range
For iValCount = 1 To 4
If lDotValues(iValCount) < 0 Or _
lDotValues(iValCount) > 255 Then

ConvertIPAddressToLong = 0
Exit Function
End If
Next iValCount

' Take the four value, hex them, pad to 2 zero digits, make a hex
' String and then convert the whole mess to a long for returning
lAddress = Val("&H" & Right("00" & Hex(lDotValues(4)), 2) & _
Right("00" & Hex(lDotValues(3)), 2) & _
Right("00" & Hex(lDotValues(2)), 2) & _
Right("00" & Hex(lDotValues(1)), 2))

' Set the return value
ConvertIPAddressToLong = lAddress
End Function


Private Function SetReturnMessage(lStatus As Long) As String
Select Case lStatus
Case IP_SUCCESS
SetReturnMessage = "Ping Success"
Case IP_BUF_TOO_SMALL
SetReturnMessage = "Buffer Too Small"
Case IP_DEST_NET_UNREACHABLE
SetReturnMessage = "Destination Network Unreachable"
Case IP_DEST_HOST_UNREACHABLE
SetReturnMessage = "Destination Host Unreachable"
Case IP_DEST_PROT_UNREACHABLE
SetReturnMessage = "Destination Protocol Unreachable"
Case IP_DEST_PORT_UNREACHABLE
SetReturnMessage = "Destination Port Unreachable"
Case IP_NO_RESOURCES
SetReturnMessage = "No Resources"
Case IP_BAD_OPTION
SetReturnMessage = "Bad Option"
Case IP_HW_ERROR
SetReturnMessage = "HW Error"
Case IP_PACKET_TOO_BIG
SetReturnMessage = "Packet Too Big"
Case IP_REQ_TIMED_OUT
SetReturnMessage = "Request Timed Out"
Case IP_BAD_REQ
SetReturnMessage = "Bad Request"
Case IP_BAD_ROUTE
SetReturnMessage = "Bad Route"
Case IP_TTL_EXPIRED_TRANSIT
SetReturnMessage = "TTL Expired Transit"
Case IP_TTL_EXPIRED_REASSEM
SetReturnMessage = "TTL Expired Reassembly"
Case IP_PARAM_PROBLEM
SetReturnMessage = "Parameter Problem"
Case IP_SOURCE_QUENCH
SetReturnMessage = "Source Quench"
Case IP_OPTION_TOO_BIG
SetReturnMessage = "Option Too Big"
Case IP_BAD_DESTINATION
SetReturnMessage = "Bad Destination"
Case IP_ADDR_DELETED
SetReturnMessage = "Address Deleted"
Case IP_SPEC_MTU_CHANGE
SetReturnMessage = "Spec MTU Change"
Case IP_MTU_CHANGE
SetReturnMessage = "MTU Change"
Case IP_UNLOAD
SetReturnMessage = "Unload"
Case IP_ADDR_ADDED
SetReturnMessage = "Address Added"
Case IP_GENERAL_FAILURE
SetReturnMessage = "General Failure"
Case MAX_IP_STATUS
SetReturnMessage = "Max IP Status"
Case IP_PENDING
SetReturnMessage = "IP Pending"
End Select
End Function

Thanks!

[Crazy D @ Work]

I just copy-pasted it into VB and called the Ping function like Ping("192.100.100.190", s) and it returned 0 and the msg was "Ping Success. Completion time is 0ms.". (it's our proxy server).
With our mailserver it works fine too.
When I tried to ping a workstation running SQL server, I got a request time out.
I'm not really a network expert (not at all actually...)
But it seems to work here... at least I don't get the error you got.
Sorry can't be of any more help.

Crazy D @ Work :-)

[Garry]

Thanks!

I tried from other NT workstations and it gave me the same error. It worked fine on Win 95. May be I will check with Microsoft guys.

Thanks Anyway!

Garry

[Crazy D @ Work]

Can it have to be something with added services and protocols? (asking to a network specialist....)
Let us know if the MS guys have a solution; might be helpful :-)
good luck!

Crazy D @ Work :-)