Mode connecte et non connecté en VB
Par DeadlyPredator

Nom

Effet

Valeurs acceptées

Name

*(Quand il est sur une feuille) Le nom du contrôle

Une chaîne de caractères correcte pour un nom d'objet

Index

*(Quand il est sur une feuille) Son index si il fait partit d'une collection de contrôles

rien=pas dans une collection;un chiffre de 0 à (limite du type entier)

Left

*(Quand il est sur une feuille) La position du côté gauche du contrôle

un chiffre

LocalPort

Port à écouter pour recevoir des paquets ou des demandes de connexion

un chiffre de 0 à 65 000

Protocol

Protocole à utiliser

0 pour TCP et 1 pour UDP

RemoteHost

L'adresse de l'hôte auquel il faut envoyer des paquets (UDP)

une adresse ip: 192.168.0.1, 125.124.368.14, ... ou un DNS.

RemotePort

Le port de l'hôte auquel il faut envoyer des paquets (UDP)

un chiffre de 0 à 65 000

Tag

*(Quand il est sur une feuille) Une propriété pour stocker des données, ce que l'on veut

ce que l'on veut

Top

*(Quand il est sur une feuille) La position du haut du contrôle

un chiffre

Nom

Résultat

BytesReceived

Nombre de BYTES reçus

LocalHostName

Nom d'hôte de cet ordinateur

RemoteHostIP

Adresse IP de l'hôte auquel on est connecté

SocketHandle

Le handle du socket qui est utilisé (la section que l'API winsock a dû lui réserver)

State

L'état du socket (connecté, erreur, attente de connexion, ...)

Nom

Description des arguments

Description

Close()

Fermeture d'une connexion (TCP)

Connect()

Connexion réussie (TCP)

ConnectionRequest(ByVal requestID As Long)

l'ID d'une requête de connexion)

Demande de connexion (TCP)

DataArrival(ByVal bytesTotal As Long)

Le nombre de bytes qui arrivent

Arrivée de données

Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)

Informations relatives à l'erreur (numéro, description, ...)

Erreur!!!!!!

SendComplete()

Envoi des données terminé

SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)

Nombre de bytes envoyées
Nombre de bytes qui reste à envoyer

Envoi des données en cours ...

Private Sub Command1_Click() socket.Connect "www.google.com", 80 'On se connecte à www.google.com sur le port 80 End Sub

Private Sub socket_Close() 'Fin de la connexion MsgBox "connexion terminée!" socket.Close 'Fermeture du socket End Sub

Private Sub socket_Connect() 'Connexion établie MsgBox "connexion réessie!" socket.SendData "GET / HTTP/1.0" & vbCrLf & "Accept: */*" & vbCrLf & "User-Agent: Winsock" & vbCrLf & vbCrLf 'On envoie des données au serveur, ici c'est une requête HTTP End Sub

Private Sub socket_DataArrival(ByVal bytesTotal As Long) 'Arrivée de données Dim data As String If socket.State <> sckConnected Then Exit Sub 'Juste au cas où ça a buggé socket.GetData data, vbString 'On récupère les données 'DONNÉES DANS DATA MsgBox data End Sub

Private Sub socket_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) Err.Clear 'On ignore l'erreur End Sub

Public WithEvents socket As Winsock 'Pour les évènements

Private Sub Command1_Click() socket.Connect "www.google.com", 80 'On se connecte à www.google.com sur le port 80 End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Set socket = Nothing 'On vide l'objet winsock End Sub

Private Sub socket_Close() 'Fin de la connexion MsgBox "connexion terminée!" socket.Close 'Fermeture du socket End Sub

Private Sub socket_Connect() 'Connexion établie MsgBox "connexion réessie!" socket.SendData "GET / HTTP/1.0" & vbCrLf & "Accept: */*" & vbCrLf & "User-Agent: Winsock" & vbCrLf & vbCrLf 'On envoie des données au serveur, ici c'est une requête HTTP End Sub

Private Sub socket_DataArrival(ByVal bytesTotal As Long) 'Arrivée de données Dim data As String If socket.State <> sckConnected Then Exit Sub 'Juste au cas où ça a buggé socket.GetData data, vbString 'On récupère les données 'DONNÉES DANS DATA MsgBox data End Sub

Private Sub socket_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) Err.Clear 'On ignore l'erreur End Sub

Private Sub Form_Load() Set socket = New Winsock 'On initialise winsock 'With socket '.param1=??? '.param2=??? 'End With End Sub

Private Sub Command1_Click() socket.Close 'UN SOCKET DOIT ÊTRE FERMER AVANT D'ÊTRE MIS EN ÉCOUTE!!! socket.LocalPort = 95 'écoute port 95 socket.Listen End Sub

Private Sub socket_Close() 'Fermeture du socket MsgBox "connexion terminée!" socket.Close 'S'assurer que le socket se ferme car sinon, ça peut être très drôle ;-) Command1_Click End Sub

Private Sub socket_ConnectionRequest(ByVal requestID As Long) 'Demande de connexion MsgBox "Demande de connexion!" socket.Close 'UN SOCKET DOIT ÊTRE FERMER AVANT D'ACCEPTER UNE CONNEXION!!! 'Bon, ya u gros problème. c'est une connexion par socket. QUE FAIRE!!! socket.Accept requestID 'Une autre contrôle winsock peut très bien accepter cette demande... End Sub

Private Sub socket_DataArrival(ByVal bytesTotal As Long) 'Arrivée des données Dim data As String If socket.State <> sckConnected Then Exit Sub 'En cas de problèmes ... on ne sait pas socket.GetData data, vbString MsgBox data 'Ce que le client dit (on s'en fiche tu :-) 'Ce qu'on lui répond : Dim envoie As String envoie = "<html><head><title>Salut</title></head><body>Allo</body></html>" 'La réponse à envoyer socket.SendData "HTTP/1.0 200 OK" & vbCrLf & "Server: Winsock/6.0" & vbCrLf & "Content-Type: text/html" & vbCrLf & "Content-Lenght: " & Len(envoie) & vbCrLf & vbCrLf & envoie 'Une réponse HTTP ^ End Sub

Private Sub socket_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) Err.Clear 'En cas d'erreur, ignorer End Sub

Private Sub socket_SendComplete() socket.Close 'On ferme End Sub

Private Sub Command1_Click() 'Le socket est ouvert et il restera ouvert If ecoute.State = 2 Then Exit Sub 'Si on écoute déjà, on quitte la procédure ecoute.LocalPort = 95 ecoute.Listen End Sub

Private Sub ecoute_ConnectionRequest(ByVal requestID As Long) 'LE TRÈS GROS MORCEAU Dim nb As Integer nb = socket.Count 'Le nombre de socket dans la collection. Comme le 0 compte, pas besoins de rajouter +1. Load socket(nb) 'On ajoute ajoute un autre socket dans la collection de ce contrôle socket(nb).Accept requestID 'CE contrôle fesant partit de la collection accepte la requête Debug.Print "Client ajouté : " & socket(nb).RemoteHostIP End Sub

Private Sub ecoute_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) Err.Clear 'En cas d'erreur, ignorer End Sub

Private Sub socket_Close(Index As Integer) socket_SendComplete Index 'Si le socket se ferme, fait comme si l'envoie serait fini End Sub

Private Sub socket_DataArrival(Index As Integer, ByVal bytesTotal As Long) 'NOTEZ BIEN L'ARGUMENT INDEX. IL RETOURE L'INDEX DE CE SOCKET DANS LA COLLECTION 'Ce que le client dit (on s'en fiche tu :-) 'Ce qu'on lui répond : Dim envoie As String envoie = "<html><head><title>Salut</title></head><body>a" & String$(10000, "l") & "o</body></html>" 'La réponse à envoyer Debug.Print "Envoie du socket # " & Index & " à " & Now socket(Index).SendData "HTTP/1.0 200 OK" & vbCrLf & "Server: Winsock/6.0" & vbCrLf & "Content-Type: text/html" & vbCrLf & "Content-Lenght: " & Len(envoie) & vbCrLf & "Pragma: no-cache" & vbCrLf & vbCrLf & envoie 'Une réponse HTTP ^ End Sub

Private Sub socket_Error(Index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) Err.Clear 'En cas d'erreur, ignorer End Sub

Private Sub socket_SendComplete(Index As Integer) socket(Index).Close 'Fermer le socket Debug.Print "Fermeture du socket # " & Index & " à " & Now If Index <> 0 Then Unload socket(Index) 'Si le socket n'est pas le 0 (celui de base), on le FLUSH End Sub

Public WithEvents socket As Winsock
Public MyNum As Long

Private Sub Class_Initialize() Set socket = New Winsock End Sub

Private Sub Class_Terminate() Set socket = Nothing End Sub

Private Sub socket_Close() Form1.Killsocket MyNum 'S'assurer que le socket se ferme car sinon, ça peut être très drôle ;-) End Sub

Private Sub socket_DataArrival(ByVal bytesTotal As Long) 'Ce qu'on lui répond : Debug.Print "OK" Dim envoie As String envoie = "<html><head><title>Salut</title></head><body>A" & String$(1000, "l") & "o</body></html>" 'La réponse à envoyer socket.SendData "HTTP/1.0 200 OK" & vbCrLf & "Server: Winsock/6.0" & vbCrLf & "Content-Type: text/html" & vbCrLf & "Content-Lenght: " & Len(envoie) & vbCrLf & vbCrLf & envoie 'Une réponse HTTP ^ End Sub

Private Sub socket_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) Err.Clear 'En cas d'erreur, ignorer End Sub

Private Sub socket_SendComplete() socket.Close 'On ferme End Sub

Private WithEvents socket As Winsock
Public Sockets As New Collection
Public Num As Long

Private Sub Class_Initialize() Set socket = New Winsock With socket .LocalPort = 95 .Listen End With End Sub

Private Sub Class_Terminate() Set Sockets = Nothing Set socket = Nothing End Sub

Private Sub socket_ConnectionRequest(ByVal requestID As Long) Dim buf As New Client buf.socket.Accept requestID buf.MyNum = Num Num = Num + 1 Sockets.Add buf End Sub

Private Sub socket_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) Err.Clear End Sub

Private Clients As Clients
'JUSTE POUR DÉMARRER  ET NETTOYER CAR J'AI PAS ENVIE DE ME CASSER LA TÊTE

Private Sub Form_Load() Set Clients = New Clients End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Set Clients = Nothing End Sub

Sub Killsocket(MyNum As Long) For i = 1 To Clients.Sockets.Count If Clients.Sockets.MyNum = MyNum Then Clients.Sockets.Remove i Next End Sub

Private Sub CheckState_Timer()
If Clients.ListCount = 0 Then send.Enabled = False Else: send.Enabled = True 'Si il n'y a pas de client, pourquoi envoyer un message?
If Ecoute.State = 0 Then Go.Caption = "Écouter" Else: Go.Caption = "Arrêter le serveur" 'Placer le texte du bouton Go
End Sub

Private Sub Clients_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton And Clients.ListIndex <> -1 Then 'Si on clique avec le bouton droit et qu'on a sélectionner un ip dans la liste, on affiche le menu
PopupMenu pop
End If
End Sub

Private Sub Decon_Click() 'ON LE BOOT!!
Dim col
col = Split(Clients.List(Clients.ListIndex), ":") 'On récuprère son # de socket (après le ":")
Socket_Close (CInt(col(1))) 'On fait comme s'il aurait quitté
End Sub

Private Sub Ecoute_ConnectionRequest(ByVal requestID As Long) 'Demande de connexion
Dim Nb As Integer
Nb = Socket.Count '# de la prochaince socket disponible (LIMITE : 65535 CAR TYPE INTEGER = SUR 4 OCTETS (FFFF))
Load Socket(Nb) 'On charge ce socket
Socket(Nb).Accept requestID 'On fait accepter la connexion
recep.Text = recep.Text & recep.Text & "<system> : Connexion établie avec " & Socket(Nb).RemoteHostIP & " !" & vbCrLf & vbCrLf 'On dit que le client c'est connecté
Clients.AddItem Socket(Nb).RemoteHostIP & ":" & Nb 'On met son IP suivit de ":" et son 1 de socket dans la liste
End Sub

Private Sub Ecoute_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) 'Erreur!
MsgBox "Erreur avec le socket! & vbcrlf # " & Number & vbCrLf & Description
Ecoute.Close
End Sub

Private Sub Form_Load()
CheckState_Timer 'On fait faire une première vérification avec le timer
End Sub

Private Sub Go_Click() 'On appuie sur le bouton Go
On Error Resume Next
If Ecoute.State = 2 Then 'Si on écoutait, ben on ferme
Ecoute.Close
For i = 1 To Socket.Count - 1 'On décharge tout les sockets
Socket(i).Close
Unload Socket(i) 'On détruit l'objet créer (0 ne peut pas être unloadé)
Next
Else 'Sinon ben on écoute
Ecoute.LocalPort = Port.Text 'Le port
Ecoute.Listen 'On écoute
If Err.Number <> 0 Then 'ERREUR, POURQUOI ON PEUT PAS ÉCOUTER (sûrement que le port est occupé)
MsgBox "Erreur avec le socket! & vbcrlf # " & Err.Number & vbCrLf & Err.Description 'On dit pourquoi
Err.Clear 'On nettoie l'erreur
End If
End If
End Sub

Private Sub send_Click() 'Envoie du message, comme avec le client
recep.Text = recep.Text & "<you> : " & vbCrLf & Emission.Text & vbCrLf & vbCrLf
For i = 1 To Socket.Count - 1
Socket(i).SendData Emission.Text
Next
Emission.Text = ""
End Sub

Private Sub Socket_Close(Index As Integer) 'Le client vient de quitter ou il s'est fait booter
Dim col
For i = 0 To Clients.ListCount - 1 'On cherche son # de socket pour l'enlever de la liste
col = Split(Clients.List(i), ":")
If col(1) = Index Then
Socket(col(1)).Close
Unload Socket(col(1)) 'On kill le socket
recep.Text = recep.Text & recep.Text & "<system> : Connexion terminée avec " & col(0) & " !" & vbCrLf & vbCrLf 'On dit qu'il quitte
Clients.RemoveItem i 'On l'enlève de la liste
Exit For 'Pas besoins de continuer
End If
Next
End Sub

Private Sub Socket_DataArrival(Index As Integer, ByVal bytesTotal As Long) 'Arrivée des données, comme avec le client
Dim data As String
Socket(Index).GetData data, vbString
recep.Text = recep.Text & "<" & Socket(Index).RemoteHostIP & "> : " & vbCrLf & data & vbCrLf & vbCrLf
End Sub

'SOCKET 1 EST LE "CLIENT" ET LE 2 EST LE "SERVEUR"

Private Sub Form_Load() On Error Resume Next 'UDP PLANTE DESFOIS!!! socket2.Bind 98, "0.0.0.0" 'PORT À ÉCOUTER socket1.RemoteHost = "127.0.0.1" 'Adresse auquel il faut envoyer le(s) datagramme(s) socket1.RemotePort = 98 'Port auquel il faut envoyer le(s) datagramme(s) socket1.SendData "drole" 'Envoyer les données End Sub

Private Sub Form_Unload(Cancel As Integer) socket2.Close 'Arrêter d'écouter le port UDP 98 End Sub

Private Sub socket1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) Err.Clear 'Ignorer l'erreur End Sub

Private Sub socket2_DataArrival(ByVal bytesTotal As Long) Dim data As String socket2.GetData data, vbString 'Prendre les données comme avec tcp MsgBox "Message de " & socket2.RemoteHostIP & " : " & data End Sub

Private Sub socket2_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) Err.Clear 'Ignorer l'erreur End Sub

Option Explicit

Private Sub CheckState_Timer()
If Socket.State = 1 Then Go.Caption = "Arrêter" Else: Go.Caption = "Écouter"
End Sub

Private Sub Go_Click()
On Error Resume Next
If Socket.State <> 1 Then
Socket.Close
Socket.Bind port.Text, addr.Text
If Err.Number <> 0 Then 'ERREUR, POURQUOI ON PEUT PAS ÉCOUTER (sûrement que le port est occupé)
MsgBox "Erreur avec le socket! & vbcrlf # " & Err.Number & vbCrLf & Err.Description 'On dit pourquoi
Err.Clear 'On nettoie l'erreur
End If
Else
Socket.Close
End If
End Sub


Private Sub send_Click()
On Error Resume Next
If Socket.State <> 1 Then 'On prend 1 port pour recevoir les messages du recépteur
Socket.LocalPort = 0 'N'IMPORTE QUEL PORT LIBRE
End If
Socket.RemoteHost = sendaddr.Text 'L'adresse où ilo faut envoyer les données
Socket.RemotePort = sendport.Text 'Le port où ilo faut envoyer les données
Socket.SendData Emission.Text 'On envoie (ÇA PEUT BOGUER POUR RIEN!!!)
recep.Text = recep.Text & "<you> : " & vbCrLf & Emission.Text & vbCrLf & vbCrLf 'Pour savoir ce qu'on a envoyer
Emission.Text = "" 'On fait de la place pour un nouveau message
End Sub

Private Sub Socket_DataArrival(ByVal bytesTotal As Long)
Dim data As String
Socket.GetData data, vbString 'On les met dans la variable data
recep.Text = recep.Text & "<" & Socket.RemoteHostIP & "> : " & vbCrLf & data & vbCrLf & vbCrLf 'Pour dire qui à envoyer le message
sendaddr.Text = Socket.RemoteHostIP 'On garde son adresse et on peut lui répondre
sendport.Text = Socket.RemotePort 'On garde son port et on peut lui répondre
Beep
End Sub

Private Sub Socket_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
'ERREUR!!! ON AFFICHE L'ERRREUR ET ON FERME LE SOCKET
MsgBox "Erreur avec le socket! & vbcrlf # " & Number & vbCrLf & Description
Socket.Close
End Sub