Réalisation d'un utilitaire d'analyse de trafic d'une interface réseau

IV.3. Développement

IV.3.1. Environnement de développement

Nous avons programmé l'utilitaire d'analyse de trafic d'une interface réseau en Visual Basic 6. Le choix de cet environnement de développement est dicté par sa simplicité d'usage et son intuitivité. L'ordinateur de développement est tout ordinateur pouvant exécuter Visual Studio 6. Dans notre cas nous avons utilisé un laptop de processeur Centrino Duo d'Intel 2 Ghz avec une mémoire centrale de 4Go.

IV.3.2. Structure de l'application

L'application comprend :

1. une interface utilisateur où l'administrateur de réseau, qui cherche à écouter le trafic sur une interface réseau particulière introduit l'adresse IPv4 de cette interface réseau : le code associé à l'interface utilisateur est dans le module de feuille frmTraficReseau.frm ;

2. des modules standard : qui contiennent des constantes, des procédures et des fonctions pouvant être utilisées dans l'ensemble de l'application. Ces modules standard recourent à certaines fonctions, procédures et constantes définies dans des bibliothèques de liaison dynamique.

IV.3.3. Déroulement de l'exécution

L'administrateur réseau introduit l'adresse IP dont il veut contrôler le trafic, puis clique sur le bouton « Activer l'écoute » pour activer l'écoute. Il peut désactiver l'écouter en cliquant sur le bouton « Désactiver l'écoute ».

Fig. 17 : listview

S'il y a du trafic réseau, il peut être visualisé dans une listview de l'onglet correspondant au protocole pour lequel l'écoute est réalisée.

Exemple de trafic concernant le protocole TCP

Fig. 18 : Exemple de trafic concernant le protocole TCP

Exemple de trafic concernant le protocole UDP

Fig. 19: Exemple de trafic concernant le protocole UDP

IV.3.4. Codes sources

Module de feuille frmTraficReseau.frm

' Ce code sniffe les paquets puis affiche les trames TCP/UDP/ICMP plus un routeur '################################################################## #######################

Public xSock As Long

Public Sub CreateSocketSniffe() ' socket en mode écoute pour le sniffeur

Dim Sock As Long, xSockAddr As SOCK_ADDR, wSada As WSA_DATA, E_Buffer As Long, S_Buffer As Long, LenBytes As Long

WSAStartup &H101, wSada

With xSockAddr

.sin_family = AF_INET

.sin_port = htons(4200)

.sin_addr.S_addr = inet_addr(txtip.Text)

End With

xSock = Sock

Sock = socket(AF_INET, SOCK_RAW, IPPROTO_IP)

If Sock = 0 Then MsgBox "erreur création sock": Exit Sub Else xSock = Sock If bind(Sock, xSockAddr, LenB(xSockAddr)) <> 0 Then MsgBox "erreur bind": FermerSocket (Sock)

E_Buffer = 1

If WSAIoctl(Sock, SIO_RCVALL, E_Buffer, Len(E_Buffer), S_Buffer, Len(S_Buffer), LenBytes, ByVal 0, ByVal 0) <> 0 Then MsgBox "WSAIoctl pas bon."

If WSAAsyncSelect(Sock, frmTraficReseau.hwnd, WM_USER + 1, FD_READ) < 0 Then FermerSocket Sock: MsgBox "Erreur de socket": Exit Sub

End Sub

Private Sub Command1_Click() 'active l'écoute

Command1.Enabled = False: Call SubClass(hwnd, True): Call CreateSocketSniffe End Sub

Private Sub Command2_Click() ' active ou désactive le routeur

Routeur = Not Routeur

If Command2.Caption = "routeur on" Then Command2.Caption = "routeur off" Else Command2.Caption = "routeur on"

End Sub

Private Sub Command3_Click() ' désactive l'écoute

Command1.Enabled = True: Call SubClass(hwnd, False): FermerSocket (xSock) End Sub

Private Sub Form_Load() ' chargement de 3 Treeview

ChargeTree 6, Frame1(0): ChargeTree 17, Frame1(1)

ChargeTree 1, Frame1(2): ChargeTree 2, Frame1(3)

Tree(2).Height = Frame1(3).Height

' partie qui donne l'ip local

Dim Buffer As INTERFACEINFO, StartupInfo As WSA_DATA, Sock As

Long

WSAStartup &H202, StartupInfo

Sock = socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP)

WSAIoctl Sock, SIO_GET_INTERFACE_LIST, ByVal 0, ByVal 0, Buffer, 1024, 0, ByVal 0, ByVal 0

txtip.Text = FonctionIp(Buffer.Info_Inter(0).Info_Addresse.AddresseLocal.sin_addr.S_addr) FermerSocket (Sock): Text1.Text = txtip.Text: txtRouteur(0).Text = txtip.Text: txtRouteur(1).Text = txtip.Text

End Sub

Sub ChargeTree(xIndex As Integer, xFrame As Frame) 'chargement d'une treeview Load Tree(xIndex)

Set Tree(xIndex).Container = xFrame

Tree(xIndex).Move 0, 50

Tree(xIndex).Visible = True

Tree(xIndex).ImageList = ImgLst

End Sub

Private Sub Form_Unload(Cancel As Integer): Call SubClass(hwnd, False): End Sub Private Sub mnData_Click() ' affiche les données

Dim StrData As String

On Error Resume Next ' on passe l' erreur de lecture des données quand treeview

est vide With Form2

Select Case SSTab1.Tab

Case 0: StrData = Tree(6).SelectedItem.Tag: .txt.Tag = Tree(6).Nodes.Item(Tree(6).SelectedItem.Index + 1).Tag

Case 1: StrData = Tree(17).SelectedItem.Tag: .txt.Tag = Tree(17).Nodes.Item(Tree(17).SelectedItem.Index + 1).Tag

Case 2: StrData = Tree(1).SelectedItem.Tag: .txt.Tag = Tree(1).Nodes.Item(Tree(1).SelectedItem.Index + 1).Tag

Case 3: StrData = Tree(2).SelectedItem.Tag: .txt.Tag = Tree(2).Nodes.Item(Tree(2).SelectedItem.Index + 1).Tag

End Select

.txt = StrData: .ZOrder 0: .Visible = True

End With End Sub Private Sub mnkill_Click() ' décharge et recharge une treeview, plus rapide que

.Clear

Select Case SSTab1.Tab

Case 0: Unload Tree(6): ChargeTree 6, Frame1(0): Label2(0).Caption = "TCP : 0": Label2(0).Tag = 0 ' TCP

Case 1: Unload Tree(17): ChargeTree 17, Frame1(1): Label2(1).Caption = "UDP : 0": Label2(1).Tag = 0 ' UDP

Case 2: Unload Tree(1): ChargeTree 1, Frame1(2): Label2(2).Caption = "ICMP :

0": Label2(2).Tag = 0 ' ICMP

Case 3: Unload Tree(2): ChargeTree 2, Frame1(3): Tree(2).Height = Frame1(3).Height:: Label2(4).Caption = "ROUTE : 0": Label2(4).Tag = 0 ' ROUTEUR End Select

End Sub

Private Sub Tree_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)

If Button = 2 Then PopupMenu gg ' menu du treeview

End Sub

Modules standard

Les différents modules standard utilisent des fonctions, procédures et constantes diverses codées par d'autres développeurs et définies dans des bibliothèques de liaisons dynamiques (dll)

1. Module Constantes.bas

Public Const AF_ INET = 2

Public Const IPPROTO_ IP = 0

Public Const FD_ READ = &H1

Public Const SOCK_RAW = 3

Public Const SIO_ RCVALL As Long = &H98000001

Public Const WSADESCRIPTION_ LEN = 256, WSASYS_STATUS_LEN = 128 Public Const WM_USER = &H400, GWL_WNDPROC = (-4)

Public Const SOCK_DGRAM = 2 Public Const IPPROTO_ RAW = 255 Public Const IP_ HDRINCL = 2 Public Const SOCK_STREAM = 1

2. Module FonctionsDiverses.bas

Private Const OFFSET_4 = 4294967296#, MAXINT_4 = 2147483647, OFFSET_2 = 65536, MAXINT_2 = 32767

Public Function UnsignedToLong(Value As Double) As Long

If Value < 0 Or Value >= OFFSET_4 Then Error 6 ' Overflow

UnsignedToLong = Value - IIf(Value <= MAXINT_4, 0, OFFSET_4)

End Function

Public Function LongToUnsigned(Value As Long) As Double

LongToUnsigned = Value + IIf(Value < 0, OFFSET_4, 0)

End Function

Public Function UnsignedToInteger(Value As Long) As Integer

If Value < 0 Or Value >= OFFSET_2 Then Error 6 ' Overflow

UnsignedToInteger = Value - IIf(Value <= MAXINT_2, 0, OFFSET_2)

End Function

Public Function IntegerToUnsigned(Value As Integer) As Long

IntegerToUnsigned = Value + IIf(Value < 0, OFFSET_2, 0)

End Function

Public Function LoWord(lngValue As Long) As Long

LoWord = lngValue And &HFFFF

End Function

Public Function HiNibble(bytValue As Byte) As Byte

HiNibble = (bytValue And &HF0) \ 16

End Function

Public Function IcmpCodeValeur(xType As Byte, xCode As Byte) As String

Select Case xType

Case IcmpType.[Destination Unreachable]

If xCode = IcmpCode.[Network Unreachable] Then IcmpCodeValeur = "Network Unreachable"

If xCode = IcmpCode.[Host Unreachable] Then IcmpCodeValeur = "Host

Unreachable"

If xCode = IcmpCode.[Protocol Unreachable] Then IcmpCodeValeur =

"Protocol Unreachable"

If xCode = IcmpCode.[Port Unreachable] Then IcmpCodeValeur = "Port

Unreachable"

If xCode = IcmpCode.[Fragmentation Needed] Then IcmpCodeValeur =

"Fragmentation Needed"

Case IcmpType.Redirect

If xCode = IcmpCode.[Redirect Network] Then IcmpCodeValeur =

"Redirect Network"

If xCode = IcmpCode.[Redirect Host] Then IcmpCodeValeur = "Redirect

Host"

If xCode = IcmpCode.[Redirect TOS Network] Then IcmpCodeValeur = "Redirect TOS Network"

If xCode = IcmpCode.[Redirect TOS Host] Then IcmpCodeValeur = "Redirect TOS Host"

Case IcmpType.[Time Exceeded]

If xCode = IcmpCode.[TTL Exceeded In Transit] Then IcmpCodeValeur = "TTL Exceeded In Transit"

If xCode = IcmpCode.[Reassembly Timeout] Then IcmpCodeValeur = "Reassembly Timeout"

Case IcmpType.[Parameter Problem]

If xCode = IcmpCode.[Problem With Option] Then IcmpCodeValeur = "Problem With Option"

Case Else: IcmpCodeValeur = "N/A"

End Select End Function Public Function IcmpTypeValeur(xType As Byte) As String

Select Case xType

Case IcmpType.[Echo Reply]: IcmpTypeValeur = "Echo Reply"

Case 1, 2, 7: IcmpTypeValeur = "Reserved"

Case IcmpType.[Destination Unreachable]: IcmpTypeValeur = "Destination Unreachable"

Case IcmpType.[Source Quench]: IcmpTypeValeur = "Source Quench"

Case IcmpType.Redirect: IcmpTypeValeur = "Redirect"

Case IcmpType.[Alternate Host Address]: IcmpTypeValeur = "Alternate Host Address"

Case IcmpType.[Echo Request]: IcmpTypeValeur = "Echo Request"

Case IcmpType.[Router Advertisement]: IcmpTypeValeur = "Router

Advertisement"

Case IcmpType.[Router Solicitation]: IcmpTypeValeur = "Router Solicitation" Case IcmpType.[Time Exceeded]: IcmpTypeValeur = "Time Exceeded"

Case IcmpType.[Parameter Problem]: IcmpTypeValeur = "Parameter Problem" Case IcmpType.[TimeStamp Reply]: IcmpTypeValeur = "Timestamp Request" Case IcmpType.[TimeStamp Request]: IcmpTypeValeur = "Timestamp Reply" Case IcmpType.[Information Request]: IcmpTypeValeur = "Information Request"

Case IcmpType.[Information Reply]: IcmpTypeValeur = "Information Reply"

Case IcmpType.[Address Mask Request]: IcmpTypeValeur = "Address Mask Request"

Case IcmpType.[Address Mask Reply]: IcmpTypeValeur = "Address Mask Reply"

Case 19: IcmpTypeValeur = "Reserved (security)"

Case 20, 21, 22, 23, 24, 25, 26, 27, 28, 29: IcmpTypeValeur = "Reserved (robustness experiment)"

Case IcmpType.[IP IX Trace Router]: IcmpTypeValeur = "TP IX Traceroute" Case IcmpType.[Conversion Error]: IcmpTypeValeur = "Conversion Error"

Case IcmpType.[Mobile Host Redirect]: IcmpTypeValeur = "Mobile Host

Redirect"

Case IcmpType.[IPv6 Where Are You]: IcmpTypeValeur = "IPv6 Where Are

You"

Case IcmpType.[IPv6 Here I Am]: IcmpTypeValeur = "IPv6 I Am Here"

Case IcmpType.[Mobile Registration Request]: IcmpTypeValeur = "Mobile Registration Request"

Case IcmpType.[Mobile Registration Reply]: IcmpTypeValeur = "Mobile Registration Reply"

Case IcmpType.[Domain Name Request]: IcmpTypeValeur = "Domain Name Request"

Case IcmpType.[Domain Name Reply]: IcmpTypeValeur = "Domain Name Reply"

Case IcmpType.[SKIP Algorithm Discovery Protocol]: IcmpTypeValeur = "SKIP Algorithm Discovery_protocol"

Case IcmpType.[IPsec Security Failures]: IcmpTypeValeur = "IPsec Security Failures"

Case Is > 40: IcmpTypeValeur = "Reserved"

End Select

End Function

3. Module Protocoles.bas

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)

Private Declare Function ntohs Lib "ws2_32.dll" (ByVal netshort As Long) As Integer Public Routeur As Boolean, eIP As EnteteIp, eTCP As EnteteTcp, eUDP As EnteteUdp, eICMP As EnteteIcmp, ePS As PseudoEntete, zSock As Long

Public Sub Routes_Paquets(xProto As Byte, Donnee As String)

' on va router un paquet avec une nouvelle ip de destination

On Error Resume Next

'on active ou désactive la prise en charge du protocole pour le routage

If frmTraficReseau.OptionRouteur(2).Value = 0 Then If xProto = 1 Then xProto = 0 ' icmp

If frmTraficReseau.OptionRouteur(1).Value = 0 Then If xProto = 17 Then xProto = 0 ' udp

If frmTraficReseau.OptionRouteur(0).Value = 0 Then If xProto = 6 Then xProto = 0 ' tcp

' on charge dans notre nouvelle entête eip,l'entete ip qu'on vient juste de sniffer With eIP ' entête ip

.VerLen = &H45

.id = xEnteteIp.id

.Offset = xEnteteIp.Offset

.Ttl = xEnteteIp.Ttl

.SourceIp = inet_addr(frmTraficReseau.txtRouteur(0).Text) ' <-- nouvelle ip source

.DestIp = inet_addr(frmTraficReseau.txtRouteur(1).Text) '<-- nouvelle ip destination

.Protocol = xProto

.Tos = xEnteteIp.Tos

.Checksum = 0 ' <--- nouveau checksum à recalculé

.Checksum = UnsignedToInteger(Check.Checksum(VarPtr(eIP), LenB(eIP))) End With

If eIP.Protocol = 6 Or eIP.Protocol = 17 Then 'pseudo entete uniquement pour tcp ou udp

' pseudo entête uniquement pour le calcule du checksum

With ePS

.IPsource = eIP.SourceIp

.IPdestination = eIP.DestIp

.Protocol = eIP.Protocol

.Reserved = 0

End With

End If

Select Case xProto

Case 6 ' = TCP

ePS.Len = ntohs(LenB(eTCP) + UBound(xData)) '<- taille pseudoEntete

With eTCP

.Ack = xEnteteTcp.Ack

.DataOffset = xEnteteTcp.DataOffset

.Flag = xEnteteTcp.Flag

.PortDesti = xEnteteTcp.PortDesti

.PortSource = xEnteteTcp.PortSource

.Sequence = xEnteteTcp.Sequence

.UrgentPointer = xEnteteTcp.UrgentPointer

.Windows = xEnteteTcp.Windows

.Checksum = 0

.Checksum = UnsignedToInteger(CheckTcp(VarPtr(ePS), LenB(ePS), VarPtr(eTCP), LenB(eTCP), VarPtr(xData(0)), UBound(xData)))

End With

eIP.TotalLength = ntohs(LenB(eIP) + LenB(eTCP) + UBound(xData)) ' taille entête

ip

Case 17 ' = UDP

ePS.Len = ntohs(LenB(eUDP) + UBound(xData))

With eUDP ' on garde les mêmes valeurs du paquet qu'on à sniffer pour notre nouvelle entête

.SourcePort = xEnteteUdp.SourcePort

.DestPort = xEnteteUdp.DestPort

.udpChecksum = 0

.Len = ePS.Len ' <- nouvelle taille de l'entête udp

End With

'on calcule le checksum pour l'entete udp

eUDP.udpChecksum = UnsignedToInteger(CheckUdp(VarPtr(ePS), LenB(ePS), VarPtr(eUDP), LenB(eUDP), VarPtr(xData(0)), UBound(xData)))

eIP.TotalLength = ntohs((LenB(eIP) + LenB(eUDP) + UBound(xData))) ' taille entête ip

Case 1 ' = ICMP

With eICMP ' entête icmp , on garde les mêmes valeurs

.Type = xEnteteIcmp.Type

.Code = xEnteteIcmp.Code

.Identifiant = xEnteteIcmp.Identifiant

.Sequence = xEnteteIcmp.Sequence

.Checksum = xEnteteIcmp.Checksum

End With

eIP.TotalLength = ntohs(LenB(eIP) + LenB(eICMP) + UBound(xData)) ' taille entête ip

End Select

Dim xPaquet() As Byte ' on forge notre trame = Entête ip + datagramme(entête tcp ou icmp ou udp +data)

Select Case xProto

Case 6 'on forge un paquet TCP

ReDim xPaquet(LenB(eIP) + LenB(eTCP) + UBound(xData)) CopyMemory ByVal VarPtr(xPaquet(0)), ByVal VarPtr(eIP), LenB(eIP) CopyMemory ByVal VarPtr(xPaquet(LenB(eIP))), ByVal VarPtr(eTCP),

LenB(eTCP)

CopyMemory ByVal VarPtr(xPaquet(LenB(eIP) + LenB(eTCP))), ByVal VarPtr(xData(0)), UBound(xData)

Case 17 'on forge un paquet UDP

ReDim xPaquet(LenB(eIP) + LenB(eUDP) + UBound(xData)) CopyMemory ByVal VarPtr(xPaquet(0)), ByVal VarPtr(eIP), LenB(eIP) CopyMemory ByVal VarPtr(xPaquet(LenB(eIP))), ByVal VarPtr(eUDP),

LenB(eUDP)

CopyMemory ByVal VarPtr(xPaquet(LenB(eIP) + LenB(eUDP))), ByVal VarPtr(xData(0)), UBound(xData)

Case 1 ' on forge un paquet ICMP

ReDim xPaquet(LenB(eIP) + LenB(eICMP) + UBound(xData)) CopyMemory ByVal VarPtr(xPaquet(0)), ByVal VarPtr(eIP), LenB(eIP) CopyMemory ByVal VarPtr(xPaquet(LenB(eIP))), ByVal VarPtr(eICMP),

LenB(eICMP)

CopyMemory ByVal VarPtr(xPaquet(LenB(eIP) + LenB(eICMP))), ByVal VarPtr(xData(0)), UBound(xData)

End Select

' structure de destinantion

Call CreateSocket(VarPtr(xPaquet(0)), CInt(xProto))

Dim SockAddr As SOCK_ADDR

SockAddr.sin_zero(0) = 0

SockAddr.sin_family = AF_INET '<-famille protocole

If xProto = 6 Then SockAddr.sin_port = xEnteteTcp.PortDesti ' port de destination pour tcp

If xProto = 17 Then SockAddr.sin_port = xEnteteUdp.DestPort ' port de destination pour udp

' < rien pour icmp,pas de port >

SockAddr.sin_addr.S_addr = eIP.DestIp ' adresse de destination

' la fonction Sendto va nous permettre d'envoyer un paquet à une adresse spécifiée par la structure to de type sockaddr.

SendData = sendto(zSock, ByVal VarPtr(xPaquet(0)), UBound(xPaquet), 0, SockAddr, LenB(SockAddr))

If SendData > 0 Then

Debug.Print "envoi réussi"

' Compteur de paquet router

Select Case xProto ' mise à jour

Case 1

frmTraficReseau.OptionRouteur(2).Tag = frmTraficReseau.OptionRouteur(2).Tag + 1

frmTraficReseau.OptionRouteur(2).Caption = "ICMP (" & frmTraficReseau.OptionRouteur(2).Tag & ")"

Case 17

frmTraficReseau.OptionRouteur(1).Tag = frmTraficReseau.OptionRouteur(1).Tag + 1

frmTraficReseau.OptionRouteur(1).Caption = "UDP (" & frmTraficReseau.OptionRouteur(1).Tag & ")"

Case 6

frmTraficReseau.OptionRouteur(0).Tag = frmTraficReseau.OptionRouteur(0).Tag + 1

frmTraficReseau.OptionRouteur(0).Caption = "TCP (" & frmTraficReseau.OptionRouteur(0).Tag & ")"

End Select

frmTraficReseau.Label2(4).Tag = frmTraficReseau.Label2(4).Tag + 1: frmTraficReseau.Label2(4).Caption = "ROUTE : " & frmTraficReseau.Label2(4).Tag Else

Debug.Print "erreur envoi"

End If

Call ListePaquet(Donnee, CInt(xProto)) End Sub

Public Sub CreateSocket(adrs As Long, Proto As Integer)

Dim StartupInfo As WSA_DATA

WSAStartup &H202, StartupInfo

If Proto = 6 Or Proto = 1 Then zSock = socket(AF_INET, SOCK_RAW, Proto) Else zSock = socket(AF_INET, SOCK_DGRAM, 17)

setsockopt zSock, IPPROTO_IP, IP_HDRINCL, adrs, 4

End Sub

Sub ListePaquet(xData As String, Proto As Integer)

Dim Parent As Node, EnteteA As Node, EnteteB As Node, flags As Node, Titre As String, Info As String

If Proto = 6 Then Titre = "Entete Tcp" Else If Proto = 17 Then Titre = "Entete Udp" Else Titre = "Entete Icmp"

Info = FonctionIp(eIP.SourceIp) & " --> " & FonctionIp(eIP.DestIp) & Space(10) & IIf(Proto = 1, vbNullString, Mid(xData, 1, 70) & "...")

' on quitte si le protocole ne correspond pas à TCP Or UDP Or ICMP If Proto <> 6 And Proto <> 17 And Proto <> 1 Then Exit Sub

Set Parent = frmTraficReseau.Tree(2).Nodes.Add(): Parent = Info: Parent.Image =

1

Set EnteteA = frmTraficReseau.Tree(2).Nodes.Add(Parent, tvwChild): EnteteA = "Entete ip": EnteteA.Image = 2

Set EnteteB = frmTraficReseau.Tree(2).Nodes.Add(Parent, tvwChild): EnteteB = Titre: EnteteB.Image = 2

Parent.Tag = xData

EnteteA.Tag = xEnteteIp.SourceIp

With eIP ' on affiche les valeurs des entetes ip frmTraficReseau.Tree(2).Nodes.Add EnteteA, tvwChild, , "Source IP . . . " & FonctionIp(.SourceIp), 3

frmTraficReseau.Tree(2).Nodes.Add EnteteA, tvwChild, , "Destination IP . . . " & FonctionIp(.DestIp), 3

frmTraficReseau.Tree(2).Nodes.Add EnteteA, tvwChild, , "Time To Live (TTL) . . . . . . " & .Ttl, 3

frmTraficReseau.Tree(2).Nodes.Add EnteteA, tvwChild, , "IP Version . . . . . . . . .IPv" & HiNibble(.VerLen), 3

frmTraficReseau.Tree(2).Nodes.Add EnteteA, tvwChild, , "Identification . . . . . . . . . " & IntegerToUnsigned(.id), 3

frmTraficReseau.Tree(2).Nodes.Add EnteteA, tvwChild, , "DataOffset. . . . . . . . ." & IntegerToUnsigned(ntohs(.Offset)), 3

frmTraficReseau.Tree(2).Nodes.Add EnteteA, tvwChild, , "Checksum . . . . . . . . " & IntegerToUnsigned(ntohs(.Checksum)), 3

frmTraficReseau.Tree(2).Nodes.Add EnteteA, tvwChild, , "Longueur . . . . . . . . . " & ntohs(.TotalLength), 3

End With

Select Case Proto

Case 1

With eICMP ' ICMP

frmTraficReseau.Tree(2).Nodes.Add EnteteB, tvwChild, , "Type. . . . . . . . . " & IcmpTypeValeur(.Type), 3

"

frmTraficReseau.Tree(2).Nodes.Add EnteteB, tvwChild, , "Code & IcmpCodeValeur(.Type, .Code), 3

frmTraficReseau.Tree(2).Nodes.Add EnteteB, tvwChild, , "Checksum ." & IntegerToUnsigned(ntohs(.Checksum)), 3

frmTraficReseau.Tree(2).Nodes.Add EnteteB, tvwChild, , "Identifiant. . ." & ntohl(.Identifiant), 3

End With

Case 6

With eTCP ' TCP

frmTraficReseau.Tree(2).Nodes.Add EnteteB, tvwChild, , "Source Port . . . " & ntohs(.PortSource), 3

frmTraficReseau.Tree(2).Nodes.Add EnteteB, tvwChild, , "Dest Port ." & ntohs(.PortDesti), 3

frmTraficReseau.Tree(2).Nodes.Add EnteteB,	tvwChild, , "DataOffset	62

. . " & IntegerToUnsigned(ntohs(.DataOffset)), 3

frmTraficReseau.Tree(2).Nodes.Add EnteteB, tvwChild, , "Ack. . . . . . . . ." & LongToUnsigned(ntohl(.Ack)), 3

frmTraficReseau.Tree(2).Nodes.Add EnteteB, tvwChild, , "Sequence. . . . . . . . " & LongToUnsigned(ntohl(.Sequence)), 3

frmTraficReseau.Tree(2).Nodes.Add EnteteB, tvwChild, , "Urgent Pointer. . . . . . ." & ntohs(.UrgentPointer), 3

frmTraficReseau.Tree(2).Nodes.Add EnteteB, tvwChild, , "Windows. . . . . . . . ." & ntohs(.Windows), 3

frmTraficReseau.Tree(2).Nodes.Add EnteteB, tvwChild, , "Checksum . . . . . . . . " & IntegerToUnsigned(ntohs(.Checksum)), 3

End With

Case 17

With eUDP ' UDP

frmTraficReseau.Tree(2).Nodes.Add EnteteB, tvwChild, , "Source Port . . ." & ntohs(.SourcePort), 3

frmTraficReseau.Tree(2).Nodes.Add EnteteB, tvwChild, , "Dest Port. . ." & ntohs(.DestPort), 3

frmTraficReseau.Tree(2).Nodes.Add EnteteB, tvwChild, , "Longueur. . ." & ntohs(.Len), 3

frmTraficReseau.Tree(2).Nodes.Add EnteteB, tvwChild, , "Checksum. . ." & IntegerToUnsigned(ntohs(.udpChecksum)), 3

End With

End Select

End Sub

4. Module sckEcoute.bas

Public Declare Function WSAIoctl Lib "ws2_32.dll" (ByVal s As Long, ByVal dwIoControlCode As Long, lpvInBuffer As Any, ByVal cbInBuffer As Long, lpvOutBuffer As Any, ByVal cbOutBuffer As Long, lpcbBytesReturned As Long, lpOverlapped As Long, lpCompletionRoutine As Long) As Long

Public Declare Function setsockopt Lib "ws2_32" (ByVal s As Long, ByVal level As Integer, ByVal optname As Integer, ByVal optval As Long, ByVal optlen As Long) As Integer

Public Declare Function sendto Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal lngLen As Long, ByVal flags As Long, sTo As SOCK_ADDR, ByVal tolen As Long) As Long

Public Declare Function socket Lib "ws2_32" (ByVal iAddressFamily As Long, ByVal iType As Long, ByVal iProtocol As Long) As Long

Public Declare Function bind Lib "wsock32" (ByVal s As Long, addr As SOCK_ADDR, ByVal namelen As Long) As Long

Public Declare Function closesocket Lib "wsock32" (ByVal s As Long) As Long Public Declare Function connect Lib "wsock32" (ByVal s As Long, Name As SOCK_ADDR, ByVal namelen As Integer) As Long

Public Declare Function inet_addr Lib "wsock32" (ByVal cp As String) As Long Public Declare Function recv Lib "wsock32" (ByVal s As Long, Buffer As Any, ByVal length As Long, ByVal flags As Long) As Long

Public Declare Function shutdown Lib "wsock32" (ByVal s As Long, ByVal how As Long) As Long

Public Declare Function WSACancelBlockingCall Lib "wsock32" () As Long Public Declare Function WSACleanUp Lib "wsock32" Alias "WSACleanup" () As Long

Public Declare Function WSAStartup Lib "wsock32" (ByVal wVersionRequired As Integer, wsData As WSA_DATA) As Long

Public Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hwnd As Long, ByVal wMsg As Integer, ByVal lEvent As Long) As Integer

Public Declare Function listen Lib "wsock32.dll" (ByVal s As Long, ByVal backlog As Integer) As Integer

Public Declare Function htonl Lib "ws2_32.dll" (ByVal hostlong As Long) As Long Public Declare Function htons Lib "wsock32" (ByVal hostshort As Integer) As Integer Public Declare Function ntohl Lib "ws2_32.dll" (ByVal netlong As Long) As Long Public Declare Function ntohs Lib "ws2_32.dll" (ByVal netshort As Integer) As Integer

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, ByVal pSrc As Long, ByVal ByteLen As Long)

Public Declare Function gethostbyaddr Lib "ws2_32.dll" (addr As Long, ByVal addr_len As Long, ByVal addr_type As Long) As Long

Public xData() As Byte

Public xEnteteIp As EnteteIp, xEnteteTcp As EnteteTcp, xEnteteUdp As EnteteUdp, xEnteteIcmp As EnteteIcmp

Public Sub FermerSocket(Sock As Long) ' fermeture du socket

Dim xLng As Long

If Sock <> 0 Then xLng = shutdown(Sock, 2): xLng = closesocket(Sock): xLng = WSACancelBlockingCall: xLng = WSACleanUp: Sock = 0

End Sub

Public Function FonctionIp(xIp As Long) As String ' affiche en bon format l'ip

Dim Bytes(3) As Byte

Call CopyMemory(ByVal VarPtr(Bytes(0)), ByVal VarPtr(xIp), 4): FonctionIp = Bytes(0) & "." & Bytes(1) & "." & Bytes(2) & "." & Bytes(3)

End Function

Public Function InfoSource() As String ' fonction qui recupere le nom du domaine Dim ValHost As Long, xHost As Host, xIp As String

With Form2

.Label1.Caption = "Traitement en cours "

DoEvents: DoEvents

If .txt.Tag = vbNullString Then Exit Function

ValHost = gethostbyaddr(CLng(.txt.Tag), 4, 1)

If ValHost = 0 Then .Label1.Caption = vbNullString: .lbl.Caption = "aucune information disponible!": Exit Function

InfoSource = String(50, 0)

CopyMemory xHost, ByVal ValHost, LenB(xHost)

CopyMemory ByVal InfoSource, ByVal xHost.Nom, 50

.lbl.Caption = "Nom du domaine : " & Trim$(InfoSource)

.Label1.Caption = vbNullString

End With

End Function

Public Function Capture(Sock As Long) As String

ReDim Buffer(1499) As Byte

Dim xVal As Long, xProto As Integer, StrData As String, DataSize As Long, Offset As Integer

xVal = recv(Sock, Buffer(0), 1500, 0): If xVal < 0 Then Exit Function Else Buffer(xVal - 1) = 0

CopyMemory xEnteteIp, VarPtr(Buffer(0)), LenB(xEnteteIp)

Select Case xEnteteIp.Protocol ' on va lire le champ protocole dans l'entete ip Case 6 ' tcp

CopyMemory xEnteteTcp, VarPtr(Buffer(0)) + 20, LenB(xEnteteTcp): xProto = 6 frmTraficReseau.Label2(0).Tag = frmTraficReseau.Label2(0).Tag + 1:

frmTraficReseau.Label2(0).Caption = "TCP : " & frmTraficReseau.Label2(0).Tag Offset = 20 + (xEnteteTcp.DataOffset \ &H10) * 4

Case 17 ' udp

CopyMemory xEnteteUdp, VarPtr(Buffer(0)) + 20, LenB(xEnteteUdp): xProto = 17 frmTraficReseau.Label2(1).Tag = frmTraficReseau.Label2(1).Tag + 1:

frmTraficReseau.Label2(1).Caption = "UDP : " & frmTraficReseau.Label2(1).Tag Offset = 20 + LenB(xEnteteUdp)

Case 1 ' icmp

CopyMemory xEnteteIcmp, VarPtr(Buffer(0)) + 20, LenB(xEnteteIcmp): xProto = 1

frmTraficReseau.Label2(2).Tag = frmTraficReseau.Label2(2).Tag + 1: frmTraficReseau.Label2(2).Caption = "ICMP : " & frmTraficReseau.Label2(2).Tag End Select

DataSize = xVal - Offset

If DataSize > 0 Then

ReDim xData(0 To DataSize)

CopyMemory ByVal VarPtr(xData(0)), ByVal VarPtr(Buffer(Offset)), DataSize: StrData = StrConv(xData, vbUnicode)

End If

On Error Resume Next

frmTraficReseau.Label2(3).Tag = frmTraficReseau.Label2(3).Tag + LenB(StrData): frmTraficReseau.Label2(3).Caption = "Données reçu : " & frmTraficReseau.Label2(3).Tag

Call Affiche(xProto, StrData)

If Routeur Then If xEnteteIp.SourceIp = inet_addr(frmTraficReseau.Text1.Text) Then Call Routes_Paquets(xEnteteIp.Protocol, StrData)

End Function

Sub Affiche(Proto As Integer, xData As String)

Dim Parent As Node, EnteteA As Node, EnteteB As Node, flags As Node, Titre As String, Info As String

If Proto = 6 Then Titre = "Entete Tcp" Else If Proto = 17 Then Titre = "Entete Udp" Else Titre = "Entete Icmp"

Info = FonctionIp(xEnteteIp.SourceIp) & " --> " & FonctionIp(xEnteteIp.DestIp) & Space(10) & IIf(Proto = 1, vbNullString, Mid(xData, 1, 70) & "...")

' on quitte si le protocole ne correspond pas à TCP Or UDP Or ICMP If Proto <> 6 And Proto <> 17 And Proto <> 1 Then Exit Sub

' pas grand chose à dire sur les treeview,on affiche les valeurs des champs des entetes

Set Parent = frmTraficReseau.Tree(Proto).Nodes.Add(): Parent = Info: Parent.Image = 1

Set EnteteA = frmTraficReseau.Tree(Proto).Nodes.Add(Parent, tvwChild): EnteteA = "Entete ip": EnteteA.Image = 2

Set EnteteB = frmTraficReseau.Tree(Proto).Nodes.Add(Parent, tvwChild): EnteteB = Titre: EnteteB.Image = 2

Parent.Tag = xData

EnteteA.Tag = xEnteteIp.SourceIp

' on affiche les valeurs des entetes ip

With xEnteteIp

frmTraficReseau.Tree(Proto).Nodes.Add EnteteA, tvwChild, , "Source IP . . . . " & FonctionIp(.SourceIp), 3

frmTraficReseau.Tree(Proto).Nodes.Add EnteteA, tvwChild, , "Destination IP . . . . . " & FonctionIp(.DestIp), 3

frmTraficReseau.Tree(Proto).Nodes.Add EnteteA, tvwChild, , "Time To Live (TTL) . . . . . . . . . " & .Ttl, 3

frmTraficReseau.Tree(Proto).Nodes.Add EnteteA, tvwChild, , "IP Version . . . . . . . . .IPv" & HiNibble(.VerLen), 3

frmTraficReseau.Tree(Proto).Nodes.Add EnteteA, tvwChild, , "Identification . . . . . . . . . " & IntegerToUnsigned(.id), 3

frmTraficReseau.Tree(Proto).Nodes.Add EnteteA, tvwChild, , "DataOffset. . . . . . . . ." & IntegerToUnsigned(ntohs(.Offset)), 3

frmTraficReseau.Tree(Proto).Nodes.Add EnteteA, tvwChild, , "Checksum . . . . . . . . . " & IntegerToUnsigned(ntohs(.Checksum)), 3

frmTraficReseau.Tree(Proto).Nodes.Add EnteteA, tvwChild, , "Longueur . . . " & ntohs(.TotalLength), 3

End With

Select Case Proto

Case 1

With xEnteteIcmp ' icmp

frmTraficReseau.Tree(1).Nodes.Add EnteteB, tvwChild, , "Type. . . . . . . . . " & IcmpTypeValeur(.Type), 3

"

frmTraficReseau.Tree(1).Nodes.Add EnteteB, tvwChild, , "Code & IcmpCodeValeur(.Type, .Code), 3

frmTraficReseau.Tree(1).Nodes.Add EnteteB, tvwChild, , "Checksum ." & IntegerToUnsigned(ntohs(.Checksum)), 3

frmTraficReseau.Tree(1).Nodes.Add EnteteB, tvwChild, , "Identifiant ." & ntohl(.Identifiant), 3

End With

Case 6

With xEnteteTcp ' tcp

frmTraficReseau.Tree(6).Nodes.Add EnteteB, tvwChild, , "Source Port.

." & ntohs(.PortSource), 3

frmTraficReseau.Tree(6).Nodes.Add EnteteB, tvwChild, , "Dest Port. . . . . . . . . " & ntohs(.PortDesti), 3

frmTraficReseau.Tree(6).Nodes.Add EnteteB, tvwChild, , "DataOffset. . . . . . . . ." & IntegerToUnsigned(ntohs(.DataOffset)), 3

frmTraficReseau.Tree(6).Nodes.Add EnteteB, tvwChild, , "Ack. . . . . . . . ." & LongToUnsigned(ntohl(.Ack)), 3

frmTraficReseau.Tree(6).Nodes.Add EnteteB, tvwChild, , "Sequence. . . . . . . . . " & LongToUnsigned(ntohl(.Sequence)), 3

frmTraficReseau.Tree(6).Nodes.Add EnteteB, tvwChild, , "Urgent Pointer . . . " & ntohs(.UrgentPointer), 3

frmTraficReseau.Tree(6).Nodes.Add EnteteB, tvwChild, , "Windows. . . . . . . . . " & ntohs(.Windows), 3

frmTraficReseau.Tree(6).Nodes.Add EnteteB, tvwChild, , "Checksum . . . . . . . . ." & IntegerToUnsigned(ntohs(.Checksum)), 3

End With

Case 17

With xEnteteUdp ' udp

frmTraficReseau.Tree(17).Nodes.Add EnteteB, tvwChild, , "Source Port. . . . . . . . ." & ntohs(.SourcePort), 3

frmTraficReseau.Tree(17).Nodes.Add EnteteB, tvwChild, , "Dest Port. . . . . . . . ." & ntohs(.DestPort), 3

frmTraficReseau.Tree(17).Nodes.Add EnteteB, tvwChild, , "Longueur. . . . . . . . ." & ntohs(.Len), 3

frmTraficReseau.Tree(17).Nodes.Add EnteteB, tvwChild, , "Checksum. . . . . . . . ." & IntegerToUnsigned(ntohs(.udpChecksum)), 3

End With

End Select

End Sub

5. Module Subclassing.bas

Option Explicit

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Public WndProc As Long

Public Sub SubClass(hwnd, Go As Boolean)

If Go Then WndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf NewWndProc): Exit Sub

If WndProc Then SetWindowLong hwnd, GWL_WNDPROC, WndProc End Sub

Public Function NewWndProc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

If msg = WM_USER + 1 Then If LoWord(lParam) = FD_READ Then Capture wParam

NewWndProc = CallWindowProc(WndProc, hwnd, msg, wParam, lParam) End Function

6. Module Type.bas

Public Type WSA_DATA

wVersion As Integer

wHighVersion As Integer strDescription(WSADESCRIPTION_LEN + 1) As Byte strSystemStatus(WSASYS_STATUS_LEN + 1) As Byte iMaxSockets As Integer

iMaxUdpDg As Integer

lpVendorInfo As Long

End Type

Public Type IN_ADDR
S_addr As Long

End Type

Public Type Host

Nom As Long

Aliases As Long

Type As Integer

Longueur As Integer

List As Long

End Type

Public Type SOCK_ADDR sin_family As Integer sin_port As Integer

sin_addr As IN_ADDR sin_zero(0 To 7) As Byte End Type

Public Type Inet_Adress
Byte4 As String * 1
Byte3 As String * 1
Byte2 As String * 1
Byte1 As String * 1

End Type

Public Type EnteteIp

VerLen As Byte

Tos As Byte

TotalLength As Integer

id As Integer

Offset As Integer

Ttl As Byte

Protocol As Byte

Checksum As Integer

SourceIp As Long

DestIp As Long

End Type

Public Type EnteteTcp

PortSource As Integer

PortDesti As Integer

Sequence As Long

Ack As Long

DataOffset As Byte

Flag As Byte

Windows As Integer

Checksum As Integer

UrgentPointer As Integer

End Type

Public Enum TcpFlag TF_FIN = 1 TF_SYN = 2 TF_RST = 4 TF_ PSH = 8 TF_ACK = 16 TF_URG = 32

End Enum

Public Type EnteteIcmp

Type As Byte

Code As Byte

Checksum As Integer

Identifiant As Integer

Sequence As Integer
End Type

Public Type EnteteUdp

SourcePort As Integer

DestPort As Integer

Len As Integer

udpChecksum As Integer End Type

' structure pseudo entete

Public Type PseudoEntete IPsource As Long IPdestination As Long Reserved As Byte Protocol As Byte

Len As Integer

End Type

Public Enum IcmpType

[Echo Reply] = 0

[Destination Unreachable] = 3 [Source Quench] = 4 [Redirect] = 5

[Alternate Host Address] = 6 [Echo Request] = 8

[Router Advertisement] = 9 [Router Solicitation] = 10 [Time Exceeded] = 11

[Parameter Problem] = 12 [TimeStamp Request] = 13 [TimeStamp Reply] = 14 [Information Request] = 15 [Information Reply] = 16 [Address Mask Request] = 17 [Address Mask Reply] = 18 [IP IX Trace Router] = 30 [Conversion Error] = 31 [Mobile Host Redirect] = 32 [IPv6 Where Are You] = 33 [IPv6 Here I Am] = 34

[Mobile Registration Request] = 35

[Mobile Registration Reply] = 36 [Domain Name Request] = 37 [Domain Name Reply] = 38

[SKIP Algorithm Discovery Protocol] = 39

[IPsec Security Failures] = 40 End Enum

Public Enum IcmpCode

[Network Unreachable] = 0 [Host Unreachable] = 1 [Protocol Unreachable] = 2 [Port Unreachable] = 3 [Fragmentation Needed] = 4 [Redirect Network] = 0

[Redirect Host] = 1

[Redirect TOS Network] = 2 [Redirect TOS Host] = 3

[TTL Exceeded In Transit] = 0 [Reassembly Timeout] = 1 [Problem With Option] = 0

End Enum

' type pour info interface(ip/masque/broadcast,flag) + constante

Public Type Sock_Addr_Info

AddresseLocal As SOCK ADDR

filler(0 To 7) As Byte

End Type

Public Type INTERFACE_INFO

Info_ Flags As Long 'Interface flags

Info Addresse As Sock Addr_ Info 'Interface addresse

Info_BroadcastAddresse As Sock Addr_ Info 'Broadcast addresse

Info_Netmask As Sock Addr_ Info 'Network mask

End Type

Public Type INTERFACEINFO

Info_Inter(0 To 7) As INTERFACE_INFO End Type

Public Const SIO_GET

_

INTERFACE

LIST As Long = &H4004747F

_

7. Module Verification.bas

Option Explicit

Private Declare Function ntohs Lib "ws2_32.dll" (ByVal netshort As Long) As Integer Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)

Public Function Checksum(ByVal adrs As Long, ByVal length As Long) As Long

Dim i As Long, t As Long

For i = 1 To length Step 2

t = t + Read16(adrs): adrs = adrs + 2

Next

t = Int16(t): Checksum = l2i((Not t) And &HFFFF&)

End Function

Private Function Read16(ByVal adrs As Long) As Long

CopyMemory Read16, ByVal adrs, 2

End Function

Private Function i2l(ByVal i As Long) As Long

CopyMemory i2l, i, 2

End Function

Private Function l2i(ByVal i As Long) As Long

CopyMemory l2i, i, 2

End Function

Private Function Int16(ByVal Value As Long) As Long

Dim t(1) As Integer

CopyMemory t(0), Value, 4

Int16 = i2l(t(0)) + i2l(t(1))

End Function

Public Function HexB(ByVal b As Byte) As String

HexB = Hex(b)

HexB = String(2 - Len(HexB), "0") & HexB

End Function

Public Function CheckUdp(ByVal AdrsePs As Long, LenPs As Long, ByVal AdrseUdp As Long, LenUdp As Long, ByVal AdrsData As Long, LenData As Long) As Long

Dim Datagramme() As Byte

ReDim Datagramme(LenPs + LenUdp + LenData)

CopyMemory ByVal VarPtr(Datagramme(0)), ByVal AdrsePs, LenPs CopyMemory ByVal VarPtr(Datagramme(0)) + LenPs, ByVal AdrseUdp, LenUdp CopyMemory ByVal VarPtr(Datagramme(0)) + LenPs + LenUdp, ByVal AdrsData,

LenData

CheckUdp = Checksum(VarPtr(Datagramme(0)), UBound(Datagramme))

End Function

Public Function CheckIcmp(ByVal AdrsIcmp As Long, LenIcmp As Long, ByVal AdrsData As Long, LenData As Long) As Long

Dim Datagramme() As Byte

ReDim Datagramme(LenIcmp + LenData)

CopyMemory ByVal VarPtr(Datagramme(0)), ByVal AdrsIcmp, LenIcmp CopyMemory ByVal VarPtr(Datagramme(LenIcmp)), ByVal AdrsData, LenData CheckIcmp = Checksum(VarPtr(Datagramme(0)), UBound(Datagramme))

End Function

Public Function CheckTcp(ByVal AdrsePs As Long, LenPs As Long, ByVal AdrseTcp As Long, LenTcp As Long, ByVal AdrsData As Long, LenData As Long) As Long

Dim Datagramme() As Byte

ReDim Datagramme(LenPs + LenTcp + LenData)

CopyMemory ByVal VarPtr(Datagramme(0)), ByVal AdrsePs, LenPs

CopyMemory ByVal VarPtr(Datagramme(LenPs)), ByVal AdrseTcp, LenTcp CopyMemory ByVal VarPtr(Datagramme(LenPs + LenTcp)), ByVal AdrsData, LenData

CheckTcp = Checksum(VarPtr(Datagramme(0)), UBound(Datagramme))

End Function