USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Fórum

  Visual Basic
Voltar
Autor Assunto:  Ping em várias máquinas simultaneamente...
Wolverine
LORENA
SP - BRASIL
ENUNCIADA !
Postada em 22/12/2005 06:39 hs            
Preciso executar um ping em várias máquinas simultaneamente para controle da rede.
Como fazer para que os pings sejam disparados no mesmo momento, como no explorer qndo selecionamos mais de um arquivo e apertamos enter...
   
Geronimo
Pontos: 2843
JOINVILLE
SC - BRASIL
ENUNCIADA !
Postada em 21/01/2006 06:38 hs            
Veja se ajuda:
Use o módulo abaixo. Ele retorna um código de erro numérico acima de 11000 quando houver erros ou o tempo em milisegundos levado para efetuar o ping. 

Para os erros a constantes publicas declaradas no módulo para facilitar a identificação do erro.

Public Const IP_STATUS_BASE = 11000

Public Const IP_SUCCESS = 0
Public Const IP_BUF_TOO_SMALL = (11000 + 1)
Public Const IP_DEST_NET_UNREACHABLE = (11000 + 2)
Public Const IP_DEST_HOST_UNREACHABLE = (11000 + 3)
Public Const IP_DEST_PROT_UNREACHABLE = (11000 + 4)
Public Const IP_DEST_PORT_UNREACHABLE = (11000 + 5)
Public Const IP_NO_RESOURCES = (11000 + 6)
Public Const IP_BAD_OPTION = (11000 + 7)
Public Const IP_HW_ERROR = (11000 + 8)
Public Const IP_PACKET_TOO_BIG = (11000 + 9)
Public Const IP_REQ_TIMED_OUT = (11000 + 10)
Public Const IP_BAD_REQ = (11000 + 11)
Public Const IP_BAD_ROUTE = (11000 + 12)
Public Const IP_TTL_EXPIRED_TRANSIT = (11000 + 13)
Public Const IP_TTL_EXPIRED_REASSEM = (11000 + 14)
Public Const IP_PARAM_PROBLEM = (11000 + 15)
Public Const IP_SOURCE_QUENCH = (11000 + 16)
Public Const IP_OPTION_TOO_BIG = (11000 + 17)
Public Const IP_BAD_DESTINATION = (11000 + 18)
'
'   The next group are status codes passed up on status indications to
'   transport layer protocols.
'
Public Const IP_ADDR_DELETED = (11000 + 19)
Public Const IP_SPEC_MTU_CHANGE = (11000 + 20)
Public Const IP_MTU_CHANGE = (11000 + 21)
Public Const IP_UNLOAD = (11000 + 22)
Public Const IP_ADDR_ADDED = (11000 + 23)

Public Const IP_GENERAL_FAILURE = (11000 + 50)
Public Const MAX_IP_STATUS = 11000 + 50
Public 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

'   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 = 200        ' 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

Private Sub btnExit_Click()
    End
End Sub

' Efetua o Ping. Retorna
Public Function Ping(ByVal IP As String, TTL As Integer) 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 strMessage  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
    
    strMessage = "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 no good to start with but we don't mind seeing bad return status
    '   as that is what samples are all about
    lIPAddress = ConvertIPAddressToLong(IP)
    
    '   open up a file handle for doing the ping
    hFile = IcmpCreateFile()
    
    '   set the TTL from the text box, try values of 1 to 255
    pOptions.TTL = TTL
    
    '   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), pOptions, pReturn, Len(pReturn), PING_TIMEOUT)

    If lRet = 0 Then
        ' the ping failed for some reason, hopefully the error is in the return buffer
        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
            Ping = pReturn.Status
        Else
            Ping = pReturn.RoundTripTime
        End If
    End If
                        
    '   close the file handle that was used
    lRet = IcmpCloseHandle(hFile)
    
    iVal = WSACleanup()
    
End Function

' Converte um IP para um número inteiro long

Public Function ConvertIPAddressToLong(strAddress As String) As Long

    Dim strTemp             As String
    Dim lAddress            As Long
    Dim iValCount           As Integer
    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 Max 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
        ConvertIPAddressToLong = 0
        Exit Function
        End If
        
    '   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(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



"O pior inimigo que você poderá encontrar será sempre você mesmo."
   
Página(s): 1/1    


Seu Nome:

Seu eMail:

ALTERAR PARA MODO HTML
Mensagem:

[:)] = 
[:P] = 
[:(] = 
[;)] = 

HTML DESLIGADO

     
 VOLTAR

  



CyberWEB Network Ltda.    © Copyright 2000-2024   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página