Bonjour,
Option Explicit
Const PORT_LOG As Long = 162 ' port de logs
Const LINKSYS_INFO_START As Long = 74 '
Private Sub Command1_Click()
Dim ip As String
Dim rep As VbMsgBoxResult
Dim errn As Long
Dim errs As String
Dim ret As Boolean
[code=vb]On Error GoTo Command1_error
If Winsock1.State = 1 Then ' si déjà à l'écoute
' propose une réinitialisation éventuelle
rep = MsgBox("Le programme est déjà initialisé. Voulez vous le réinitialiser?", vbQuestion + vbYesNo, "Réinitialisation")
If rep = vbYes Then
Winsock1.Close
DoEvents
Else
Exit Sub
End If
#End If
ip = Text1.Text ' récupération de l'IP de notre machine, bind au port 162
If ip <> "" Then
ret = ip_bind(PORT_LOG, ip, errn, errs)
If ret Then
Label2.BackColor = &H80FF80 ' mise à jour label
Label2.Caption = "Surveillance Active"
Else
MsgBox "Erreur lors de l'initialisation" & vbCrLf & "Erreur : " & errs & " (" & errn & ")", vbExclamation, "Erreur initialisation"
End If
Else
MsgBox "Entrez l'adresse IP locale de cette machine."
End If
Command1_ok:
Exit Sub
Command1_error:
MsgBox "Erreur : " & Err.Description & " (" & Err.Number & ")"
Resume Command1_ok
End Sub
Private Function ip_bind(ByVal port As Long, _
ByVal ip As String, _
ByRef errn As Long, _
ByRef errs As String) As Boolean
On Error GoTo bind_error
Winsock1.Bind PORT_LOG, ip
ip_bind = True
bind_ok:
Exit Function
bind_error:
errn = Err.Number
errs = Err.Description
ip_bind = False ' inutile en soi, juste par symétrie
Resume bind_ok
End Function /code
Private Sub Command2_Click()
On Error GoTo Command2_Click_Error
Label2.BackColor = &H8080FF
Label2.Caption = "Surveillance non active"
Winsock1.Close
DoEvents
On Error GoTo 0
Exit Sub
Command2_Click_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Command2_Click of Feuille frmMain"
End Sub
Private Sub Form_Load()
Call Init_label_colonnes
End Sub
Private Sub Init_label_colonnes()
Label4.Caption = "Timestamp Direction IP source Port IP/host dest Port "
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim s As String
Dim p As Long
Dim t() As String
Dim n As Integer
Dim ss As String
Dim ip() As String
On Error GoTo Winsock1_DataArrival_Error
Winsock1.GetData s ' lit le pacquet de donnée
s = Mid$(s, LINKSYS_INFO_START) ' ne garde qu'à partir de la position 74
p = InStr(s, vbLf) ' cherche un CRLF
If p = 0 Then Exit Sub ' si pas présent, on sort
s = Mid$(s, 1, p - 1) ' garde la partie utile seulement
t() = Split(s, " ") ' découpe en champs
If Mid$(t(0), 1, 1) = "@" Then ' si ça ne commence pas par ce caractère, ce n'est pas pour nous
' "parsing" de tout ça et prépare pour affichage
For n = 0 To UBound(t())
Select Case n
' DIRECTION
Case 0
If t(n) = "@out" Then
'ss = ss & "outgoing"
ss = ss & "sortant "
Else
'ss = ss & "incoming"
ss = ss & "entrant "
End If
' IP/hote source
Case 1
ss = ss & t(1) & Space$(16 - Len(t(1)))
' PORT source
Case 2
ss = ss & t(2) & Space$(6 - Len(t(2)))
' IP/HOTE destination
Case 3
If Len(t(3)) > 50 Then
t(3) = Mid$(t(3), 1, 49)
End If
ss = ss & t(3) & Space$(50 - Len(t(3)))
' PORT destination
Case 4
ss = ss & t(4) & Space$(6 - Len(t(4)))
End Select
ss = ss & " "
Next n
' on ajoute l'heure et on affiche en haut du RtextBox
rt1.Text = Format$(Date, "dd/mm/yy") & " " & Format$(Time, "hh:mm:ss") & " " & ss & vbCrLf & rt1.Text
End If
' utile pour garder la main si beaucoup de données
rt1.Refresh
DoEvents
On Error GoTo 0
Exit Sub
Winsock1_DataArrival_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Winsock1_DataArrival of Feuille frmMain"
End Sub
En espérant t'avoir aider.
Cordialement.
Anakin79