Newsgroup: it.comp.lang.visual-basic
Titolo: ping con vb6

 
          salve vorrei implementare una procedura in VB6 che prima di avviare una
connessione ad un server verifica che ci sia la disponibilità di
quest'ultimo
attraverso un ping e se questo è disponibile o meno deve avvisare l'utente.
Qualcuno mi puo' dare una dritta su come fare ad avviare un ping da VB6?
Grazie
--------------------------------
Inviato via 
http://arianna.libero.it/usenet/

 Grazie
Un po' laborioso ma fattibilissimo. Non bisogna usare winsock(xchè usa solo 
tcp e udp) ma appoggiarsi direttamente alle WSA e quindi sfruttare ICMP.DLL 
(lo sai vero che ping usa il protocollo ICMP? In particolare ICMP Echo...). 
Mi sembra di ricordare qualcosa su 
www.vbsimple.it
 . Dacci un occhio e fammi 
sapere.
Salutiamo
Umbe
P.S.
mazza oh..ma oggi è venerdi' 17?????? 

 fammi
.net!  
www.vbsimple.net
E' proprio venerdi 17.
Salutiamo
Umbe

 Grazie
Trovata tempo fa, non ricordo + dove:
P.S. l'avevo modificata per effettuare 100 tentativi... se nn ti va bene 
modificala come vuoi
ciao, roby
'Inizio Codice -----------------------------------------------------------
Option Explicit
'Option Compare Text
Private Const IP_SUCCESS                As Long = 0
Private Const IP_STATUS_BASE            As Long = 11000
Private Const IP_BUF_TOO_SMALL          As Long = (11000 + 1)
Private Const IP_DEST_NET_UNREACHABLE   As Long = (11000 + 2)
Private Const IP_DEST_HOST_UNREACHABLE  As Long = (11000 + 3)
Private Const IP_DEST_PROT_UNREACHABLE  As Long = (11000 + 4)
Private Const IP_DEST_PORT_UNREACHABLE  As Long = (11000 + 5)
Private Const IP_NO_RESOURCES           As Long = (11000 + 6)
Private Const IP_BAD_OPTION             As Long = (11000 + 7)
Private Const IP_HW_ERROR               As Long = (11000 + 8)
Private Const IP_PACKET_TOO_BIG         As Long = (11000 + 9)
Private Const IP_REQ_TIMED_OUT          As Long = (11000 + 10)
Private Const IP_BAD_REQ                As Long = (11000 + 11)
Private Const IP_BAD_ROUTE              As Long = (11000 + 12)
Private Const IP_TTL_EXPIRED_TRANSIT    As Long = (11000 + 13)
Private Const IP_TTL_EXPIRED_REASSEM    As Long = (11000 + 14)
Private Const IP_PARAM_PROBLEM          As Long = (11000 + 15)
Private Const IP_SOURCE_QUENCH          As Long = (11000 + 16)
Private Const IP_OPTION_TOO_BIG         As Long = (11000 + 17)
Private Const IP_BAD_DESTINATION        As Long = (11000 + 18)
Private Const IP_ADDR_DELETED           As Long = (11000 + 19)
Private Const IP_SPEC_MTU_CHANGE        As Long = (11000 + 20)
Private Const IP_MTU_CHANGE             As Long = (11000 + 21)
Private Const IP_UNLOAD                 As Long = (11000 + 22)
Private Const IP_ADDR_ADDED             As Long = (11000 + 23)
Private Const IP_GENERAL_FAILURE        As Long = (11000 + 50)
Private Const MAX_IP_STATUS             As Long = (11000 + 50)
Private Const IP_PENDING                As Long = (11000 + 255)
Private Const PING_TIMEOUT              As Long = 500
Private Const WS_VERSION_REQD           As Long = &H101
Private Const MIN_SOCKETS_REQD          As Long = 1
Private Const SOCKET_ERROR              As Long = -1
Private Const INADDR_NONE               As Long = &HFFFFFFFF
Private Const MAX_WSADescription        As Long = 256
Private Const MAX_WSASYSStatus          As Long = 128
Private Type ICMP_OPTIONS
     Ttl             As Byte
     Tos             As Byte
     Flags           As Byte
     OptionsSize     As Byte
     OptionsData     As Long
End Type
Public Type ICMP_ECHO_REPLY
     Address         As Long
     status          As Long
     RoundTripTime   As Long
     DataSize        As Long 'formerly integer
    'Reserved        As Integer
     DataPointer     As Long
     Options         As ICMP_OPTIONS
     DATA            As String * 250
End Type
Private Type WSADATA
    wVersion                                 As Integer
    wHighVersion                             As Integer
    szDescription(0 To MAX_WSADescription)   As Byte
    szSystemStatus(0 To MAX_WSASYSStatus)    As Byte
    wMaxSockets                              As Long
    wMaxUDPDG                                As Long
    dwVendorInfo As Long
End Type
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 Long, _
     ByVal RequestOptions As Long, _
     ReplyBuffer As ICMP_ECHO_REPLY, _
     ByVal ReplySize As Long, _
     ByVal Timeout As Long) As Long
Private Declare Function WSAGetLastError Lib "wsock32" () As Long
Private Declare Function WSAStartup Lib "wsock32" _
    (ByVal wVersionRequired As Long, _
     lpWSADATA As WSADATA) As Long
Private Declare Function WSACleanup Lib "wsock32" () As Long
Private Declare Function gethostname Lib "wsock32" _
    (ByVal szHost As String, _
     ByVal dwHostLen As Long) As Long
Private Declare Function gethostbyname Lib "wsock32" _
    (ByVal szHost As String) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" _
   (xDest As Any, _
    xSource As Any, _
    ByVal nbytes As Long)
Private Declare Function inet_addr Lib "wsock32" _
    (ByVal s As String) As Long
Public Function GetStatusCode(status As Long) As String
    Dim msg As String
    Select Case status
       Case IP_SUCCESS:               msg = "ip success"
       Case INADDR_NONE:              msg = "inet_addr: bad IP format"
       Case IP_BUF_TOO_SMALL:         msg = "ip buf too_small"
       Case IP_DEST_NET_UNREACHABLE:  msg = "ip dest net unreachable"
       Case IP_DEST_HOST_UNREACHABLE: msg = "ip dest host unreachable"
       Case IP_DEST_PROT_UNREACHABLE: msg = "ip dest prot unreachable"
       Case IP_DEST_PORT_UNREACHABLE: msg = "ip dest port unreachable"
       Case IP_NO_RESOURCES:          msg = "ip no resources"
       Case IP_BAD_OPTION:            msg = "ip bad option"
       Case IP_HW_ERROR:              msg = "ip hw_error"
       Case IP_PACKET_TOO_BIG:        msg = "ip packet too_big"
       Case IP_REQ_TIMED_OUT:         msg = "ip req timed out"
       Case IP_BAD_REQ:               msg = "ip bad req"
       Case IP_BAD_ROUTE:             msg = "ip bad route"
       Case IP_TTL_EXPIRED_TRANSIT:   msg = "ip ttl expired transit"
       Case IP_TTL_EXPIRED_REASSEM:   msg = "ip ttl expired reassem"
       Case IP_PARAM_PROBLEM:         msg = "ip param_problem"
       Case IP_SOURCE_QUENCH:         msg = "ip source quench"
       Case IP_OPTION_TOO_BIG:        msg = "ip option too_big"
       Case IP_BAD_DESTINATION:       msg = "ip bad destination"
       Case IP_ADDR_DELETED:          msg = "ip addr deleted"
       Case IP_SPEC_MTU_CHANGE:       msg = "ip spec mtu change"
       Case IP_MTU_CHANGE:            msg = "ip mtu_change"
       Case IP_UNLOAD:                msg = "ip unload"
       Case IP_ADDR_ADDED:            msg = "ip addr added"
       Case IP_GENERAL_FAILURE:       msg = "ip general failure"
       Case IP_PENDING:               msg = "ip pending"
       Case PING_TIMEOUT:             msg = "ping timeout"
       Case Else:                     msg = "unknown  msg returned"
    End Select
    GetStatusCode = CStr(status) & "   [ " & msg & " ]"
End Function
Public Function Ping(sAddress As String, _
                      sDataToSend As String, _
                      ECHO As ICMP_ECHO_REPLY) As Long
   'If Ping succeeds :
   '.RoundTripTime = 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
   '.Status will be 0
   '
   'If Ping fails .Status will be the error code
    Dim hPort        As Long
    Dim dwAddress    As Long
   'convert the address into a long representation
    dwAddress = inet_addr(sAddress)
   'if a valid address..
    If dwAddress <> INADDR_NONE Then
      'open a port
       hPort = IcmpCreateFile()
      'and if successful,
       If hPort Then
         'ping it.
          Call IcmpSendEcho(hPort, _
                            dwAddress, _
                            sDataToSend, _
                            Len(sDataToSend), _
                            0, _
                            ECHO, _
                            Len(ECHO), _
                            PING_TIMEOUT)
         'return the status as ping succes and close
          Ping = ECHO.status
          Call IcmpCloseHandle(hPort)
       End If
    Else:
         'the address format was probably invalid
          Ping = INADDR_NONE
    End If
End Function
Public Sub SocketsCleanup()
    If WSACleanup() <> 0 Then
        MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
    End If
End Sub
Public Function SocketsInitialize() As Boolean
    Dim WSAD     As WSADATA
    SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
End Function
Public Function TestConnection(ByVal IPAddress As String, Optional ByRef 
StatusCode As String) As Boolean
Dim ECHO    As ICMP_ECHO_REPLY
Dim success As Long
Dim NumberOfTent As Integer
    If SocketsInitialize() Then
      'ping the ip passing the address, text to send, and the ECHO
''structure.
'      success = Ping(IniInf.IFXip, "echo this", ECHO)
       NumberOfTent = 0
RIPETI:
success = Ping(IPAddress, "echo this", ECHO)
       If success = 0 Then
         TestConnection = True
       Else
         NumberOfTent = NumberOfTent + 1
         TestConnection = False
         If NumberOfTent <= 100 Then GoTo RIPETI:
       End If
       StatusCode = GetStatusCode(success)
       SocketsCleanup
    Else
       MsgBox "Windows Sockets for 32 bit Windows " & _
              "environments is not successfully responding."
    End If
End Function
'Fine Codice -------------------------------------------------------------



Se per connessione intendi quella ad un server su internet,
quella del ping è, una mezza soluzione.
Infatti se l'utente è dietro un firewall che non accetta 
l'ICMP response, ottieni una risposta negativa anche se il sito è
raggiungibile.
Ciao

 l'ICMP response, ottieni una risposta negativa
In effetti spesso i server hanno il ping disattivato, perň una soluzione
"intera" che funzioni sempre non mi viene in mente...

Senza fare ping "preventivi" prova a fare direttamente la connessione 
impostando un timeout massimo. Se va in timeout gestisci l'errore!
Ciao 

però una soluzione "intera" che funzioni sempre non mi viene in mente...
Non esiste una soluzione "intera". Dipende da quello che devi fare.
In linea di massima, la soluzione di Erp è quella migliore, ma devi
utilizzare winsock (o relative api) e non inet (o relative api)
perchè, in quest' ultimo caso, dipendi dalle impostazioni di IE.
(Se hai il browser offline, dal tuo programma non ti conetti).
Pensa che anche il tanto osannato Firefox ha lo stesso comportamento.
Ciao