PureBasic

Code : Tout sélectionner

;/ PureBasic 4 Beta 3


Structure Enregistrement
  Avertir.b
  Nom.s
  IP.s
  Description.s
  Statut.s
  EchecSi.s
  Duree.l
  UniteDuree.s
  TypeInterrogation.s
  Port.l
  TimeOut.l
  TimerId.l
EndStructure

ProcedureDLL IPNum(IPAdress.s) ; Return a numerical IP Adress from a IPString
  IpAddress.l=MakeIPAddress(Val(StringField(IPAdress,1,".")),Val(StringField(IPAdress,2,".")),Val(StringField(IPAdress,3,".")),Val(StringField(IPAdress,4,"."))) 
  ProcedureReturn IpAddress
EndProcedure

ProcedureDLL.s HostnameToIP(ConputerName.s) ; Return as a String
  If Len(ConputerName) > 0 
    ResultIP.s=""    
    high.b = 1: low.b = 1 
    Define wsaversion.w 
    PokeB(@wsaversion, high) 
    PokeB(@wsaversion + 1, low) 
    If WSAStartup_(wsaversion, wsa.WSAData) = #NOERROR ; Try to access Windows sockets stuff... 
      *host.HOSTENT = gethostbyname_(ConputerName)       ; Get host information for named computer... 
      If *host <> #Null      
        While PeekL(*host\h_addr_list  + AdressNumber * 4) 
          IpAddress = PeekL(*host\h_addr_list  + AdressNumber * 4) 
          ResultIP = StrU(PeekB(IpAddress),0)+"."+StrU(PeekB(IpAddress+1),0)+"."+StrU(PeekB(IpAddress+2),0)+"."+StrU(PeekB(IpAddress+3),0) 
          AdressNumber + 1 
        Wend 
      EndIf 
      WSACleanup_() ; Close Windows sockets stuff... 
    EndIf 
    ProcedureReturn ResultIP 
  EndIf 
EndProcedure 

ProcedureDLL Ping(sIPAdress.s,TimeOut=500)
  ;/ Renvoie le temps en ms
  ;/ Renvoie -1 si hôte inaccessible
  ;/ Renvoie -2 si la résolution du nom de l'hôte en adresse Ip a échouée
  
  Message.s="PING from PureBasic"
  
  ResultSize.l = SizeOf(ICMP_ECHO_REPLY) + Len(Message) 
  *Result = AllocateMemory(ResultSize) 
  *Echo.ICMP_ECHO_REPLY = *Result 
  
  If Len(sIPAdress ) > 0 
    hFile.l = IcmpCreateFile_() 
    IpAddress.l=MakeIPAddress(Val(StringField(sIPAdress,1,".")),Val(StringField(sIPAdress,2,".")),Val(StringField(sIPAdress,3,".")),Val(StringField(sIPAdress,4,".")))  
    If IPAdresse = 0 
      sIPAdress = HostnameToIP(sIPAdress) 
      IpAddress.l=MakeIPAddress(Val(StringField(sIPAdress,1,".")),Val(StringField(sIPAdress,2,".")),Val(StringField(sIPAdress,3,".")),Val(StringField(sIPAdress,4,"."))) 
    EndIf 
    If IpAddress > 0 
      
      If IcmpSendEcho_(hFile, IpAddress, Message, Len(Message), 0, *Result, ResultSize, TimeOut) > 0                                
        ; PrintN("Ping " + sIPAdress + " Octets: " + Str(*Echo\DataSize) + " Temps: " + Str(*Echo\RoundTripTime) + " ms TTL:" + StrU(*Echo\Options\Ttl,#Byte)) 
      Else 
        ;/ Hôte inaccessible 
        FreeMemory(*Result)
        ProcedureReturn -1
      EndIf 
      
      IcmpCloseHandle_(hFile) 
    Else 
      ;/ Nom d'hôte introuvable / inrésolvable
      FreeMemory(*Result) 
      ProcedureReturn -2
    EndIf 
  EndIf 
  FreeMemory(*Result)
  
  ;/ Définition variables partagées
  PingTTL=*Echo\Options\Ttl & $000000FF ;/ Car résultat sur un octet
  
  ProcedureReturn *Echo\RoundTripTime
EndProcedure

Temps=Ping("www.voila.fr")
Select Temps
  Case -2
    MessageRequester("Ping","Echec résolution de noms")
  Case -1
    MessageRequester("Ping","Hôte injoignable")
  Default
    MessageRequester("Ping",Str(Temps)+" ms")
EndSelect