Rede - rastrear ip na rede

Top  Previous  Next

unit ResolverIPs;

 

interface

 

uses Forms, winsock, StdCtrls, Classes, Controls, ComCtrls, Windows, sysutils, Dialogs;

 

type

 

  // ************ declaration of Snmp types *****************

  PAsnObjectIdentifier = ^AsnObjectIdentifier;

  AsnObjectIdentifier = record

    idLength:          Cardinal;                 // number of integers in object

    ids:               ^Cardinal;                // pointer to integer stream

  end;

  AsnOctetString = record

    _stream:          ^BYTE;                 // pointer to octet stream

     length:           Cardinal;             // number of octets in stream

    _dynamic:          BOOL;                 // true if octets must be freed

  end

  TAsnValue = (number, _string, _object, sequence, address, counter,

               gauge, ticks, arbitrary); 

  TAsnValueUnion = record                    // translation of C++ Union 

    case TAsnValue of

      number   :(number   :Longint);         //..integer tag. %ld(long) 

      _string  :(_string  :AsnOctetString);  //..octet string tag. putchar

      _object  :(_object  :AsnObjectIdentifier);//..object identifier tag. .1.2.3.4 

      sequence :(sequence :AsnOctetString);  //..ASN sequence variable. ASN_OCTET STRING 

      address  :(address  :AsnOctetString);  //..IP address variable. 157.578.160 

      counter  :(counter  :DWORD);           //..counter variable. %lu (unsigned log) 

      gauge    :(gauge    :DWORD);           //..gauge variable. %lu (unsigned log) 

      ticks    :(ticks    :DWORD);           //..timeticks variable. %lu (unsigned log) 

      arbitrary:(arbitrary:AsnOctetString);  //..opaque variable. 0x5 ox3 ox 

  end

  AsnAny = record 

    asnType:           BYTE;                 // Indicates a ... (look at top) 

    asnValue:          TAsnValueUnion;       // Contains the variable's value.

  end;

  RFC1157VarBind = record

    name:              AsnObjectIdentifier;  // variable's object identifer

    value:             AsnAny;               // variable's value (in asn terms)

  end;

  PRFC1157VarBindList = ^RFC1157VarBindList;

  RFC1157VarBindList = record

    list:             ^RFC1157VarBind;       // array of variable bindings

    len:               Cardinal;             // number of bindings in array

  end;

  PAsnInteger = ^Longint;

  TData = record                             // return Data of Snmp for Print

    Protocol   :String;

    LocalIP    :Cardinal;

    LocalPort  :Cardinal;

    RemoteIP   :Cardinal;

    RemotePort :UINT;

    State      :String;

  end;

  TCardinalArray = Array of Cardinal;

  TCardinal      = ^Cardinal;

 

  TForm1 = class(TForm)

    // turn to "ViewStyle=vsReport" and add 4 Columns:

    // Protocol, Local Address:Port, Remote Address:Port, State

    ListView1: TListView;

    Button1: TButton;

    CheckBoxResolve: TCheckBox;

    procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn);

    procedure Button1Click(Sender: TObject);

    procedure ListView1Compare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);

  private

    ColumnToSort: Integer;

  end;

 

var

  Form1: TForm1;

 

  function GetIpHostName(resolve:Boolean;ipaddr:Cardinal;remote:Boolean):String;

  function GetPortName(resolve:Boolean;port:Cardinal;proto:string; ipaddr:Cardinal;remote:Boolean):String;

 

implementation

 

{$R *.dfm}

 

 

//-------------------------------------------------------------------------

// GetIpHostName

// Translate IP addresses into their name-resolved form if possible.

// Translate from C [(C) 1998 Mark Russinovich Systems Internals] to Delphi

//-------------------------------------------------------------------------

function GetIpHostName(resolve:Boolean;ipaddr:Cardinal;remote:Boolean):String;

var

  P_hostent: PHostent;

  nipaddr  : Cardinal;

  Buffer   : array [0..255of char;

begin

  nipaddr:=htonl(ipaddr);                          //change right bytes to left

  if NOT resolve OR (remote AND NOT Boolean(nipaddr)) then

    result:=format('%d.%d.%d.%d', [(nipaddr shr 24AND $FF, (nipaddr shr 16AND $FF,

                                   (nipaddr shr  8AND $FF, (nipaddr       ) AND $FF])

  else

    if not Boolean(nipaddr) then

    begin             //0.0.0.0 ???

      //The Windows Sockets gethostname function returns the standard host

      // name for the local machine

      GetHostName(Buffer,SizeOf(Buffer));

      result:=StrPas(Buffer);

    end

    else

      if nipaddr = $7f000001 then

      begin            //127.0.0.1 ???

        GetHostName(Buffer,SizeOf(Buffer));

        result:=StrPas(Buffer);

      end

      else

      begin

        //The Windows Sockets gethostbyaddr function gets host information

        // corresponding to an address

        P_hostent:=GetHostByAddr(PChar(@ipaddr),Sizeof(nipaddr), PF_INET);

        if P_hostent<>nil then

          result:=StrPas(P_hostent.h_name)

        else

          result:=format('%d.%d.%d.%d',

                         [(nipaddr shr 24AND $FF, (nipaddr shr 16AND $FF,

                          (nipaddr shr  8AND $FF, (nipaddr       ) AND $FF]);

      end;

end;

 

//-------------------------------------------------------------------------

// GetPortName

// Translate port numbers into their text equivalent if there is one

// Translate from C [(C) 1998 Mark Russinovich Systems Internals] to Delphi

//-------------------------------------------------------------------------

function  GetPortName(resolve:Boolean;port:Cardinal;proto:string; ipaddr:Cardinal;remote:Boolean):String;

var

  psrvent:PServEnt;

begin

  if remote AND NOT Boolean(ipaddr) then

    result:='0'

  else

    if resolve then

    begin

      //The Windows Sockets getservbyport function gets service information

      // corresponding to a port and protocol

      psrvent:=GetServByPort( htons(port),PChar(proto));

      if psrvent<>nil then

        result:=StrPas(psrvent.s_name)

      else

        result:=format('%d',[port]);

    end

    else

      result:=format('%d',[port]);

end;

 

procedure TForm1.Button1Click(Sender: TObject);

const

  ASN_CONSTRUCTOR            = $20;

  ASN_CONTEXTSPECIFIC        = $80;

  ASN_RFC1157_GETNEXTREQUEST = ASN_CONTEXTSPECIFIC OR ASN_CONSTRUCTOR OR $01;

  tcpidentifiers: array [0..9of Cardinal = (1,3,6,1,2,1,6,13,1,1);

  udpidentifiers: array [0..9of Cardinal = (1,3,6,1,2,1,75,1,1);

  //I don't know, what is the meaning of the identifiers, no list found ???

  TcpState: array [0..11of String = ('???','CLOSED','LISTENING','SYN_SENT',

                                       'SEN_RECEIVED','ESTABLISHED','FIN_WAIT','FIN_WAIT2','CLOSE_WAIT',

                                       'CLOSING','LAST_ACK','TIME_WAIT');

var

  pSnmpExtensionInit:function (dwTimeZeroReference:DWORD; hPollForTrapEvent:PHandle;

                               supportedView:PAsnObjectIdentifier):Boolean; stdcall;

 

  pSnmpExtensionQuery:function (requestType:Byte; variableBindings:PRFC1157VarBindList;

                                errorStatus:PAsnInteger; errorIndex:PAsnInteger):Boolean; stdcall;

 

  wVersionRequested : WORD;                //Version of WinSock field

  hInetLib          : THandle;             //Library (inetmib1.dll) address

  _wsaData          : WSADATA;             //data structure WinSock implementation

  hTrapEvent        : THandle;             //Handle to event object

  hIdentifier       : AsnObjectIdentifier; //ASN Object

  errorStatus,

  errorIndex        : Longint;

  bindList          : RFC1157VarBindList;  //connection List

  bindEntry         : RFC1157VarBind;      //connection

  ActualDataType    : Cardinal;            //delivered Datatype of query function

  Data              : Array of TData;      //collecting data

  DataPointer       : Integer;             //pointer to actual data field

  ListItem          : TListItem;

  n                 : Integer;

begin

  // Initialize winsock

  //The MAKEWORD macro creates an unsigned 16-bit integer by concatenating two

  // given unsigned character values.

  wVersionRequested:=MAKEWORD( 11 );

  //The Windows Sockets WSAStartup function initiates use of the Windows

  // Sockets DLL by a process.

  if Boolean(WSAStartup(wVersionRequested,_wsaData )) then

  begin

    ShowMessage('Could not initialize Winsock.');

    exit;

  end;

  // Locate and initialize INETMIB1

  hInetLib:=LoadLibrary('inetmib1.dll');

  if hInetLib=0 then

  begin

    ShowMessage('Could not load extension DLL "inetmib1.dll".');

    exit;

  end

  else

  begin

    @pSnmpExtensionInit:=GetProcAddress(hInetLib,'SnmpExtensionInit');

    if @pSnmpExtensionInit=nil then

    begin

      ShowMessage('Could not load extension DLL "inetmib1.dll".');

      exit;

    end

    else

    begin

      @pSnmpExtensionQuery:=GetProcAddress(hInetLib,'SnmpExtensionQuery');

      if @pSnmpExtensionQuery=nil then

      begin

        ShowMessage('Could not load extension DLL "inetmib1.dll".');

        exit;

      end;

    end;

  end;

  //The CreateEvent function creates a named or unnamed event object.

  hTrapEvent:=CreateEvent(nil, TRUE, FALSE,nil);

  //The extensible agent calls the SnmpExtensionInit function in the extension

  // agent DLL to perform bilateral initialization of both the extension and

  // the extensible agents.

  if not pSnmpExtensionInit(GetTickCount,@hTrapEvent,@hIdentifier) then

  begin

    ShowMessage('Could not initialize extension DLL "inetmib1.dll".');

    exit;

  end;

  //********************** TCP ********************************************

  // Initialize the query structure once

  bindEntry.name.idLength := 10;

  bindEntry.name.ids      := @tcpidentifiers;

  //In the .List field is the address of the actual List with the return Data

  bindList.list           := @bindEntry;

  bindList.len            := 1;

  //Roll through TCP connections

  ActualDataType          := 1;  //look at the case option

  DataPointer             := 0;  //Points to the actual Data in Array

  while 1=1 do

  begin

    if NOT pSnmpExtensionQuery( ASN_RFC1157_GETNEXTREQUEST, @bindList, @errorStatus, @errorIndex ) then

    begin

      ShowMessage('Fault in query bind list...exit');

      exit;

    end;

    // Terminate when we are no longer seeing TCP information

    if bindEntry.name.idLength < 10 then break;

    // Go back to start of table if we're reading info about the next byte

    if ActualDataType <> TCardinalArray(bindEntry.name.ids)[9] then

    begin

      ActualDataType:=TCardinalArray(bindEntry.name.ids)[9];

      DataPointer:=0;

    end;

    // Build our TCP information table

    case TCardinalArray(bindEntry.name.ids)[9of

      1:begin  // Add new Data to Array                     State of connection

          SetLength(Data,length(Data)+1);

          Data[DataPointer].Protocol:='TCP';

          Data[DataPointer].State:=TcpState[bindEntry.value.asnValue.number];

        end;

      2:Data[DataPointer].LocalIP   := TCardinal(bindEntry.value.asnValue.address._stream)^; //Local IP-address

      3:Data[DataPointer].LocalPort := bindEntry.value.asnValue.number;                      //Local Port

      4:Data[DataPointer].RemoteIP  := TCardinal(bindEntry.value.asnValue.address._stream)^; //Remote IP-address

      5:Data[DataPointer].RemotePort:= bindEntry.value.asnValue.number;                      //Remote Port

    end;

    DataPointer:=DataPointer+1;

  end;

  // Now print the TCP connection information

  for n:= 0 to Length(Data)-1 do

  begin

    with ListView1 do

    begin

      ListItem := Items.Add;

      ListItem.Caption := Data[n].Protocol;

      ListItem.SubItems.Add( GetIpHostName(CheckBoxResolve.Checked,Data[n].LocalIP,false) + ':' +

                             GetPortName(CheckBoxResolve.Checked,Data[n].LocalPort,'tcp',

                             Data[n].LocalIP,false));

      ListItem.SubItems.Add( GetIpHostName(CheckBoxResolve.Checked,Data[n].RemoteIP,true) + ':'+

                             GetPortName(CheckBoxResolve.Checked,Data[n].RemotePort,'tcp',

                              Data[n].RemoteIP,true));

      ListItem.SubItems.Add(Data[n].State);

    end;

    Application.ProcessMessages;

  end;

  Finalize(Data);

  //********************** UDP ********************************************

  // Initialize the query structure once

  bindEntry.name.idLength := 10;

  bindEntry.name.ids      := @udpidentifiers;

  //In the .List field is the address of the actual List with the return Data

  bindList.list           := @bindEntry;

  bindList.len            := 1;

  //Roll through TCP connections

  ActualDataType          := 1;  //look at the case option

  DataPointer             := 0;  //Points to the actual Data in Array

  while True do

  begin

    if NOT pSnmpExtensionQuery( ASN_RFC1157_GETNEXTREQUEST, @bindList, @errorStatus, @errorIndex ) then

    begin

      ShowMessage('Fault in query bind list...exit');

      exit;

    end;

    // Terminate when we are no longer seeing TCP information

    if bindEntry.name.idLength < 10 then break;

    // Go back to start of table if we're reading info about the next byte

    if ActualDataType <> TCardinalArray(bindEntry.name.ids)[9] then

    begin

      ActualDataType:=TCardinalArray(bindEntry.name.ids)[9];

      DataPointer:=0;

    end;

    // Build our UDP information table

    case TCardinalArray(bindEntry.name.ids)[9of

      1:begin  // Add new Data to Array                     State of connection

          SetLength(Data,length(Data)+1);

          Data[DataPointer].Protocol := 'UDP';

          Data[DataPointer].LocalIP  := TCardinal(bindEntry.value.asnValue.address._stream)^;

        end;

      2:Data[DataPointer].LocalPort := bindEntry.value.asnValue.number; //Local Port

    end;

    DataPointer := DataPointer + 1;

  end;

  // Now print the UDP connection information

  for n:= 0 to Length(Data)-1 do

  begin

    with ListView1 do

    begin

      ListItem         := Items.Add;

      ListItem.Caption := Data[n].Protocol;

      ListItem.SubItems.Add( GetIpHostName(CheckBoxResolve.Checked,Data[n].LocalIP,false)+':'+

                             GetPortName(CheckBoxResolve.Checked,Data[n].LocalPort,'udp',

                             Data[n].LocalIP,false));

      ListItem.SubItems.Add('*.*.*.*:*');

      ListItem.SubItems.Add('');

    end;

    Application.ProcessMessages;

  end;

  Finalize(Data);

end;

 

procedure TForm1.ListView1Compare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);

var

  ix: Integer;

begin

  if ColumnToSort = 0 then

    Compare := CompareText(Item1.Caption,Item2.Caption)

  else

  begin

   ix := ColumnToSort - 1;

   Compare := CompareText(Item1.SubItems[ix],Item2.SubItems[ix]);

  end;

end;

 

procedure TForm1.ListView1ColumnClick(Sender: TObject; Column: TListColumn);

begin

  ColumnToSort := Column.Index;

  (Sender as TCustomListView).AlphaSort;

end;

 

end.