Visual Basic - Ping

Har fattet timeren :o)

Du kan fx. gøre sådan her:
shell "ping 194.55.22.55 >> ping.txt",vbHide   

//>Rune

Her er evt. et program der gør det, med sourcecode med til...

http://www.planetsourcecode.com/upload/ftp/CODE_UPLOAD47954142000.zip

//>Rune

Hej.

En søgning på eksperten giver 5-6 tidligere spørgsmål om 'Ping', her er et hvor jeg var inde med et svar, det kunne jeg godt huske:

http://www.eksperten.dk/spm/78484

M.v.h.  Jørn

Hvis du ikke har "fattet" timeren ordentligt endnu, kan du lige læse dette.


En timer er en indbygget kontrol i Visual Basic. Denne kontrol giver dig mulighed for at lade en eller flere hændelser forekomme inden for et bestemt tidsrum.

Eksempel. A1
Du vil have at et program hvert sekund skriver klokken. 

Objekter:
* Start et nyt exe projekt
* Opret en timer (findes i toolboxen i venstre side)


Skriv denne kode ind i form_load proceduren:


' Denne linje aktiver timeren
Timer1.Enabled = True

' I denne linjer angiver du
' hvor mange gange timeren
' skal gennemgå den kode
' som du skriver i timeren
' -------
' 1000 er et sekund
' Jo mindre tallet bliver
' Jo flere gange hænder det
Timer1.Interval = 1000


Nu skal vi have programmet til at skrive hvad klokken er. Opret nu en Label. Du finder label kontrollen i toolboxen i venstre side af skærmen. Med ikonet "A". Sæt den et sted på formen.

Dobbeltklik nu på timeren. Nu er du inde i timerens procedure.

Skriv denne kode i timeren:


Label1.Caption = Time


Her bliver label1's caption værdi lig med time. Time er simpelthen hvad klokken er. Caption er hvad der står i labelen.

Du kan udskifte "Time" kommandoen med disse andre kommandoer:

    Date - Now
Date betyder Datoen og Now skriver klokken og datoen.

Mvh.
NorthCode

Gøres således.
Koden herunder er baseret på at du har flg.:
1. En form hvor du kopierer nedenstående kode ind i kodevinduet.
2. En knap: navn = cmdStartPing, caption = Start Ping
3. En knap: navn = cmdClose, caption = Luk
4. Et tekstfelt: navn = txtIPAddress (her indtaster du IP adressen som skal pinges)
5. Et tekstfelt: navn = txtResult, egenskab multiline = TRUE (her vises resultatet i millisekunder af en ping)
That's it !

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
        txtResult = 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

Private Sub cmdClose_Click()
Unload Me
End Sub

Private Sub cmdStartPing_Click()
PingAddress txtIPAddress
End Sub

Beklager jeg ikke har svaret endnu - men jeg havde et par uheldig episoder med Nimbda/Klez på min proxy så min up/down-stream-ratio er overskredet - så der er først internet igen den 1. :/

Fair nok ;o)
Thx 4 Poinz

//>Rune