Sniffer en Delphi

Version imprimable

22/05/2009, 10h25
andreditdd

Sniffer en Delphi

Bonjour,
je désirerais faire un sniffer comme Wireshark à l'aide des composants
Indy10.
Pouvez vous me donner une piste car dans les recherches que j'effectue, il me semble comprendre que l'on ne sais pas sniffer en étant passif (J'ai cru comprendre qu'il faut envoyer une requête pour en attendre une réponse ).
Comme vous pouvez le lire, je débute dans ce genre de truc.

André
22/05/2009, 17h21
Félix Guillemot

C'est un chantier difficile mais formateur et passionnant.
Je l'ai réalisé il ya qq années en utilisant les composants Packet Sniffre SDK de MicroOLAP :
http://microolap.com/products/network/pssdk/

L'intérêt est qu'il ya des composants VCL
et un support...tu en auras besoin à mon avis car ce n'est pas évident (mais on y arrive)
Ces composants sont payants mais il y a une version TRIAL.

Bon courage !
22/05/2009, 17h42
andreditdd

Merci pour la réponse et les encouragements...
Je vais devoir travailler le domaine que je ne maitrise pas... Les réseaux.

André

salut,

Citation:

je désirerais faire un sniffer comme Wireshark à l'aide des composants
Indy10.
Pouvez vous me donner une piste car dans les recherches que j'effectue, il me semble comprendre que l'on ne sais pas sniffer en étant passif (J'ai cru comprendre qu'il faut envoyer une requête pour en attendre une réponse ).
Comme vous pouvez le lire, je débute dans ce genre de truc.

Tu peux réaliser un Sniffer simple avec delphi, il te suffit de mettre dans "uses :Winsock".
-sur ta fiche, ajoute un ListView.
-double-clique dessus et ajoute 5 Colonnes:
1-le nom de la 1ère colonne :"Heure"
2- le nom de la 2e colonne :"Protocole"
3-le nom de la 3e colonne :"Adresse IP locale"
4-le nom de la 4e colonne :"Adresse IP distante"
5-le nom de la 5e colonne :"TTL".

ajoute:

Code:

1
2
3
const
  MAX_PACKET_SIZE = $10000;
  SIO_RCVALL      = $98000001;

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
type
  USHORT = Word;
  TIPHeader = 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;
    iph_dest:     ULONG;
  end;
  PIPHeader = ^TIPHeader;
 
var
  Form1: TForm1;
  Buffer: array [0..MAX_PACKET_SIZE] of Char;
  flag: Integer;
  hThread: Cardinal;
 
implementation
 
{$R *.DFM}
 
procedure ListenThread(LV: TListView); stdcall;
var
  lowbyte, hibyte: USHORT;
  wsadata: TWSAData;
  s: TSocket;
  name: array [0..128]of Char;
  phe: PHostent;
  sa: TSockAddrIn;
  sa1: TInAddr;
  count: Integer;
  hdr: PIPHeader;
begin
  flag:=1;
  WSAStartup(MAKEWORD(2,2), wsadata);
  s := socket(AF_INET, SOCK_RAW, IPPROTO_IP);
  gethostname(name, sizeof(name));
  phe := gethostbyname(name);
  ZeroMemory(@sa, sizeof(sa));
  sa.sin_family := AF_INET;
  sa.sin_addr.s_addr := cardinal(pointer(phe^.h_addr_list^)^);
  bind(s, sa, sizeof(TSockaddr));
  ioctlsocket(s, SIO_RCVALL, flag);
  repeat
     count := recv(s, Buffer, sizeof(Buffer), 0);
      if (count >= sizeof(TIPHeader)) then
      with LV.Items.Add do
      begin
        hdr := @Buffer;
        Caption:= TimeToStr(Time);
        case hdr.iph_protocol of
          IPPROTO_TCP:  SubItems.Add('TCP');
          IPPROTO_UDP:  SubItems.Add('UDP');
          IPPROTO_RAW:  SubItems.Add('RAW');
          IPPROTO_ICMP: SubItems.Add('ICMP');
          IPPROTO_IGMP: SubItems.Add('IGMP');
          IPPROTO_IP:   SubItems.Add('IP');
        else SubItems.Add('') end;
        sa1.s_addr := hdr.iph_src;
        SubItems.Add(inet_ntoa(sa1));
        sa1.s_addr := hdr.iph_dest;
        SubItems.Add(inet_ntoa(sa1));
        lowbyte := hdr.iph_length shr 8;
        hibyte := hdr.iph_length shl 8;
        hibyte := hibyte + lowbyte;
      //  SubItems.Add(IntToStr(hibyte));
        SubItems.Add(IntToStr(hdr.iph_ttl));
      end;
  until false;
end;

dans l'événement "Oncreate" de la fiche:

Code:

1
2
3
4
5
6
7
procedure TForm1.FormCreate(Sender: TObject);
var
  ThID: Cardinal;
begin
 hThread:=CreateThread(nil,0,@ListenThread,ListView1,0,ThID);
 if hThread=0 then ShowMessage(SysErrorMessage(GetLastError));
end;

dans l'événement "OnChange" de ton ListView1, mets ça:

Code:

1
2
3
4
5
procedure TForm1.ListView1Change(Sender: TObject; Item: TListItem;
  Change: TItemChange);
begin
  ListView1.Scroll(0,Item.Position.y);
end;

dans l'événement "OnClose" de ta fiche, mets ça:

Code:

1
2
3
4
5
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  while not TerminateThread(hThread,0) do
    Sleep(500);
end;

Bonne chance.

A+

NABIL74

NABIL74, Merci pour ton aide (décidément tu es très présent :ccool:)

J'ai mis ce code:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, winsock, ComCtrls;
 
type
  TForm1 = class(TForm)
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure ListView1Change(Sender: TObject; Item: TListItem; Change: TItemChange);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
type
  USHORT = Word;
  TIPHeader = 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;
    iph_dest:     ULONG;
  end;
  PIPHeader = ^TIPHeader;
 
const
  MAX_PACKET_SIZE = $10000;
  SIO_RCVALL      = $98000001;
 
var
  Form1: TForm1;
  Buffer: array [0..MAX_PACKET_SIZE] of Char;
  flag: Integer;
  hThread: Cardinal;
 
implementation
 
{$R *.DFM}
 
procedure ListenThread(LV: TListView); stdcall;
var
  lowbyte, hibyte: USHORT;
  wsadata: TWSAData;
  s: TSocket;
  name: array [0..128]of Char;
  phe: PHostent;
  sa: TSockAddrIn;
  sa1: TInAddr;
  count: Integer;
  hdr: PIPHeader;
begin
  flag:=1;
  WSAStartup(MAKEWORD(2,2), wsadata);
  s := socket(AF_INET, SOCK_RAW, IPPROTO_IP);
  gethostname(name, sizeof(name));
  phe := gethostbyname(name);
  ZeroMemory(@sa, sizeof(sa));
  sa.sin_family := AF_INET;
  sa.sin_addr.s_addr := cardinal(pointer(phe^.h_addr_list^)^);
  bind(s, sa, sizeof(TSockaddr));
  ioctlsocket(s, SIO_RCVALL, flag);
  repeat
     count := recv(s, Buffer, sizeof(Buffer), 0);
      if (count >= sizeof(TIPHeader)) then
      with LV.Items.Add do
      begin
        hdr := @Buffer;
        Caption:= TimeToStr(Time);
        case hdr.iph_protocol of
          IPPROTO_TCP:  SubItems.Add('TCP');
          IPPROTO_UDP:  SubItems.Add('UDP');
          IPPROTO_RAW:  SubItems.Add('RAW');
          IPPROTO_ICMP: SubItems.Add('ICMP');
          IPPROTO_IGMP: SubItems.Add('IGMP');
          IPPROTO_IP:   SubItems.Add('IP');
        else SubItems.Add('') end;
        sa1.s_addr := hdr.iph_src;
        SubItems.Add(inet_ntoa(sa1));
        sa1.s_addr := hdr.iph_dest;
        SubItems.Add(inet_ntoa(sa1));
        lowbyte := hdr.iph_length shr 8;
        hibyte := hdr.iph_length shl 8;
        hibyte := hibyte + lowbyte;
      //  SubItems.Add(IntToStr(hibyte));
        SubItems.Add(IntToStr(hdr.iph_ttl));
      end;
  until false;
end;
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  while not TerminateThread(hThread,0) do
    Sleep(500);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var
  ThID: Cardinal;
begin
 hThread:=CreateThread(nil,0,@ListenThread,ListView1,0,ThID);
 if hThread=0 then ShowMessage(SysErrorMessage(GetLastError));
end;
 
procedure TForm1.ListView1Change(Sender: TObject; Item: TListItem;
  Change: TItemChange);
begin
  ListView1.Scroll(0,Item.Position.y);
end;
 
end.

Il ce passe bien quelque chose mais je n'ai que des "21:..." qui s'inscrivent l'un après l'autre et sans colonnes dans le listview.
J'imagine que j'ai dut faire une erreur.

André

salut andreditdd :P,

voici toute mon unité:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
unit Unit1;
 
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, Winsock;
 
const
  MAX_PACKET_SIZE = $10000;
  SIO_RCVALL      = $98000001;
 
type
  TForm1 = class(TForm)
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure ListView1Change(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
type
  USHORT = Word;
  TIPHeader = 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;
    iph_dest:     ULONG;
  end;
  PIPHeader = ^TIPHeader;
 
var
  Form1: TForm1;
  Buffer: array [0..MAX_PACKET_SIZE] of Char;
  flag: Integer;
  hThread: Cardinal;
 
implementation
 
{$R *.DFM}
 
procedure ListenThread(LV: TListView); stdcall;
var
  lowbyte, hibyte: USHORT;
  wsadata: TWSAData;
  s: TSocket;
  name: array [0..128]of Char;
  phe: PHostent;
  sa: TSockAddrIn;
  sa1: TInAddr;
  count: Integer;
  hdr: PIPHeader;
begin
  flag:=1;
  WSAStartup(MAKEWORD(2,2), wsadata);
  s := socket(AF_INET, SOCK_RAW, IPPROTO_IP);
  gethostname(name, sizeof(name));
  phe := gethostbyname(name);
  ZeroMemory(@sa, sizeof(sa));
  sa.sin_family := AF_INET;
  sa.sin_addr.s_addr := cardinal(pointer(phe^.h_addr_list^)^);
  bind(s, sa, sizeof(TSockaddr));
  ioctlsocket(s, SIO_RCVALL, flag);
  repeat
     count := recv(s, Buffer, sizeof(Buffer), 0);
      if (count >= sizeof(TIPHeader)) then
      with LV.Items.Add do
      begin
        hdr := @Buffer;
        Caption:= TimeToStr(Time);
        case hdr.iph_protocol of
          IPPROTO_TCP:  SubItems.Add('TCP');
          IPPROTO_UDP:  SubItems.Add('UDP');
          IPPROTO_RAW:  SubItems.Add('RAW');
          IPPROTO_ICMP: SubItems.Add('ICMP');
          IPPROTO_IGMP: SubItems.Add('IGMP');
          IPPROTO_IP:   SubItems.Add('IP');
        else SubItems.Add('') end;
        sa1.s_addr := hdr.iph_src;
        SubItems.Add(inet_ntoa(sa1));
        sa1.s_addr := hdr.iph_dest;
        SubItems.Add(inet_ntoa(sa1));
        lowbyte := hdr.iph_length shr 8;
        hibyte := hdr.iph_length shl 8;
        hibyte := hibyte + lowbyte;
      //  SubItems.Add(IntToStr(hibyte));
        SubItems.Add(IntToStr(hdr.iph_ttl));
      end;
  until false;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var
  ThID: Cardinal;
begin
 hThread:=CreateThread(nil,0,@ListenThread,ListView1,0,ThID);
 if hThread=0 then ShowMessage(SysErrorMessage(GetLastError));
end;
 
procedure TForm1.ListView1Change(Sender: TObject; Item: TListItem;
  Change: TItemChange);
begin
  ListView1.Scroll(0,Item.Position.y);
end;
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  while not TerminateThread(hThread,0) do
    Sleep(500);
end;
 
end.

au faite tu veux quoi au juste?
connaître le protocole utilisé, l'adresse IP locale, l'adresse IP distante et le TTL?

après le lancement de cette application, essaye de te déconnecté et puis reconnecte-toi pour voir.

A+

NABIL74

22/05/2009, 23h28
andreditdd

Encore merci.
Il y a une évolution: maintenant j'ai que des "23:2..." mais ils se rajoutent que en fonction du transfert réseau.

Le but du projet: j'ai un soft codé en VB qui communique avec une radio via un port ethernet. J'ai vu que ce soft emploit Winsock.
Il "écoute les information qui arrive par le port ethernet via une adresse IP et peut envoyer des infos en retour.
Le but est de remplacer ce soft qui ne convient pas exactement.

André
22/05/2009, 23h45
NABIL74

Citation:

Il y a une évolution: maintenant j'ai que des "23:2..." mais ils se rajoutent que en fonction du transfert réseau.

quand il y a un transfert réseau, il rajoute heure du transfert, le protocole utilisé, l'adresse IP locale, l'adresse IP distante et le TTL, je pense que c'est pas mal pour un début non? .
Pour ton projet, il y a du travail sérieux qui t'attend. j'ai fait mon propre Sniffer il n'est pas comme "Wireshark", mais il te donne beaucoup de renseignements.
22/05/2009, 23h58
andreditdd

Effectivement, il s'agit du début de l'heure...
Merci pour ton aide :ccool:

André
23/05/2009, 00h04
NABIL74

Citation:

Envoyé par andreditdd

Effectivement, il s'agit du début de l'heure...
Merci pour ton aide :ccool:

André

André, il y a ce lien intéressant à voir :http://www.jcolibri.com/presentation...er_tcp_ip.html

il indique comment réaliser et incorporer à des projets Delphi des outils de suivi et d'analyse de paquets TCP IP.
ça peux aider.

A+

NABIL74
23/05/2009, 00h22
andreditdd

Oui merci, j'avais vu ce lien.
il semblerait d'après mes lectures que une solution actuelle permettant de contourner les firewall de XP et Vista, serait d'employer la dll de Winpcap.

Je continue mes recherches.

En ce qui concerne ton code, je reçois maintenant en retour juste les heures, minutes, secondes des paquets.

André