Soyez le premier à donner votre avis sur cette source.
Vue 18 622 fois - Téléchargée 2 865 fois
Imports System.Text Imports System.Net Imports System.Net.Sockets Imports System.IO Public Class frmMain Inherits System.Windows.Forms.Form Dim IPHE As Net.IPHostEntry Dim IPA() As Net.IPAddress Dim HN As String Dim TcpServer As System.Net.Sockets.TcpListener Dim Buffer(1024) As Byte Dim bytes As Integer Dim strTemp As String Dim ascii As Encoding = Encoding.ASCII Dim Retour As DialogResult Public IP As String Public Socket As Socket = Nothing Dim Request As String Private Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load IpLocale() If File.Exists("ipchat.ini") Then Dim sr As New StreamReader("ipchat.ini") Dim i As Integer = 0 Do Until sr.Peek = -1 If i = 0 Then i = 1 txtNick.Text = sr.ReadLine Else txtIP.Text = sr.ReadLine End If Loop sr.Close() End If End Sub Private Sub txtIP_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txtIP.DoubleClick txtIP.Text = "" End Sub Private Sub IpLocale() Dim strIP As String HN = Net.Dns.GetHostName() IPHE = Net.Dns.GetHostByName(HN) IPA = IPHE.AddressList() Dim i As Integer For i = 0 To IPA.GetUpperBound(0) strIP = strIP & IPA(i).ToString() & vbCrLf Next txtIpLocale.Text = strIP End Sub Private Sub Reset() btnConnect.Text = "Se connecter" btnServer.Text = "Héberger" gpbServer.Enabled = True gpbClient.Enabled = True tmrConnect.Enabled = False tmrWait.Enabled = False Socket.Close() Socket = Nothing strTemp = "" sbpConnection.Text = "Non connecté" sbpConnection.Icon = New System.Drawing.Icon("TRFFC10C.ICO") End Sub Private Sub tmrConnect_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmrConnect.Tick If Socket.Available > 0 Then bytes = Socket.Receive(Buffer, Buffer.Length, 0) strTemp = strTemp + ascii.ASCII.GetString(Buffer, 0, bytes) Select Case strTemp Case ":connection:CLOSING" Reset() MessageBox.Show("Connexion coupée par le client ou l'hôte.", "Connexion", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) Exit Sub Case ":connection:REFUSED" Reset() MessageBox.Show("Connexion refusée par l'hôte.", "Connexion", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) Exit Sub Case ":connection:ACCEPTED" MessageBox.Show("Connexion acceptée par l'hôte.", "Connexion", MessageBoxButtons.OK, MessageBoxIcon.Information) strTemp = "" sbpConnection.Text = "Connecté !" sbpConnection.Icon = New System.Drawing.Icon("TRFFC10A.ICO") End Select If strTemp <> "" Then txtAff.Text += strTemp & vbCrLf strTemp = "" End If End If End Sub Private Sub SocketSend(ByVal server As String, ByVal port As Integer) Request = txtNick.Text & " dit : " & vbCrLf & " " & txtMessage.Text Dim ascii As Encoding = Encoding.ASCII Dim bytesSent As [Byte]() = ascii.GetBytes(Request) Request = "" If txtNick.Text = "" Then MessageBox.Show("Vous devez taper votre pseudo." & vbCrLf & "Envoi annulé...", "Pseudo", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) txtNick.Focus() Exit Sub ElseIf txtMessage.Text = "" Then MessageBox.Show("Vous devez taper un message.", "Message", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) txtMessage.Focus() Exit Sub End If If Socket Is Nothing Then MessageBox.Show("Vous n'êtes pas connecté." & vbCrLf & "Envoi annulé...", "Connexion", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) Exit Sub End If Try Socket.Send(bytesSent, bytesSent.Length, 0) Catch ex As Exception MessageBox.Show("Connexion coupée.", "Connexion", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) Reset() Exit Sub End Try txtAff.Text += txtNick.Text & " dit : " & vbCrLf & " " & txtMessage.Text & vbCrLf txtMessage.Text = "" End Sub Private Sub btnSend_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSend.Click If Socket Is Nothing Then MessageBox.Show("Non connecté.", "Connexion", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) Exit Sub ElseIf txtMessage.Text = "" Then Exit Sub End If SocketSend(IP, 8157) End Sub Private Sub txtAff_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txtAff.TextChanged If txtAff.Lines.Length > 17 Then txtAff.Text = txtAff.Text.Remove(0, txtAff.Lines(0).Length + 2) End If End Sub Private Sub tmrNow_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmrNow.Tick sbpDateSysteme.Text = Date.Now.ToString("dd/MM/yyyy") sbpHeureSysteme.Text = Date.Now.ToString("HH:mm:ss") End Sub #Region "Partie Server" Private Sub btnServer_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnServer.Click If txtNick.Text = "" Then MessageBox.Show("Vous devez indiquer votre pseudo." & vbCrLf & "Hébergement annulé.", "Erreur", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) txtNick.Focus() Exit Sub End If If btnServer.Text = "Héberger" Then btnServer.Text = "Arrêter d'héberger" gpbClient.Enabled = False TcpServer = New Net.Sockets.TcpListener(8157) TcpServer.Start() tmrWait.Enabled = True sbpConnection.Text = "En attente de connexion ..." sbpConnection.Icon = New System.Drawing.Icon("TRFFC10B.ICO") Else btnServer.Text = "Héberger" gpbClient.Enabled = True tmrWait.Enabled = False tmrConnect.Enabled = False TcpServer.Stop() sbpConnection.Text = "Non connecté" sbpConnection.Icon = New System.Drawing.Icon("TRFFC10C.ICO") If Socket Is Nothing Then Exit Sub Else If Socket.Connected = True Then Request = ":connection:CLOSING" Dim ascii As Encoding = Encoding.ASCII Dim bytesSent As [Byte]() = ascii.GetBytes(Request) Try Socket.Send(bytesSent, bytesSent.Length, 0) Socket.Close() Socket = Nothing Catch Socket = Nothing Exit Sub End Try End If End If Exit Sub End If End Sub Private Sub tmrWait_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmrWait.Tick If TcpServer.Pending = True Then tmrWait.Enabled = False Socket = TcpServer.AcceptSocket() TcpServer.Stop() If Socket.Connected = True Then If Socket.Available > 0 Then strTemp = "" bytes = Socket.Receive(Buffer, Buffer.Length, 0) strTemp = strTemp + ascii.ASCII.GetString(Buffer, 0, bytes) Retour = MessageBox.Show("Souhaitez vous accepter la connexion en provenance de : " & IPAddress.Parse((CType(Socket.RemoteEndPoint, IPEndPoint).Address.ToString())).ToString & " (" & strTemp & ")" & " ?", "Connexion", MessageBoxButtons.YesNo, MessageBoxIcon.Question) strTemp = "" If Retour = DialogResult.No Then Request = ":connection:REFUSED" Dim ascii As Encoding = Encoding.ASCII Dim bytesSent As [Byte]() = ascii.GetBytes(Request) Try Socket.Send(bytesSent, bytesSent.Length, 0) Socket.Close() Socket = Nothing Catch Socket = Nothing End Try TcpServer.Start() tmrWait.Enabled = True Socket = Nothing Else Request = ":connection:ACCEPTED" Dim ascii As Encoding = Encoding.ASCII Dim bytesSent As [Byte]() = ascii.GetBytes(Request) Try Socket.Send(bytesSent, bytesSent.Length, 0) Catch End Try tmrConnect.Enabled = True sbpConnection.Text = "Connecté !" sbpConnection.Icon = New System.Drawing.Icon("TRFFC10A.ICO") End If End If Else TcpServer.Start() tmrWait.Enabled = True End If End If End Sub #End Region #Region "Partie Client" Private Sub btnConnect_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnConnect.Click If btnConnect.Text = "Se connecter" Then If Connexion() = True Then tmrConnect.Enabled = True btnConnect.Text = "Se déconnecter" gpbServer.Enabled = False sbpConnection.Text = "En attente de l'acceptation de la connexion..." sbpConnection.Icon = New System.Drawing.Icon("TRFFC10B.ICO") Else Exit Sub End If Else btnConnect.Text = "Se connecter" gpbServer.Enabled = True tmrConnect.Enabled = False sbpConnection.Text = "Non connecté" sbpConnection.Icon = New System.Drawing.Icon("TRFFC10C.ICO") If Socket Is Nothing Then Exit Sub Else If Socket.Connected = True Then Request = ":connection:CLOSING" Dim ascii As Encoding = Encoding.ASCII Dim bytesSent As [Byte]() = ascii.GetBytes(Request) Try Socket.Send(bytesSent, bytesSent.Length, 0) Socket.Close() Catch End Try Socket = Nothing End If End If End If End Sub Private Function Connexion() As Boolean If ValidationIP(txtIP.Text) = False Then MessageBox.Show("Adresse IP non valide !" & vbCrLf & "Connexion annulée.", "Connexion", MessageBoxButtons.OK, MessageBoxIcon.Error) Return False Exit Function Else IP = txtIP.Text End If If txtNick.Text = "" Then MessageBox.Show("Vous devez taper votre pseudo." & vbCrLf & "Connexion annulée...", "Pseudo", MessageBoxButtons.OK, MessageBoxIcon.Exclamation) txtNick.Focus() Return False Exit Function End If Dim ascii As Encoding = Encoding.ASCII Dim Nick As String = txtNick.Text Dim nickSent As [Byte]() = ascii.GetBytes(Nick) Socket = ConnectSocket(IP, 8157) Try Socket.Send(nickSent, nickSent.Length, 0) Catch ex As Exception Return False Exit Function End Try Return True End Function Private Shared Function ConnectSocket(ByVal server As String, ByVal port As Integer) As Socket Dim Socket As Socket = Nothing Dim hostEntry As IPHostEntry = Nothing Try hostEntry = Dns.Resolve(server) Catch ex As Exception If InStr(ex.ToString, "No such host") >= 1 Then MessageBox.Show("Adresse IP non valide ou hôte non connecté.", "Connexion", MessageBoxButtons.OK, MessageBoxIcon.Error) Exit Function End If MessageBox.Show(ex.ToString) End Try Dim address As IPAddress For Each address In hostEntry.AddressList Dim endPoint As New IPEndPoint(address, port) Dim tempSocket As New Socket(endPoint.AddressFamily, SocketType.Stream, ProtocolType.Tcp) Try tempSocket.Connect(endPoint) Catch MessageBox.Show("Erreur lors de la connexion : hôte non joignable.", "Connexion", MessageBoxButtons.OK, MessageBoxIcon.Error) Exit Function End Try If tempSocket.Connected Then Socket = tempSocket Exit For Else MessageBox.Show("Erreur lors de la connexion : non connecté.", "Connexion", MessageBoxButtons.OK, MessageBoxIcon.Error) Exit Function End If Next address Return Socket End Function Public Function ValidationIP(ByVal strIP As String) As Boolean Try Dim Br1 As String, Br2 As String, Br3 As String, Br4 As String If InStr(strIP, ".") = 0 Then ValidationIP = False : Exit Function Br1 = Microsoft.VisualBasic.Strings.Mid(strIP, 1, InStr(strIP, ".") - 1) Br2 = Microsoft.VisualBasic.Strings.Mid(strIP, Len(Br1) + 2, (Len(strIP) - InStr(strIP, ".")) + 1) Br2 = Microsoft.VisualBasic.Strings.Left(Br2, InStr(Br2, ".") - 1) Br3 = Microsoft.VisualBasic.Strings.Mid(strIP, Len(Br1) + Len(Br2) + 3, Len(strIP)) Br3 = Microsoft.VisualBasic.Strings.Left(Br3, InStr(Br3, ".") - 1) Br4 = Microsoft.VisualBasic.Strings.Mid(strIP, Len(Br1) + Len(Br2) + Len(Br3) + 4, Len(strIP)) If IsNumeric(Br1) = False Or IsNumeric(Br2) = False Or IsNumeric(Br3) = False Or IsNumeric(Br4) = False Then ValidationIP = False : Exit Function If Not (CInt(Br1) >= 0 And CInt(Br1) <= 255) Or Not (CInt(Br2) >= 0 And CInt(Br2) <= 255) Or Not (CInt(Br3) >= 0 And CInt(Br3) <= 255) Or Not (CInt(Br4) >= 0 And CInt(Br4) <= 255) Then ValidationIP = False : Exit Function ValidationIP = True Exit Function Catch ValidationIP = False End Try End Function #End Region Private Sub frmMain_Closing(ByVal sender As System.Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing tmrConnect.Enabled = False Dim sw As New StreamWriter("ipchat.ini", False) sw.WriteLine(txtNick.Text) sw.WriteLine(txtIP.Text) sw.Close() If Socket Is Nothing Then Else If Socket.Connected = True Then Request = ":connection:CLOSING" Dim ascii As Encoding = Encoding.ASCII Dim bytesSent As [Byte]() = ascii.GetBytes(Request) Try Socket.Send(bytesSent, bytesSent.Length, 0) Socket.Close() Catch Exit Sub End Try End If End If End Sub End Class
Merci
Très utile. Merci à toi.
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.