problem med ping/icmp modul
jeg har det her icmp/ping modulmen jeg kan ikke sætte pakke størrelse
er der nogen der har en ide til hvordan man gør det?
koden kommer her:
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, we don't implement these here as this is
' a simple sample (simon says).
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
Private Type ip_bytes
Byte1 As String
Byte2 As String
Byte3 As String
Byte4 As String
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, _
ByVal RequestOptions As Long, _
ReplyBuffer As icmp_echo_reply, _
ByVal ReplySize As Long, _
ByVal Timeout As Long) As Long
Private Const PING_TIMEOUT = 10000 ' number of milliseconds to wait for the reply
Public Sub PingAddress(CounterAddress As String)
Dim hFile As Long ' handle for the icmp port opened
Dim lRet As Long ' hold return values as required
Dim strMessage As String
Dim pReturn As icmp_echo_reply
Dim iVal As Integer
Dim lPingRet As Long
lIPAddress = ConvertIPAddressToLong(CheckIPAddress(CounterAddress))
' open up a file handle for doing the ping
hFile = IcmpCreateFile()
' 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, strMessage, Len(strMessage), 0, pReturn, Len(pReturn), PING_TIMEOUT)
If lRet = 0 Then
' the ping failed for some reason, hopefully the error is in the return buffer
Rem Update Flensburg Router status label
varPingRespTime = 1000
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
varPingRespTime = pReturn.RoundTripTime
'If txtResult = "" Then
MsgBox (CStr(varPingRespTime) + " ms")
'Else
' txtResult = txtResult + vbCrLf + CStr(varPingRespTime) + " ms"
'End If
End If ' close the file handle that was used
lRet = IcmpCloseHandle(hFile)
End Sub
Private Function CheckIPAddress(strAddress As String) As ip_bytes
Dim strTemp As String
Dim iValCount As Integer
Dim CheckedIP As ip_bytes
Dim lDotValues(1 To 4) As String
' set up the initial storage and counter
strTemp = strAddress
iValCount = 0
' keep going while we still have dots in the string
While InStr(strTemp, ".") > 0
iValCount = iValCount + 1 ' count the number
lDotValues(iValCount) = Mid(strTemp, 1, InStr(strTemp, ".") - 1) ' pick it off and convert it
strTemp = Mid(strTemp, InStr(strTemp, ".") + 1) ' chop off the number and the dot
Wend
' the string only has the last number in it now
iValCount = iValCount + 1
lDotValues(iValCount) = strTemp
' if we didn't get four pieces then the IP address is no good
If iValCount <> 4 Then
' MsgBox "IP Address contains errors - please check!"
Exit Function
Else
CheckedIP.Byte1 = lDotValues(1)
CheckedIP.Byte2 = lDotValues(2)
CheckedIP.Byte3 = lDotValues(3)
CheckedIP.Byte4 = lDotValues(4)
End If
CheckIPAddress = CheckedIP
End Function
Private Function ConvertIPAddressToLong(lDotValue As ip_bytes) As Long
Dim lAddress As Long
' take the four value, hex them, pad to 2 digits, make a hex
' string and then convert the whole mess to a long for returning
lAddress = Val("&H" & Right("00" & Hex(lDotValue.Byte4), 2) & _
Right("00" & Hex(lDotValue.Byte3), 2) & _
Right("00" & Hex(lDotValue.Byte2), 2) & _
Right("00" & Hex(lDotValue.Byte1), 2))
' set the return value
ConvertIPAddressToLong = lAddress
End Function
