REM 19.okt.2014 Svein Svensson, edit 26.mar.2015
      REM Fast local ping scanner
      REM 8*32=256 threads
      Ip$="192.168.0.0"+CHR$0  : REM local net

      ON ERROR PROCclose : REPORT : END
      ON CLOSE PROCclose : END

      DIM Ping{(255) hping%, ip%, dta&(31), rep&(63), buf&(15), fill&(7)}
      DIM hMain%(7), hThread%(255)
      DIM Code% NOTEND AND 2047, Code% 500, L%-1

      SYS "LoadLibrary", "iphlpapi.dll" TO Iphlpapi%
      SYS "GetProcAddress", Iphlpapi%, "IcmpSendEcho" TO IcmpSendEcho%
      SYS "GetProcAddress", Iphlpapi%, "IcmpCreateFile" TO IcmpCreateFile%
      SYS "GetProcAddress", Iphlpapi%, "IcmpCloseHandle" TO IcmpCloseHandle%
      SYS "LoadLibrary", "Ntdll.dll" TO Ntdll%
      SYS "GetProcAddress", Ntdll%, "RtlIpv4AddressToStringA" TO Rtl2String%
      SYS "GetProcAddress", Ntdll%, "RtlIpv4StringToAddressA" TO RtlString2adr%

      FOR Pass%=8 TO 10 STEP 2
        P% = Code%
        [OPT Pass%
  
        .Ping%
        cld
        mov ebp,[esp+4]
        mov eax,500 : push eax                  ; timeout, can't go faster !    (change to 1000 if on wlan)
        mov eax,64  : push eax                  ; replysize
        mov eax,ebp : add eax,40 : push eax     ; replybuffer rep&(0)
        xor eax,eax : push eax                  ; options
        mov eax,32  : push eax                  ; sendsize, msdn say's word but that doesn't work
        mov eax,ebp : add eax,8  : push eax     ; sendbuffer dta&(0)
        push [ebp+4]                            ; ip%
        push [ebp]                              ; hping%
        call IcmpSendEcho%
        or eax,eax                              ; if result=0 then timeout or some error else we got a reply
        jnz Ping4%
        call "GetLastError"
        mov [ebp+8],eax
        jmps Ping3%
  
        .Ping4%
        mov eax,[ebp+44]                        ; if reply_stat=0 then valid ip else some error
        mov [ebp+12],eax
        or eax,eax
        jz Ping2%
  
        .Ping3%
        xor eax,eax
        ]
        WHILE P%AND3:[OPT Pass%:nop:]:ENDWHILE  : REM dword alignment for mov [ebp+4],eax
        [OPT Pass%
        mov [ebp+4],eax                         ; no reply, clear ip table entry
  
        .Ping2%
        push [ebp] : call IcmpCloseHandle% : ret
  
        .Wait%                                  ; 32 sub wait threads
        mov ebp,[esp+4]
        mov eax,2000 : push eax
        mov eax,1 : push eax
        push ebp
        mov eax,32 : push eax
        call "WaitForMultipleObjects" : ret
        ]
      NEXT Pass%

      REM create ip table
      SYS  RtlString2adr%, !^Ip$, 1, ^C%, ^Ip% TO D%
      IF D%<>0 THEN ERROR 100, "Ip$ convert error"
      FOR I%=0 TO 255
        SYS IcmpCreateFile% TO C%
        Ping{(I%)}.hping%=C%
        Ping{(I%)}.ip%=Ip%
        ?(^Ping{(I%)}.ip%+3)=I%
      NEXT I%

      T%=TIME
      REM create 256 worker threads
      FOR I% = 0 TO 255
        H%=^Ping{(I%)}.hping%
        SYS "CreateThread", 0, 1024, Ping%, H%, 0, 0 TO hThread%(I%)
        IF hThread%(I%) = 0 THEN ERROR 100,"Failed to create Thread."
      NEXT I%

      REM create 8 main wait threads each waiting for 32 sub threads
      FOR I%=0 TO 7
        H%=^hThread%(I%*32)
        SYS "CreateThread", 0, 1024, Wait%, H%, 0, 0 TO hMain%(I%)
        IF hMain%(I%) = 0 THEN ERROR 100,"Failed to create MainThread."
      NEXT I%

      REM wait for the 8 main wait threads
      SYS "WaitForMultipleObjects", 7, ^hMain%(0), 1, 5000
      WAIT 10 : REM wait a bit before scanning ip table, threads not immediately ready ?

      REM print non zero values from ip table
      FOR I%=0 TO 255
        IF Ping{(I%)}.ip%<>0 THEN
          D%=^Ping{(I%)}.ip%
          PRINT STR$(D%?0);" ";STR$(D%?1);" ";STR$(D%?2);" ";STR$(D%?3);
          IF D%!4 THEN PRINT " IcmpErrorCode=";D%!4 ELSE PRINT
          IF D%!8 THEN PRINT " IcmpReplyStat=";D%!8
        ENDIF
      NEXT I%

      PRINT "Scan complete in ";(TIME-T%)/100;" seconds"

      FOR I%=0 TO 7
        SYS "CloseHandle", hMain%(I%)
      NEXT I%
      FOR I%=0 TO 255
        SYS "CloseHandle", hThread%(I%)
      NEXT I%

      PROCclose
      END

      DEF PROCclose
      Ntdll%+=0 : IF Ntdll% SYS "FreeLibrary", Ntdll%
      Iphlpapi%+=0 : IF Iphlpapi% SYS "FreeLibrary", Iphlpapi%
      ENDPROC