Форум на Исходниках.RU

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

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

// * 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 = 000; // 2^16

SIO_RCVALL = 000001;

WSA_VER = 2;

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;

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

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;

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 [..F] then

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

else

DumpData := DumpData + '.';

Inc(I);

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;

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

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.