Avatar billede jens_bach Nybegynder
16. juni 2005 - 23:18 Der er 10 kommentarer og
1 løsning

Ping en server. time

Hej....

jeg har fundet dette stk kode, men jeg mangler en time fx ligesom ping i windows 10ms 1ms 50ms bla bla.

er der nogle som kan hjælpe med det i dette stk kode, eller hvis der er nået andet så sig bare til:)

---------
Imports System
Imports System.Data.SqlClient
Imports System.Net
Imports System.Net.Sockets
Imports System.Threading


Module Module1

    Sub Main()

        Dim testPing As New clsPing

        Dim a As Long = testPing.Ping("10.0.0.4")
        Console.WriteLine(testPing.GetLastError.Description)
        Console.WriteLine(testping.)

       
    End Sub

















End Module
'modified by Thomas Fischer 04/2004 (http://www.thomas-fischer.org) & ohters (see below)

'*
'* Parts of the code based on information from Visual Studio Magazine
'* more info : http://www.fawcette.com/vsm/2002_03/magazine/columns/qa/default.asp
'*

Public Class StateObj
    Public sck As Sockets.Socket
    Public Buffer(255) As Byte
    Public BufferSize As Integer
    Public from As EndPoint
    Public BytesReceived As Integer
    Public TimeOut As Boolean = False
    Public rectime As Double
End Class

Public Class clsPing

    Public Structure stcError
        Dim Number As Integer
        Dim Description As String
    End Structure

    Private Const PING_ERROR_BASE As Long = &H8000

    Public Const PING_SUCCESS As Long = 0
    Public Const PING_ERROR As Long = (-1)
    Public Const PING_ERROR_HOST_NOT_FOUND As Long = PING_ERROR_BASE + 1
    Public Const PING_ERROR_SOCKET_DIDNT_SEND As Long = PING_ERROR_BASE + 2
    Public Const PING_ERROR_HOST_NOT_RESPONDING As Long = PING_ERROR_BASE + 3
    Public Const PING_ERROR_TIME_OUT As Long = PING_ERROR_BASE + 4

    Private Const ICMP_ECHO As Integer = 8
    Private Const SOCKET_ERROR As Integer = -1

    Private udtError As stcError

    Private Const intPortICMP As Integer = 7
    Private Const intBufferHeaderSize As Integer = 8
    Private Const intPackageHeaderSize As Integer = 28

    Private byteDataSize As Byte
    Private lngTimeOut As Integer
    Private ipheLocalHost As System.Net.IPHostEntry

    Protected alldone As New ManualResetEvent(False)

    'Public IP As String
    Private IPad As IPAddress
    Private ID As Short
    Private epServer As System.Net.EndPoint
    Private sequence As Byte = 0


    '*
    '* Class Constructor
    '*
    Public Sub New(Optional ByVal Identifier As Short = 0)

        ID = Identifier
        udtError = New stcError

        '*
        '* Get local IP and transform in EndPoint
        '*
        ipheLocalHost = System.Net.Dns.GetHostByName(System.Net.Dns.GetHostName())

    End Sub

    ' Ping using asynchronous read.
    'Author: Lionel BERTON
    'Source: clsPing class from Paulo dos Santos Silva Jr
    'Date: 18th may 2003

    Public Function Ping(ByVal IP As String, Optional ByVal DataSize As Byte = 32, Optional ByVal Timeout As Integer = 1000) As Double

        Dim aReplyBuffer(255) As Byte
        Dim intStart As Double

        Dim epFrom As System.Net.EndPoint

        Dim ipepServer As System.Net.IPEndPoint


        byteDataSize = DataSize
        lngTimeOut = Timeout
        IPad = IPAddress.Parse(IP)
        '*
        '* Transforms the IP address in EndPoint
        '*
        ipepServer = New System.Net.IPEndPoint(IPad, 0)
        epServer = CType(ipepServer, System.Net.EndPoint)

        epFrom = New System.Net.IPEndPoint(ipheLocalHost.AddressList(0), 0)

        '*
        '* Builds the packet to send
        '*
        DataSize = Convert.ToByte(DataSize + intBufferHeaderSize)

        '*
        '* The packet must by an even number, so if the DataSize is and odd number adds one
        '*
        If (DataSize Mod 2 = 1) Then
            DataSize += Convert.ToByte(1)
        End If
        Dim aRequestBuffer(DataSize - 1) As Byte

        '*
        '* --- ICMP Echo Header Format ---
        '* (first 8 bytes of the data buffer)
        '*
        '* Buffer (0) ICMP Type Field
        '* Buffer (1) ICMP Code Field
        '*    (must be 0 for Echo and Echo Reply)
        '* Buffer (2) checksum hi
        '*    (must be 0 before checksum calc)
        '* Buffer (3) checksum lo
        '*    (must be 0 before checksum calc)
        '* Buffer (4) ID hi
        '* Buffer (5) ID lo
        '* Buffer (6) sequence hi
        '* Buffer (7) sequence lo
        '* Buffer (8)..(n)  Ping Data
        '*

        '*
        '* Set Type Field
        '*
        aRequestBuffer(0) = Convert.ToByte(8) ' ECHO Request

        '*
        '* Set ID field
        '*
        BitConverter.GetBytes(ID).CopyTo(aRequestBuffer, 4)

        '*
        '* Set Sequence
        '*
        BitConverter.GetBytes(sequence).CopyTo(aRequestBuffer, 6)

        '*
        '* Load some data into buffer
        '*
        Dim i As Integer
        For i = 8 To DataSize - 1
            aRequestBuffer(i) = Convert.ToByte(i Mod 8)
        Next i

        '*
        '* Calculate Checksum
        '*
        Call CreateChecksum(aRequestBuffer, DataSize, aRequestBuffer(2), aRequestBuffer(3))


        '*
        '* Create the socket
        '*
        Dim sckSocket As New System.Net.Sockets.Socket( _
                                        Net.Sockets.AddressFamily.InterNetwork, _
                                        Net.Sockets.SocketType.Raw, _
                                        Net.Sockets.ProtocolType.Icmp)
        sckSocket.Blocking = False

        '*
        '* Sends Package
        '*
        alldone.Reset()
        Dim so As New StateObj
        so.sck = sckSocket
        'socket returns a packet with the IP header (20 bytes) so with 8 bytes
        'header for ICMP and 32 bytes of data we should get 60 bytes but sometimes
        ' it is more or less... so let's take it large
        '
        so.BufferSize = DataSize + 30

        so.from = epServer
        Dim ar As IAsyncResult


        sckSocket.SendTo(aRequestBuffer, 0, DataSize, SocketFlags.None, ipepServer)

        '*
        '* Records the Start Time, after sending the Echo Request
        '*
        intStart = DateTime.Now.Ticks  'System.Environment.TickCount


        ar = sckSocket.BeginReceiveFrom(so.Buffer, 0, so.BufferSize, SocketFlags.None, so.from, New AsyncCallback(AddressOf callbackfunc), so)

        Dim ret As Boolean = False

        ret = alldone.WaitOne(lngTimeOut, False) 'return false if timeout
        alldone.Close()

        If ret = False Then
            so.TimeOut = True
            sckSocket.Close()
            sckSocket = Nothing
            udtError.Number = PING_ERROR_TIME_OUT
            udtError.Description = "Time Out"
            'Console.WriteLine("timeout for")
            Return (PING_ERROR)
        End If



        '*
        '* Informs on GetLastError the state of the server
        '*
        '
        udtError.Number = BitConverter.ToInt16(so.Buffer, 19)
        Select Case so.Buffer(20)
            Case 0 : udtError.Description = "Success"
            Case 1 : udtError.Description = "Buffer too Small"
            Case 2 : udtError.Description = "Destination Unreahable"
            Case 3 : udtError.Description = "Dest Host Not Reachable"
            Case 4 : udtError.Description = "Dest Protocol Not Reachable"
            Case 5 : udtError.Description = "Dest Port Not Reachable"
            Case 6 : udtError.Description = "No Resources Available"
            Case 7 : udtError.Description = "Bad Option"
            Case 8 : udtError.Description = "Hardware Error"
            Case 9 : udtError.Description = "Packet too Big"
            Case 10 : udtError.Description = "Reqested Timed Out"
            Case 11 : udtError.Description = "Bad Request"
            Case 12 : udtError.Description = "Bad Route"
            Case 13 : udtError.Description = "TTL Exprd In Transit"
            Case 14 : udtError.Description = "TTL Exprd Reassemb"
            Case 15 : udtError.Description = "Parameter Problem"
            Case 16 : udtError.Description = "Source Quench"
            Case 17 : udtError.Description = "Option too Big"
            Case 18 : udtError.Description = "Bad Destination"
            Case 19 : udtError.Description = "Address Deleted"
            Case 20 : udtError.Description = "Spec MTU Change"
            Case 21 : udtError.Description = "MTU Change"
            Case 22 : udtError.Description = "Unload"
            Case Else : udtError.Description = "General Failure"
        End Select


        Return (so.rectime - intStart)

    End Function

    Private Sub callbackfunc(ByVal ar As IAsyncResult)
        Try
            Dim rectime As Double = DateTime.Now.Ticks '= System.Environment.TickCount
            Dim so As StateObj = CType(ar.AsyncState, StateObj)

            If so.TimeOut = False Then
                so.BytesReceived = so.sck.EndReceiveFrom(ar, so.from)
                If so.BytesReceived > 0 Then
                    If ID = BitConverter.ToInt16(so.Buffer, 24) Then
                        so.rectime = rectime
                        alldone.Set()
                    Else
                        ar = so.sck.BeginReceiveFrom(so.Buffer, 0, so.BufferSize, SocketFlags.None, epServer, New AsyncCallback(AddressOf callbackfunc), so)

                    End If

                End If
            End If
        Catch

        End Try

    End Sub

    Public Function GetLastError() As stcError
        Return udtError
    End Function

    ' ICMP requires a checksum that is the one's
    ' complement of the one's complement sum of
    ' all the 16-bit values in the data in the
    ' buffer.
    ' Use this procedure to load the Checksum
    ' field of the buffer.
    ' The Checksum Field (hi and lo bytes) must be
    ' zero before calling this procedure.
    Private Sub CreateChecksum(ByRef data() As Byte, ByVal Size As Integer, ByRef HiByte As Byte, ByRef LoByte As Byte)
        Dim i As Integer
        Dim chk As Integer = 0

        For i = 0 To Size - 1 Step 2
            chk += Convert.ToInt32(data(i) * &H100 + data(i + 1))
        Next

        chk = Convert.ToInt32((chk And &HFFFF&) + Fix(chk / &H10000&))
        chk += Convert.ToInt32(Fix(chk / &H10000&))
        chk = Not (chk)

        HiByte = Convert.ToByte((chk And &HFF00&) / &H100)
        LoByte = Convert.ToByte(chk And &HFF)
    End Sub

End Class
----------
Avatar billede arne_v Ekspert
16. juni 2005 - 23:23 #1
Du bruger ikke tilfældigvis .NET 2.0 Beta ?  Fordi der er nemlig indbygget Ping support !
Avatar billede arne_v Ekspert
16. juni 2005 - 23:23 #2
For .NET 1.1 lavede jeg engang følgende som bruger Win32 API og er noget kortere
end den kode du har fundet:

Imports System
Imports System.Net
Imports System.Runtime.InteropServices

<StructLayout(LayoutKind.Sequential,Pack:=1)> _
Public Structure ICMP_ECHO_REPLY
    Public Address As Integer
    Public Status As Integer
    Public RoundTripTime As Integer
    Public DataSize As UInt16
    Public Reserved As UInt16
    Public Data As IntPtr
    Public Options As IP_OPTION_INFORMATION
End Structure

<StructLayout(LayoutKind.Sequential,Pack:=1)> _
Public Structure IP_OPTION_INFORMATION
    Public TTL As Byte
    Public TOS As Byte
    Public Flags As Byte
    Public OptionsSize As Byte
    Public OptionsData As IntPtr
    Public RealOptionData As Integer
End Structure

Public Class Icmp
    Public Const IP_SUCCESS As Integer = 0
    Public Const IP_BUF_TOO_SMALL As Integer = 11001
    Public Const IP_REQ_TIMED_OUT As Integer = 11010

    <DllImport("icmp.dll")> _
    Public Shared Function IcmpCreateFile() As IntPtr
    End Function

    <DllImport("icmp.dll")> _
    Public Shared Function IcmpSendEcho(ByVal icmpHandle As IntPtr, ByVal ipAddr As Integer, ByRef requestData As Integer, ByVal requestSize As Short, ByVal optionInfo As IntPtr, ByRef replyBuffer As ICMP_ECHO_REPLY, ByVal replySize As Integer, ByVal timeout As Integer) As Integer
    End Function

    <DllImport("icmp.dll")> _
    Public Shared Function IcmpCloseHandle(ByVal icmpHandle As IntPtr) As Boolean
    End Function

    Public Shared Function Ping(ByVal host As String) As Boolean
        Dim addr As Integer = BitConverter.ToInt32(IPAddress.Parse(host).GetAddressBytes, 0)
        '.NET 1.0: Dim addr As Integer = BitConverter.ToInt32(BitConverter.GetBytes(IPAddress.Parse(host).Address), 0)
        Dim h As IntPtr = IcmpCreateFile
        Dim req As Integer = 123456789
        Dim rep As ICMP_ECHO_REPLY = New ICMP_ECHO_REPLY
        Dim retval As Integer = IcmpSendEcho(h, addr, req, 4, IntPtr.Zero, rep, 32, 10)
        IcmpCloseHandle(h)
        Return (retval <> 0 AndAlso rep.Status = IP_SUCCESS)
    End Function
End Class

Public Class TestClass
    Public Shared Sub Main(ByVal args As String())
        Console.WriteLine("min server : " & Icmp.Ping("192.168.1.10"))
        Console.WriteLine("ikke eksisterende : " & Icmp.Ping("192.168.1.25"))
        Console.WriteLine("www.google.dk (svarer) : " & Icmp.Ping("216.239.59.104"))
        Console.WriteLine("www.eksperten.dk (svarer ikke) : " & Icmp.Ping("62.199.138.148"))
    End Sub
End Class
Avatar billede arne_v Ekspert
16. juni 2005 - 23:24 #3
Jeg vil næsten tro at rep.RoundTripTime indeholder det du søger
Avatar billede jens_bach Nybegynder
16. juni 2005 - 23:24 #4
det kan jeg jo hurtig komme til, men er det ikke nået med at .net2 ikke kan sammen med .net1 eller ?
Avatar billede arne_v Ekspert
16. juni 2005 - 23:25 #5
du kan godt have begge installeret på samme maskine

men beta er jo beta
Avatar billede arne_v Ekspert
16. juni 2005 - 23:30 #6
jeg har lige checket

det er rep.RoundTripTime du skal bruge

Public Shared Function Ping(ByVal host As String) As Integer
  ...
  If (retval <> 0 AndAlso rep.Status = IP_SUCCESS) Then
      Return rep.RoundTripTime
  Else
      return -1
  End If
End Function

så er det bare lige at putte en løkke omkring kaldet
Avatar billede jens_bach Nybegynder
16. juni 2005 - 23:35 #7
hvis man nu ville kunne man så ligge nået ind i din kode så man kunne få tiden tilbage
Avatar billede arne_v Ekspert
16. juni 2005 - 23:36 #8
23:30:50
Avatar billede jens_bach Nybegynder
16. juni 2005 - 23:48 #9
takker mange gange
Avatar billede arne_v Ekspert
16. juni 2005 - 23:53 #10
svar
Avatar billede arne_v Ekspert
16. juni 2005 - 23:53 #11
jeg har iøvrigt smidt noget i http://www.eksperten.dk/spm/626530
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Kurser inden for grundlæggende programmering

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester