PureBasic Forums - English

Code: Select all

;Ping IP address #ip+"1"   #ip+"2"   #ip+"3"  #ip+"4" ...
#ip="94.156.68."

Structure EchoResult
  Reply.ICMP_ECHO_REPLY
  Buffer.l[65000]
EndStructure


Procedure Ping(Address$, Timeout,m_size)
  hPort = IcmpCreateFile_()
  
  *mem=AllocateMemory(m_size)
  RandomData(*mem,m_size)
  
  
  Result = IcmpSendEcho_(hPort, inet_addr_(@Address$), *mem, m_size, 0, @ECHO.EchoResult, SizeOf(EchoResult), Timeout)
  FreeMemory(*mem)
  Risposta=ECHO\Reply\Status
  IcmpCloseHandle_(hPort)
  
  If Result = 0
    ClearStructure(ECHO,EchoResult)
    ProcedureReturn 2
  Else
    If Risposta=0 ; SUCCES
      ClearStructure(ECHO,EchoResult)
      ProcedureReturn 1
    Else
      ClearStructure(ECHO,EchoResult)
      ProcedureReturn 2
    EndIf
  EndIf
EndProcedure


Structure png
  ip.s
  id.i
  result.b
EndStructure
Global Dim png.png(250)

Procedure s_ping(num)
   png(num)\result=2
  Repeat
    If png(num)\result=0
      png(num)\result=ping(png(num)\ip,1000,65)
    Else
      Delay(50)
    EndIf
  Until quit=1
EndProcedure

max_png=250

For i=1 To max_png
  png(i)\id=CreateThread(@s_ping(),i)
  png(i)\ip=#ip+Str(i)
Next

OpenConsole()
EnableGraphicalConsole(1)

PrintN("BEGIN...")


Repeat
  ms=ElapsedMilliseconds()
  For i=1 To max_png
    png(i)\result=0
  Next
  
  Repeat
    ok=0
    For i=1 To max_png
      If png(i)\result=0
        ok=1
        Break
      EndIf
    Next
    Delay(10)
  Until ok=0
  

  ClearConsole()
  online=0
  For i=1 To max_png
    If png(i)\result=1
      online+1
    EndIf
  Next
  PrintN("online: "+Str(online)+"  time:"+Str(ElapsedMilliseconds()-ms)+"ms")
  
  For i=1 To max_png
    png(i)\result=0
  Next
  
  Delay(10)
Until quit=1

Code: Select all

EnableExplicit

Code: Select all

; English forum: http://www.purebasic.fr/english/viewtopic.php?t=7338&highlight= 
; Author: TerryHough (modified by celtic88)

Global Ping_Port = IcmpCreateFile_() 

Procedure.q lngNewAddress(strAdd.s) 
  Protected sDummy.s=strAdd 
  Protected Position = FindString(sDummy, ".",1) 
  If Position>0 
    Protected a1=Val(Left(sDummy,Position-1)) 
    sDummy=Right(sDummy,Len(sDummy)-Position) 
    Position = FindString(sDummy, ".",1) 
    If Position>0 
      Protected A2=Val(Left(sDummy,Position-1)) 
      sDummy=Right(sDummy,Len(sDummy)-Position) 
      Position = FindString(sDummy, ".",1) 
      If Position>0 
        Protected A3=Val(Left(sDummy,Position-1)) 
        sDummy=Right(sDummy,Len(sDummy)-Position) 
        Protected A4=Val(sDummy) 
        Protected dummy.q=0 
        PokeB(@dummy,a1) 
        PokeB(@dummy+1,A2) 
        PokeB(@dummy+2,A3) 
        PokeB(@dummy+3,A4) 
        ProcedureReturn dummy 
      EndIf 
    EndIf 
  EndIf 
EndProcedure 

Procedure _Ping(Address.s,PING_TIMEOUT=1000,strMessage.s = "Echo This Information Back To Me")
  If Ping_Port
    Protected MsgLen = Len(strMessage) 
    Protected ECHO.ICMP_ECHO_REPLY 
    Protected IPAddressNumber.q = lngNewAddress(Address.s)
    Protected *buffer=AllocateMemory(SizeOf(ICMP_ECHO_REPLY)+MsgLen) 
    Protected lngResult = IcmpSendEcho_(Ping_Port, IPAddressNumber, @strMessage, MsgLen , #Null,*buffer, SizeOf(ICMP_ECHO_REPLY)+MsgLen,PING_TIMEOUT) 
    If lngResult
      CopyMemory(*buffer,@ECHO,SizeOf(ICMP_ECHO_REPLY)) 
    EndIf
    FreeMemory(*buffer)
    If lngResult
      ProcedureReturn ECHO\RoundTripTime
    Else
      ProcedureReturn -1
    EndIf
  EndIf
EndProcedure

Debug _Ping("74.125.136.188")

Code: Select all

*Url = ASCII(Address$)
Result = IcmpSendEcho_(hPort, inet_addr_(*Url), *mem, m_size, 0, @ECHO.EchoResult, SizeOf(EchoResult), Timeout)
FreeMemory(*Url)