////////////////////////////////////////////////////////////////////////////////

//

//  ****************************************************************************

//  * Project   : SnifferDemo

//  * Unit Name : uMain

//  * Purpose   : Демонстрационный пример сниффера.

//  * Author    : Александр (Rouse_) Багель

//  * Version   : 1.02

//  * Home Page : http://rouse.drkb.ru

//  ****************************************************************************

//

//  Особая благодарность TrefptYc и группе Машина Времени,

//  за оказанную моральную поддержку, в процессе написания данного примера :)

//

//  ****************************************************************************    

//  От автора:

//  Я не ставил перед собой целью написать что-то революционное,

//  просто было желание показать сам принцип написания простейшего сниффера,

//  что я и осуществил :)

//

//  Да, ну и работает все это бесчинство, только начиная с Windows 2000 :)

//

 

unit uMain;

 

interface

 

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, WinSock;

 

const

  MAX_PACKET_SIZE = $10000; // 2^16

  SIO_RCVALL = $98000001;

  WSA_VER = $202;

  MAX_ADAPTER_NAME_LENGTH        = 256;

  MAX_ADAPTER_DESCRIPTION_LENGTH = 128;

  MAX_ADAPTER_ADDRESS_LENGTH     = 8;

  IPHelper = 'iphlpapi.dll';

 

  // Тип ICMP пакета

  ICMP_ECHO             = 8;   // Запрос

  ICMP_ECHOREPLY        = 0;   // Ответ

 

resourcestring

  LOG_STR_0 = '==============================================================================' + sLineBreak;

  LOG_STR_1 = 'Packet ID: %-5d TTL: %d' + sLineBreak;

  LOG_STR_2 = 'Packet size: %-5d bytes type: %s' + sLineBreak;

  LOG_STR_3 = 'Source IP      : %15s: %d' + sLineBreak;

  LOG_STR_4 = 'Destination IP : %15s: %d' + sLineBreak;

  LOG_STR_5 = 'ARP Type: %s, operation: %s' + sLineBreak;

  LOG_STR_6 = 'ICMP Type: %s' + sLineBreak;

  LOG_STR_7 = '------------------------------ Packet dump -----------------------------------' + sLineBreak;

 

type

  USHORT = WORD;

  ULONG = DWORD;

  time_t = Longint;

 

  // ip заголовок

  // Более подробно в RFC 791

  // http://rtfm.vn.ua/inet/prot/rfc791r.html

  TIPHeader = packed record

    iph_verlen:   UCHAR;    // версия и длина заголовка

    iph_tos:      UCHAR;    // тип сервиса

    iph_length:   USHORT;   // длина всего пакета

    iph_id:       USHORT;   // Идентификация

    iph_offset:   USHORT;   // флаги и смещения

    iph_ttl:      UCHAR;    // время жизни пакета

    iph_protocol: UCHAR;    // протокол

    iph_xsum:     USHORT;   // контрольная сумма

    iph_src:      ULONG;    // IP-адрес отправителя

    iph_dest:     ULONG;    // IP-адрес назначения

  end;

  PIPHeader = ^TIPHeader;

 

  // tcp заголовок

  // Более подробно в RFC 793

  // http://rtfm.vn.ua/inet/prot/rfc793r.html

  TTCPHeader = packed record

    sourcePort: USHORT;       // порт отправителя

    destinationPort: USHORT;  // порт назначения

    sequenceNumber: ULONG;    // номер последовательности

    acknowledgeNumber: ULONG; // номер подтверждения

    dataoffset: UCHAR;        // смещение на область данных

    flags: UCHAR;             // флаги

    windows: USHORT;          // размер окна

    checksum: USHORT;         // контрольная сумма

    urgentPointer: USHORT;    // срочность

  end;

  PTCPHeader = ^TTCPHeader;

 

  // udp заголовок

  // Более подробно в RFC 768

  // http://rtfm.vn.ua/inet/prot/rfc768r.html

  TUDPHeader = packed record

    sourcePort:       USHORT;  // порт отправителя

    destinationPort:  USHORT;  // порт назначения

    len:              USHORT;  // длина пакета

    checksum:         USHORT;  // контрольная сумма

  end;

  PUDPHeader = ^TUDPHeader;

 

  // ICMP заголовок

  // Более подробно в RFC 792

  // http://rtfm.vn.ua/inet/prot/rfc792r.html

  TICMPHeader = packed record

   IcmpType      : BYTE;      // Тип пакета

   IcmpCode      : BYTE;      // Код пакета

   IcmpChecksum  : WORD;

   IcmpId        : WORD;

   IcmpSeq       : WORD;

   IcmpTimestamp : DWORD;

  end;

  PICMPHeader = ^TICMPHeader;

 

 

  // Структуры для выполнения GetAdaptersInfo

  IP_ADDRESS_STRING = record

    S: array [0..15] of Char;

  end;

  IP_MASK_STRING = IP_ADDRESS_STRING;

  PIP_MASK_STRING = ^IP_MASK_STRING;

 

  PIP_ADDR_STRING = ^IP_ADDR_STRING;

  IP_ADDR_STRING = record

    Next: PIP_ADDR_STRING;

    IpAddress: IP_ADDRESS_STRING;

    IpMask: IP_MASK_STRING;

    Context: DWORD;

  end;

 

  PIP_ADAPTER_INFO = ^IP_ADAPTER_INFO;

  IP_ADAPTER_INFO = record

    Next: PIP_ADAPTER_INFO;

    ComboIndex: DWORD;

    AdapterName: array [0..MAX_ADAPTER_NAME_LENGTH + 3] of Char;

    Description: array [0..MAX_ADAPTER_DESCRIPTION_LENGTH + 3] of Char;

    AddressLength: UINT;

    Address: array [0..MAX_ADAPTER_ADDRESS_LENGTH - 1] of BYTE;

    Index: DWORD;

    Type_: UINT;

    DhcpEnabled: UINT;

    CurrentIpAddress: PIP_ADDR_STRING;

    IpAddressList: IP_ADDR_STRING;

    GatewayList: IP_ADDR_STRING;

    DhcpServer: IP_ADDR_STRING;

    HaveWins: BOOL;

    PrimaryWinsServer: IP_ADDR_STRING;

    SecondaryWinsServer: IP_ADDR_STRING;

    LeaseObtained: time_t;

    LeaseExpires: time_t;

  end;                  

 

  // Поток сниффера

  TSnifferThread = class(TThread)

  private

    WSA: TWSAData;

    hSocket: TSocket;

    Addr_in: sockaddr_in;

    Packet: array[0..MAX_PACKET_SIZE - 1] of Byte;

    LogData: String;

    procedure ShowPacket;

  protected

    function InitSocket: Boolean; virtual;

    procedure DeInitSocket(const ExitCode: Integer); virtual;

    procedure Execute; override;

    procedure ParcePacket(const PacketSize: Word); virtual;

  public

    Host: String;

  end;

 

  TfrmMain = class(TForm)

    btnStartStop: TButton;

    memReport: TMemo;

    cbInterfaces: TComboBox;

    Label1: TLabel;

    procedure FormCreate(Sender: TObject);

    procedure btnStartStopClick(Sender: TObject);

  private

    TotalPacketCount: Integer;

    FSnifferThread: TSnifferThread;

    procedure ReadLanInterfaces;

  end;

 

  // При помощи данной функции мы определим наличие сетевых интерфейсов

  // на локальном компьютере и информацию о них

  function GetAdaptersInfo(pAdapterInfo: PIP_ADAPTER_INFO;

    var pOutBufLen: ULONG): DWORD; stdcall; external IPHelper;

 

const

  // Размеры используемых структур

  IPHeaderSize = SizeOf(TIPHeader);

  ICMPHeaderSize = SizeOf(TICMPHeader);

  TCPHeaderSize = SizeOf(TTCPHeader);

  UDPHeaderSize = SizeOf(TUDPHeader);

 

var

  frmMain: TfrmMain;

 

implementation

 

{$R *.dfm}

 

{ TSnifferThread }

 

// Инициализация слушающего сокета

function TSnifferThread.InitSocket: Boolean;

var

  PromiscuousMode: Integer;

begin

  // инициализируем WinSock

  Result := WSAStartup(WSA_VER, WSA) = NOERROR;

  if not Result then

  begin

    LogData := 'Ошибка: ' + SysErrorMessage(WSAGetLastError);

    Synchronize(ShowPacket);

    Exit;

  end;

  // создаем сокет

  hSocket := socket(AF_INET, SOCK_RAW, IPPROTO_IP);

  if hSocket = INVALID_SOCKET then

  begin

    DeInitSocket(WSAGetLastError);

    Exit;

  end;

  FillChar(Addr_in, SizeOf(sockaddr_in), 0);

  Addr_in.sin_family:= AF_INET;

  // указываем за каким интерфейсом будем следить

  Addr_in.sin_addr.s_addr := inet_addr(PChar(Host));

  // связываем сокет с локальным адресом

  if bind(hSocket, Addr_in, SizeOf(sockaddr_in)) <> 0 then

  begin

    DeInitSocket(WSAGetLastError);

    Exit;

  end;

  // Переключаем интерфейс на прием всех пакетов проходящих через интерфейс - promiscuous mode.

  PromiscuousMode := 1;

  if ioctlsocket(hSocket, SIO_RCVALL, PromiscuousMode) <> 0 then

  begin

    DeInitSocket(WSAGetLastError);

    Exit;

  end;

  Result := True;

end;

 

// Завершение работы сокета

procedure TSnifferThread.DeInitSocket(const ExitCode: Integer);

begin

  // Если была ошибка - выводим ее

  if ExitCode <> 0 then

  begin

    LogData := 'Ошибка: ' + SysErrorMessage(ExitCode);

    Synchronize(ShowPacket);

  end;

  // Закрываем сокет

  if hSocket <> INVALID_SOCKET then closesocket(hSocket);

  // Деинициализируем WinSock

  WSACleanup;

end;

 

// Рабочая процедура потока сниффера

procedure TSnifferThread.Execute;

var

  PacketSize: Integer;

begin

  // Производим инициализацию

  if InitSocket then

  try

    // Крутим поток до упора

    while not Terminated do

    begin

      // Ждем получения пакета (блокирующий режим)

      PacketSize := recv(hSocket, Packet, MAX_PACKET_SIZE, 0);

      // Если есть данные - производим их разбор

      if PacketSize > SizeOf(TIPHeader) then ParcePacket(PacketSize);

    end;

  finally

    // В конце освобождаем занятые ресурсы

    DeInitSocket(NO_ERROR);

  end;

end;

 

// Процедура разборки пакета

procedure TSnifferThread.ParcePacket(const PacketSize: Word);

var

  IPHeader: TIPHeader;

  ICMPHeader: TICMPHeader;

  TCPHeader: TTCPHeader;

  UDPHeader: TUDPHeader;

  SrcPort, DestPort: Word;

  I, Octets, PartOctets: Integer;

  PacketType, DumpData, ExtendedInfo: String;

  Addr, A, B: TInAddr;

begin

  Inc(frmMain.TotalPacketCount);

  // Читаем из буфера IP заголовок

  Move(Packet[0], IPHeader, IPHeaderSize);

  // Пишем время жизни пакета

  LogData := LOG_STR_0 +

    Format(LOG_STR_1, [frmMain.TotalPacketCount, IPHeader.iph_ttl]);

  SrcPort := 0;

  DestPort := 0;

  ExtendedInfo := '';

  // определяем тип протокола

  case IPHeader.iph_protocol of

    IPPROTO_ICMP: // ICMP

    begin

      PacketType := 'ICMP';

        // Читаем ICMP заголовок

      Move(Packet[IPHeaderSize], ICMPHeader, ICMPHeaderSize);

        // Смотрим тип пакета

      case ICMPHeader.IcmpCode of

        ICMP_ECHO: ExtendedInfo := Format(LOG_STR_6, ['Echo']);

        ICMP_ECHOREPLY: ExtendedInfo := Format(LOG_STR_6, ['Echo reply']);

      else

        ExtendedInfo := Format(LOG_STR_6, ['Unknown']);

      end;

    end;

    IPPROTO_TCP: // TCP

    begin

      PacketType := 'TCP';

        // Читаем ТСР заголовок

      Move(Packet[IPHeaderSize], TCPHeader, TCPHeaderSize);

        // Смотрим порт отправителя и получателя

      SrcPort := TCPHeader.sourcePort;

      DestPort := TCPHeader.destinationPort;

    end;

    IPPROTO_UDP: // UDP

    begin

      PacketType := 'UDP';

        // Читаем UDP заголовок

      Move(Packet[IPHeaderSize], UDPHeader, UDPHeaderSize);

        // Смотрим порт отправителя и получателя

      SrcPort := UDPHeader.sourcePort;

      DestPort := UDPHeader.destinationPort;

    end;

  else

    PacketType := 'Unsupported (0x' + IntToHex(IPHeader.iph_protocol, 2) + ')';

  end;

  // Пишем размер пакета

  LogData := LogData + Format(LOG_STR_2, [PacketSize, PacketType]);

  if ExtendedInfo <> '' then

    LogData := LogData + ExtendedInfo;

 

  // Пишем IP адрес отправителя с портом

  Addr.S_addr := IPHeader.iph_src;

  LogData := LogData + Format(LOG_STR_3, [inet_ntoa(Addr), htons(SrcPort)]);

  // Пишем IP адрес получателя с портом

  Addr.S_addr := IPHeader.iph_dest;

  LogData := LogData + Format(LOG_STR_4, [inet_ntoa(Addr), htons(DestPort)]) + LOG_STR_7;

 

  // Выводим содержимое пакета на экран (парсинг комментировать не буду, там все просто)

  // получается что-то вроде этого:

  //

  // ------------------------------ Packet dump -----------------------------------

  // 000000 45 00 00 4E D8 91 00 00 | 80 11 DB 3B C0 A8 02 82     E..N.......;....

  // 000010 C0 A8 02 FF 00 89 00 89 | 00 3A AC 6A 83 BD 01 10     .........:.j....

  // 000020 00 01 00 00 00 00 00 00 | 20 45 43 46 46 45 49 44     ........ ECFFEID

  // 000030 44 43 41 43 41 43 41 43 | 41 43 41 43 41 43 41 43     DCACACACACACACAC

  // 000040 41 43 41 43 41 43 41 43 | 41 00 00 20 00 01           ACACACACA.. ..

  I := 0;

  Octets := 0;

  PartOctets := 0;

  while I < PacketSize do

  begin

    case PartOctets of

      0: LogData := LogData + Format('%.6d ', [Octets]);

      9: LogData := LogData + '| ';

      18:

      begin

        Inc(Octets, 10);

        PartOctets := -1;

        LogData := LogData + '    ' + DumpData + sLineBreak;

        DumpData := '';

      end;

    else

      begin

        LogData := LogData + Format('%s ', [IntToHex(Packet[I], 2)]);

        if Packet[I] in [$19..$7F] then

          DumpData := DumpData + Chr(Packet[I])

        else

          DumpData := DumpData + '.';

        Inc(I);

      end;

    end;

    Inc(PartOctets);

  end;

  if PartOctets <> 0 then

  begin

    PartOctets := (16 - Length(DumpData)) * 3;

    if PartOctets >= 24 then Inc(PartOctets, 2);

    Inc(PartOctets, 4);

    LogData := LogData + StringOfChar(' ', PartOctets) +

      DumpData + sLineBreak + sLineBreak

  end

  else

    LogData := LogData + sLineBreak + sLineBreak;

  // Выводим все что напарсерили в Memo

  Synchronize(ShowPacket);

end;

 

procedure TSnifferThread.ShowPacket;

begin

  frmMain.memReport.Lines.BeginUpdate;

  frmMain.memReport.Text :=

    frmMain.memReport.Text + sLineBreak + LogData;

  SendMessage(frmMain.memReport.Handle, WM_VSCROLL, SB_BOTTOM, 0);

  frmMain.memReport.Lines.EndUpdate;

end;

 

{ TfrmMain }

 

procedure TfrmMain.FormCreate(Sender: TObject);

begin

  TotalPacketCount := 0;

  ReadLanInterfaces;

end;

 

// Читаем все IP адреса со всех присутствующих

// в системе сетевых интерфейсов

procedure TfrmMain.ReadLanInterfaces;

var

  InterfaceInfo,

  TmpPointer: PIP_ADAPTER_INFO;

  IP: PIP_ADDR_STRING;

  Len: ULONG;

begin

  // Смотрим сколько памяти нам требуется?

  if GetAdaptersInfo(nil, Len) = ERROR_BUFFER_OVERFLOW then

  begin

    // Берем нужное кол-во

    GetMem(InterfaceInfo, Len);

    try

      // выполнение функции

      if GetAdaptersInfo(InterfaceInfo, Len) = ERROR_SUCCESS then

      begin

        // Перечисляем все сетевые интерфейсы

        TmpPointer := InterfaceInfo;

        repeat

          // перечисляем все IP адреса каждого интерфейса

          IP := @TmpPointer.IpAddressList;

          repeat

            cbInterfaces.Items.Add(Format('%s - [%s]',

              [IP^.IpAddress.S, TmpPointer.Description]));

            IP := IP.Next;

          until IP = nil;

          TmpPointer := TmpPointer.Next;

        until TmpPointer = nil;

      end;

    finally

      // Освобождаем занятую память

      FreeMem(InterfaceInfo);

    end;

  end;

  // Смотрим - можем ли мы продолжать работу программы?

  if cbInterfaces.Items.Count = 0 then

  begin

    memReport.Text := 'Сетевые интерфейсы не обнаружены.' + sLineBreak +

      'Продолжение работы программы не возможно.';

    btnStartStop.Enabled := False;

    Exit;

  end

  else

    cbInterfaces.ItemIndex := 0;

end;

 

// Запуск остановка потока

procedure TfrmMain.btnStartStopClick(Sender: TObject);

begin

  if FSnifferThread <> nil then

  begin

    FSnifferThread.Terminate;

    FSnifferThread := nil;

    btnStartStop.Caption := 'Start';

  end

  else

  begin

    FSnifferThread := TSnifferThread.Create(True);

    FSnifferThread.Host := Copy(cbInterfaces.Text, 1, Pos(' ', cbInterfaces.Text));

    FSnifferThread.FreeOnTerminate := True;

    FSnifferThread.Resume;

    btnStartStop.Caption := 'Stop';

  end;

end;

 

end.