Следим за исходящим траффиком

KoLoB

KoLoB.cz
Нужна инфа по отслеживанию исходящего траффика в Дельфи.
Так же не откажусь от исходника файервола или сниффера.

Так же желательна инфа на русском по использованию WinPCap (исходники приветствуються)
 

Piton

Вызываю привыкание...
Нужна инфа по отслеживанию исходящего траффика в Дельфи.
Так же не откажусь от исходника файервола или сниффера.

Так же желательна инфа на русском по использованию WinPCap (исходники приветствуються)
Вот те исходняк довольно не плохого сниффера (писал когдато для личного использования):
Код:
uses
     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 заголовок
  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 заголовок
  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 заголовок
  TUDPHeader = packed record
    sourcePort:       USHORT;  // порт отправителя
    destinationPort:  USHORT;  // порт назначения
    len:              USHORT;  // длина пакета
    checksum:         USHORT;  // контрольная сумма
  end;
  PUDPHeader = ^TUDPHeader;

  // ICMP заголовок
  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;
	
  SrcPort := htons(SrcPort);
  DestPort := htons(DestPort);

  // Пишем IP адрес отправителя с портом
  Addr.S_addr := IPHeader.iph_src;
  LogData := LogData + Format(LOG_STR_3, [inet_ntoa(Addr), SrcPort]);
  // Пишем IP адрес получателя с портом
  Addr.S_addr := IPHeader.iph_dest;
  LogData := LogData + Format(LOG_STR_4, [inet_ntoa(Addr), 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.
 
Зверху