uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ICMP, ExtCtrls, Mask, Winsock;
type
  TForm1 = class(TForm)
    icmp1: Ticmp;

{             }
{                                                       }
{       Borland Delphi Runtime Library                  }
{       ICMP API Interface Unit                         }
{                                                       }
{       Copyright (c) 1990-1999 Microsoft Corporation   }
{                                                       }
{       Translator: Vadim Crits                         }
{                                                       }
{               }
unit Icmp;
{$WEAKPACKAGEUNIT}
interface
uses
  Windows;
const
{ IP_STATUS codes returned from IP APIs }
  IP_STATUS_BASE             = 11000;
  IP_SUCCESS                 = 0;
  IP_BUF_TOO_SMALL           = (IP_STATUS_BASE + 1);
  IP_DEST_NET_UNREACHABLE    = (IP_STATUS_BASE + 2);
  IP_DEST_HOST_UNREACHABLE   = (IP_STATUS_BASE + 3);
  IP_DEST_PROT_UNREACHABLE   = (IP_STATUS_BASE + 4);
  IP_DEST_PORT_UNREACHABLE   = (IP_STATUS_BASE + 5);
  IP_NO_RESOURCES            = (IP_STATUS_BASE + 6);
  IP_BAD_OPTION              = (IP_STATUS_BASE + 7);
  IP_HW_ERROR                = (IP_STATUS_BASE + 8);
  IP_PACKET_TOO_BIG          = (IP_STATUS_BASE + 9);
  IP_REQ_TIMED_OUT           = (IP_STATUS_BASE + 10);
  IP_BAD_REQ                 = (IP_STATUS_BASE + 11);
  IP_BAD_ROUTE               = (IP_STATUS_BASE + 12);
  IP_TTL_EXPIRED_TRANSIT     = (IP_STATUS_BASE + 13);
  IP_TTL_EXPIRED_REASSEM     = (IP_STATUS_BASE + 14);
  IP_PARAM_PROBLEM           = (IP_STATUS_BASE + 15);
  IP_SOURCE_QUENCH           = (IP_STATUS_BASE + 16);
  IP_OPTION_TOO_BIG          = (IP_STATUS_BASE + 17);
  IP_BAD_DESTINATION         = (IP_STATUS_BASE + 18);
{ The next group are status codes passed up on status indications to
  transport layer protocols. }
  IP_ADDR_DELETED            = (IP_STATUS_BASE + 19);
  IP_SPEC_MTU_CHANGE         = (IP_STATUS_BASE + 20);
  IP_MTU_CHANGE              = (IP_STATUS_BASE + 21);
  IP_UNLOAD                  = (IP_STATUS_BASE + 22);
  IP_ADDR_ADDED              = (IP_STATUS_BASE + 23);
  IP_MEDIA_CONNECT           = (IP_STATUS_BASE + 24);
  IP_MEDIA_DISCONNECT        = (IP_STATUS_BASE + 25);
  IP_BIND_ADAPTER            = (IP_STATUS_BASE + 26);
  IP_UNBIND_ADAPTER          = (IP_STATUS_BASE + 27);
  IP_DEVICE_DOES_NOT_EXIST   = (IP_STATUS_BASE + 28);
  IP_DUPLICATE_ADDRESS       = (IP_STATUS_BASE + 29);
  IP_INTERFACE_METRIC_CHANGE = (IP_STATUS_BASE + 30);
  IP_RECONFIG_SECFLTR        = (IP_STATUS_BASE + 31);
  IP_NEGOTIATING_IPSEC       = (IP_STATUS_BASE + 32);
  IP_INTERFACE_WOL_CAPABILITY_CHANGE = (IP_STATUS_BASE + 33);
  IP_DUPLICATE_IPADD         = (IP_STATUS_BASE + 34);
  IP_GENERAL_FAILURE         = (IP_STATUS_BASE + 50);
  MAX_IP_STATUS              = IP_GENERAL_FAILURE;
  IP_PENDING                 = (IP_STATUS_BASE + 255);
{ Values used in the IP header Flags field. }
  IP_FLAG_DF      = $2;      { Don't fragment this packet. }

{ Supported IP Option Types. }
{ These types define the options which may be used in the OptionsData field
  of the ip_option_information structure.  See RFC 791 for a complete
  description of each. }
  IP_OPT_EOL      = 0;       { End of list option }
  IP_OPT_NOP      = 1;       { No operation }
  IP_OPT_SECURITY = $82;     { Security option }
  IP_OPT_LSRR     = $83;     { Loose source route }
  IP_OPT_SSRR     = $89;     { Strict source route }
  IP_OPT_RR       = $7;      { Record route }
  IP_OPT_TS       = $44;     { Timestamp }
  IP_OPT_SID      = $88;     { Stream ID (obsolete) }
  IP_OPT_ROUTER_ALERT = $94; { Router Alert Option }
  MAX_OPT_SIZE    = 40;      { Maximum length of IP options in bytes }
type
{ IP types }
  TIPAddr   = DWORD; { An IP address. }
  TIPMask   = DWORD; { An IP subnet mask. }
  TIPStatus = DWORD; { Status code returned from IP APIs. }
{ The ip_option_information structure describes the options to be
  included in the header of an IP packet. The TTL, TOS, and Flags
  values are carried in specific fields in the header. The OptionsData
  bytes are carried in the options area following the standard IP header.
  With the exception of source route options, this data must be in the
  format to be transmitted on the wire as specified in RFC 791. A source
  route option should contain the full route - first hop thru final
  destination - in the route data. The first hop will be pulled out of the
  data and the option will be reformatted accordingly. Otherwise, the route
  option should be formatted as specified in RFC 791. }
  PIPOptionInformation = ^TIPOptionInformation;
  TIpOptionInformation = packed record
    Ttl: BYTE;          { Time To Live }
    Tos: BYTE;          { Type Of Service }
    Flags: BYTE;        { IP header flags }
    OptionsSize: BYTE;  { Size in bytes of options data }
    OptionsData: PBYTE; { Pointer to options data }
  end;
{ The icmp_echo_reply structure describes the data returned in response
  to an echo request. }
  PIcmpEchoReply = ^TIcmpEchoReply;
  TIcmpEchoReply = packed record
    Address: TIPAddr;              { Replying address }
    Status: DWORD;                 { Reply IP_STATUS }
    RoundTripTime: DWORD;          { RTT in milliseconds }
    DataSize: WORD;                { Reply data size in bytes }
    Reserved: WORD;                { Reserved for system use }
    Data: Pointer;                 { Pointer to the reply data }
    Options: TIpOptionInformation; { Reply options }
  end;

function IcmpCreateFile: THandle; stdcall;
function IcmpCloseHandle(IcmpHandle: THandle): BOOL; stdcall;
function IcmpSendEcho(IcmpHandle: THandle;
                      DestinationAddress: TIPAddr;
                      RequestData: Pointer;
                      RequestSize: WORD;
                      RequestOptions: PIPOptionInformation;
                      ReplyBuffer: Pointer;
                      ReplySize: DWORD;
                      Timeout: DWORD): DWORD; stdcall;
implementation
const
  icmplib = 'icmp.dll';
function IcmpCreateFile;  external icmplib name 'IcmpCreateFile';
function IcmpCloseHandle; external icmplib name 'IcmpCloseHandle';
function IcmpSendEcho;    external icmplib name 'IcmpSendEcho';
end.

unit UScanIP;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, StdCtrls, Buttons, Mask, Icmp, Winsock, NB30;
type
  PNBStat = ^TNBStat;
  TNBStat = packed record
    AdapterStatus: TAdapterStatus;
    NameBuffer: array of TNameBuffer;
  end;
  PNBInfo = ^TNBInfo;
  TNBInfo = packed record
    ComputerName: string[NCBNAMSZ];
    GroupName: string[NCBNAMSZ];
    MacAddress: string[17];
  end;

type
  TForm1 = class(TForm)
    ME1: TMaskEdit;
    ME2: TMaskEdit;
    BitBtn1: TBitBtn;
    StringGrid1: TStringGrid;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
    function GetLana(var LanaEnum: TLanaEnum): Boolean;
    function NBReset(const LanaNum: Char): Boolean;
    //function Execute(P: Pointer): Integer;
  public
    { Public declarations }
  end;
const
  MAX_THREAD_COUNT = 16; { the recommended limit is 16 active threads per
                           process on single processor systems. }

var
  Form1: TForm1;
  StartAddress, EndAddress, CurrentAddress: Longint;
  dwTimeOut: DWORD = 1000;
  WSAData: TWSAData;
  LanaEnum: TLanaEnum;
  hIcmp: THandle;
  Params: array of Longint;
  Handles: array of THandle;
  CSect: TRTLCriticalSection;
  i, j: Integer;
  ThreadID: DWORD;
  alamat_IP : array of string[15];
  StringGrid0 : TStringGrid;
procedure nulis(s0,s1,s2,s3 : string);
function Execute(P: Pointer): Integer;
implementation

{$R *.dfm}
{$R Version.res}
function GetNetBiosInfo(const LanaNum: Char; const IpAddress: string;
  var NBInfo: TNBInfo): Boolean;
var
  NCB: TNCB;
  NBStat: TNBStat;
  i: Integer;
begin
  FillChar(NCB, SizeOf(TNCB), 0);
  FillChar(NBStat, SizeOf(TNBStat), 0);
  with NCB do
  begin
    ncb_command := Char(NCBASTAT);
    ncb_buffer := PChar(@NBStat);
    ncb_length := SizeOf(TNBStat);
    StrCopy(ncb_callname, PChar(IpAddress));
    ncb_lana_num := LanaNum;
    NetBios(@NCB);
    Result := ncb_retcode = Char(NRC_GOODRET);
    with NBStat, NBInfo do
      if Result then
      begin
        for i := 0 to AdapterStatus.name_count - 1 do
          if (NameBuffer[i].Name[15] =#0)then
          begin
            case NameBuffer[i].name_flags of
              Char(UNIQUE_NAME + REGISTERED):
                ComputerName := Trim(NameBuffer[i].Name);
              Char(GROUP_NAME + REGISTERED):
                GroupName := Trim(NameBuffer[i].Name);
            end;
            if (ComputerName <> '') and (GroupName <> '') then
              Break;
          end;
        MacAddress := Format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%2.2x', ),
                             Byte(AdapterStatus.adapter_address[1]),
                             Byte(AdapterStatus.adapter_address[2]),
                             Byte(AdapterStatus.adapter_address[3]),
                             Byte(AdapterStatus.adapter_address[4]),
                             Byte(AdapterStatus.adapter_address[5])]);
      end
      else
      begin
        ComputerName := '?';
        GroupName := '?';
        MacAddress := '?-?-?-?-?-?';
      end;
  end;
end;
function Ping(IpAddress: DWORD): Boolean;
const
  BUFFER_SIZE  = 32;
var
  dwRetVal: DWORD;
  PingBuffer: Pointer;
  pIpe: PIcmpEchoReply;
begin
  GetMem(pIpe, SizeOf(TICMPEchoReply) + BUFFER_SIZE);
  try
    GetMem(PingBuffer, BUFFER_SIZE);
    try
      FillChar(PingBuffer^, BUFFER_SIZE, $AA);
      pIpe^.Data := PingBuffer;
      dwRetVal := IcmpSendEcho(hIcmp, IpAddress, PingBuffer, BUFFER_SIZE, nil,
                               pIpe, SizeOf(TICMPEchoReply) + BUFFER_SIZE, dwTimeOut);
      Result := dwRetVal <> 0;
    finally
      FreeMem(PingBuffer);
    end;
  finally
    FreeMem(pIpe);
  end;
end;

function TForm1.GetLana(var LanaEnum: TLanaEnum): Boolean;
var
  NCB: TNCB;
begin
  FillChar(LanaEnum, SizeOf(LanaEnum), 0);
  FillChar(NCB, SizeOf(NCB), 0);
  with NCB do
  begin
    ncb_command := Char(NCBENUM);
    ncb_buffer := PChar(@LanaEnum);
    ncb_length := SizeOf(TLanaEnum);
    Netbios(@NCB);
    Result := (ncb_retcode = Char(NRC_GOODRET)) and (Byte(LanaEnum.length) > 0);
  end;
end;
function TForm1.NBReset(const LanaNum: Char): Boolean;
var
  NCB: TNCB;
begin
  FillChar(NCB, SizeOf(NCB), 0);
  with NCB do
  begin
    ncb_command := Char(NCBRESET);
    ncb_lana_num := LanaNum;
    Netbios(@NCB);
    Result := (ncb_retcode = Char(NRC_GOODRET));
  end;
end;

//function TForm1.Execute(P: Pointer): Integer;
function Execute(P: Pointer): Integer;
var
  HostByteOrder: DWORD;
  IpAddress: string;
  i: Integer;
  NBInfo: TNBInfo;
begin
  HostByteOrder := ntohl(PDWORD(P)^);
  if Ping(HostByteOrder) then
  begin
    IpAddress := Format('%d.%d.%d.%d', [HostByteOrder and $FF,
                                       (HostByteOrder shr 8) and $FF,
                                       (HostByteOrder shr 16) and $FF,
                                       (HostByteOrder shr 24) and $FF]);
    for i := 0 to Byte(LanaEnum.length) - 1 do
    begin
      FillChar(NBInfo, SizeOf(NBInfo), 0);
      if GetNetBiosInfo(LanaEnum.lana[i], IpAddress, NBInfo) then
        Break;
    end;
    EnterCriticalSection(CSect);
    try
{      StringGrid1.Cells := IpAddress;
      StringGrid1.Cells := NBInfo.ComputerName;
      StringGrid1.Cells := NBInfo.GroupName;
      StringGrid1.Cells := NBInfo.MacAddress;
      StringGrid1.RowCount := StringGrid1.RowCount + 1;}
{      Writeln(Format('%-16s%-16s%-16s%-17s', ));}
    nulis(IpAddress, NBInfo.ComputerName, NBInfo.GroupName, NBInfo.MacAddress);
    finally
      LeaveCriticalSection(CSect);
    end;
  end;
  Result := 0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  StringGrid1.ColWidths[0] := 100;
  StringGrid1.ColWidths[1] := 200;
  StringGrid1.ColWidths[2] := 100;
  StringGrid1.ColWidths[3] := 150;
  StringGrid1.Cells[0,0] := 'IP Adress';
  StringGrid1.Cells[1,0] := 'Computer Name';
  StringGrid1.Cells[2,0] := 'Group Name';
  StringGrid1.Cells[3,0] := 'Mac Address';
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
  a : string;
begin
  StringGrid0 := TStringGrid.Create(Application);
  StringGrid0 := StringGrid1;
  StringGrid1.RowCount := 2;
  StringGrid1.Cells := '';
  if ME1.Text = '   .   .   .   ' then
    ShowMessage('Isi IP Start');
  if ME2.Text = '   .   .   .   ' then
    ShowMessage('Isi IP End');
{  if (ParamCount < 2) or (ParamCount > 4) then
  begin
    Writeln(#13#10'Displays network information: IP Address, Computer Name, Group, MAC Address.'#13#10#13#10 +
      'Usage: ipscan startIP endIP [-w timeout]'#13#10#13#10 +
      '-w timeout  Interval in milliseconds to wait for each ICMP echo reply.'#13#10 +
      '            The default is 1000.'#13#10#13#10 +
      'Example: ipscan 167.33.34.1 167.33.34.254 -w 3000'#13#10#13#10 +
      'This program is freeware.'#13#10 +
      'Author: Vadim Crits'#13#10);
    Halt;
  end;}
  if (ME2.Text <> '   .   .   .   ') or (ME2.Text <> '   .   .   .   ') then begin
    a := Trim(ME1.Text);
    //StartAddress := htonl(inet_addr(PChar(ParamStr(1))));
    StartAddress := htonl(inet_addr(PChar(a)));
    //if (StartAddress = INADDR_NONE) or (Pos('.', ParamStr(1)) = 0) then
    if (StartAddress = INADDR_NONE) or (Pos('.', a) = 0) then
    begin
      //Writeln(#13#10'Invalid startIP.');
      ShowMessage(#13#10'Invalid startIP.');
      Halt;
    end;
    a := Trim(ME2.Text);
    //EndAddress := htonl(inet_addr(PChar(ParamStr(2))));
    EndAddress := htonl(inet_addr(PChar(a)));
    //if (EndAddress = INADDR_NONE) or (Pos('.', ParamStr(2)) = 0) then
    if (EndAddress = INADDR_NONE) or (Pos('.', a) = 0) then
    begin
      //Writeln(#13#10'Invalid endIP.');
      ShowMessage(#13#10'Invalid endIP.');
      Halt;
    end;
    if StartAddress > EndAddress then
    begin
      //Writeln(#13#10'startIP cannot be greater than endIP.');
      ShowMessage(#13#10'startIP cannot be greater than endIP.');
      Halt;
    end;
    {if (ParamCount > 2) then
      if FindCmdLineSwitch('w', ['-'], True) then
        try
          if StrToInt(ParamStr(4)) > 0 then
            dwTimeOut := StrToInt(ParamStr(4))
          else
            Abort;
        except
          Writeln(#13#10'Invalid timeout value.');
          Halt;
        end
      else
      begin
        Writeln(#13#10'Invalid command line switch.');
        Halt;
      end;}
    if WSAStartup($0101, WSAData) <> 0 then
    begin
      //Writeln(#13#10'Could not initialize Winsock.');
      ShowMessage(#13#10'Could not initialize Winsock.');
      Halt;
    end;
    if not GetLana(LanaEnum) then
    begin
      //Writeln(#13#10'Problem with network adapter.');
      ShowMessage(#13#10'Problem with network adapter.');
      Halt;
    end;
    if Win32Platform = VER_PLATFORM_WIN32_NT then
      for i := 0 to Byte(LanaEnum.length) - 1 do
        if not NBReset(LanaEnum.lana[i]) then
        begin
          //Writeln(#13#10'Reset Lana error.');
          ShowMessage(#13#10'Reset Lana error.');
          Halt;
        end;
    hIcmp := IcmpCreateFile;
    if hIcmp = INVALID_HANDLE_VALUE then
    begin
      //Writeln(#13#10'Could not initialize icmp.dll.');
      ShowMessage(#13#10'Could not initialize icmp.dll.');
      Halt;
    end;
  {
    Writeln;
    Writeln(Format('%-16s%-16s%-16s%-17s', ['IP Address', 'Computer Name',
                                            'Group', 'MAC Address']));
    Writeln(Format('%s %s %s %s', ['===============', '===============',
                                   '===============', '=================']));
  }
    i := 0;
    CurrentAddress := StartAddress;
    FillChar(Params, SizeOf(Params), 0);
    FillChar(Handles, SizeOf(Handles), 0);
    InitializeCriticalSection(CSect);
    try
      while True do
      begin
        Params[i] := CurrentAddress;
        Handles[i] := BeginThread(nil, 0, Execute, @Params[i], 0, ThreadID);
        Inc(i);
        if (i = MAX_THREAD_COUNT) or (CurrentAddress = EndAddress) then
        begin
          WaitForMultipleObjects(i, @Handles, True, INFINITE);
          for j := 0 to i - 1 do
            CloseHandle(Handles[j]);
          FillChar(Params, SizeOf(Params), 0);
          FillChar(Handles, SizeOf(Handles), 0);
          i := 0;
        end;
        if CurrentAddress = EndAddress then
          Break
        else
          Inc(CurrentAddress);
      end;
    finally
      DeleteCriticalSection(CSect);
      IcmpCloseHandle(hIcmp);
      WSACleanup;
    end;
  end;
  StringGrid1 := StringGrid0;
//  StringGrid0.Free;
end;
procedure nulis(s0, s1, s2, s3: string);
begin
      StringGrid0.Cells := s0;
      StringGrid0.Cells := s1;
      StringGrid0.Cells := s2;
      StringGrid0.Cells := s3;
      StringGrid0.RowCount := StringGrid0.RowCount + 1;
end;
end.