if me.invokerequired then me.invoke(... else '... end if
Private t As New Threading.Thread(AddressOf Listen)
t.Start()
'chargement de la fenêtre principale Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load WebBrowser1.DocumentText = _ " " AskIpLine: ip = InputBox("Choose the server IP:", "IP", "127.0.0.1") If Not isIp(ip) Then MsgBox("The text you typed isn't an ip!") GoTo AskIpLine End If AskNickLine: If Not cl_IsNickSet(ip) Then nick = InputBox("Choose a nickname for this server:", "Nickname", "") If nick = Nothing Then MsgBox("Please choose a nickname!") GoTo AskNickLine End If cl_AddNick(ip, nick) Else nick = cl_GetNick(ip) End If TextBox1.ContextMenuStrip = ContextMenuStrip1 Timer1.Start() End Sub
Imports System.Net.Sockets Imports System.IO Imports System Imports System.Collections Imports System.Globalization Public Class Form1 Private stream As NetworkStream Private streamw As StreamWriter Private streamr As StreamReader Private client As New TcpClient Private t As New Threading.Thread(AddressOf Listen) Private Delegate Sub DAddItem(ByVal s As String) Private nick As String = "unknown" Private ip As String Private Sub AddItem(ByVal s As String) WebBrowser1.DocumentText = WebBrowser1.DocumentText & s & " " End Sub 'Retourne un paramètre dans le fichier de config skin.ini Private Function cl_GetSkin(ByVal param As String) Dim result As String = "" Dim skinFile As String = My.Computer.FileSystem.ReadAllText(Application.StartupPath & "/skin.ini") For Each line As String In skinFile.Split(vbNewLine) If line.Contains(param) Then result = line.Split("=")(1) End If Next Return result End Function 'Retourne si le nickname est enregistre dans nicknames.ini Private Function cl_IsNickSet(ByVal strIp As String) Dim result As Boolean = False Dim skinFile As String = My.Computer.FileSystem.ReadAllText(Application.StartupPath & "/nicknames.ini") For Each line As String In skinFile.Split(vbNewLine) If line.Contains(strIp) Then result = True End If Next Return result End Function 'Retourne un nickname en fonction d'une ip en le sortant de nicknames.ini Private Function cl_GetNick(ByVal strIp As String) Dim result As String = "" Dim skinFile As String = My.Computer.FileSystem.ReadAllText(Application.StartupPath & "/nicknames.ini") For Each line As String In skinFile.Split(vbNewLine) If line.Contains(strIp) Then result = line.Split("=")(1) End If Next Return result End Function 'Ajoute un nickname au fichier nicknames.ini (remplace si le nick demandé existe déjà) Private Sub cl_AddNick(ByVal strIp As String, ByVal strNick As String) Dim lines() As String = File.ReadAllLines(Application.StartupPath & "\nicknames.ini") Dim writer As New StreamWriter(Application.StartupPath & "\nicknames.ini") For Each line As String In lines If Not line.Contains(strIp) Then writer.WriteLine(line) End If Next writer.Close() Dim objStreamWriter As New StreamWriter(Application.StartupPath & "\nicknames.ini", True) objStreamWriter.WriteLine(strIp & " = " & strNick) objStreamWriter.Close() End Sub 'Retourne True si en string donné à bien le format d'une IP Private Function isIp(ByVal str As String) Dim result As Boolean = False If str.Split(".").Length = 4 Then result = True For Each i As String In str.Split(".") If IsNumeric(i) Then If Not result = False Then result = True End If Else result = False End If Next End If Return result End Function Private Sub Form1_Shown(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Shown Try client.Connect(ip, 8888) If client.Connected Then stream = client.GetStream streamw = New StreamWriter(stream) streamr = New StreamReader(stream) streamw.WriteLine(nick) streamw.Flush() t.Start() If ip = "127.0.0.1" Then Else ContextMenuStrip1.Items.Remove(AdminToolStripMenuItem) End If Dim wlcMessage As String = cl_GetSkin("wlcMessage") wlcMessage = wlcMessage.Replace("%nick%", nick) wlcMessage = wlcMessage.Replace("%ip%", ip) WebBrowser1.DocumentText = WebBrowser1.DocumentText & wlcMessage & " " Else MessageBox.Show("The server isn't launched!") Application.Exit() End If Catch ex As Exception MessageBox.Show("Error: " & ex.Message) Application.Exit() End Try End Sub 'Envoyer un message au serveur Private Sub sendMsg(ByVal text As String) streamw.WriteLine(text) streamw.Flush() End Sub Private Sub sendChatFormatMsg(ByVal txt As String) sendMsg("NEW_MESSAGE::" & txt) End Sub 'Envoyer un message au serveur preformaté pour le chat (ex: User >> Bonjour!) Private Sub sendMsgTextbox() If Not TextBox1.Text = Nothing Then sendChatFormatMsg(TextBox1.Text) TextBox1.Clear() End If End Sub Private Sub EmitChatSound(ByVal sound As String) Dim ChatSound As New System.Media.SoundPlayer(Application.StartupPath & "/sounds/" & sound) ChatSound.Play() End Sub 'Envois le message quand on appuis sur entrer Private Sub Textbox1_KeyDown(sender As Object, e As System.Windows.Forms.KeyEventArgs) Handles TextBox1.KeyDown If e.KeyCode = Keys.Enter Then sendMsgTextbox() End If End Sub 'Envois le message quand on appuis sur le boutton Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click sendMsgTextbox() End Sub Private Sub Listen() While client.Connected Try Dim readLine As String = streamr.ReadLine Dim Msg As String = readLine.Replace(readLine.Split("::")(0) & "::", "") If readLine.Split("::")(0) = "NEW_MESSAGE" Then Me.Invoke(New DAddItem(AddressOf AddItem), Msg) If Me.WindowState = FormWindowState.Minimized Then EmitChatSound("new_msg.wav") End If ElseIf readLine.Split("::")(0) = "NEW_CONNECTION" Then Me.Invoke(New DAddItem(AddressOf AddItem), Msg & " is now connected.") ElseIf readLine.Split("::")(0) = "NEW_DISCONNECTION" Then Me.Invoke(New DAddItem(AddressOf AddItem), Msg & " is now disconnected.") End If Catch ex As Exception MessageBox.Show("Error: " & ex.Message) Application.Exit() End Try End While End Sub 'chargement de la fenêtre principale Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load WebBrowser1.DocumentText = _ " " AskIpLine: ip = InputBox("Choose the server IP:", "IP", "127.0.0.1") If Not isIp(ip) Then MsgBox("The text you typed isn't an ip!") GoTo AskIpLine End If AskNickLine: If Not cl_IsNickSet(ip) Then nick = InputBox("Choose a nickname for this server:", "Nickname", "") If nick = Nothing Then MsgBox("Please choose a nickname!") GoTo AskNickLine End If cl_AddNick(ip, nick) Else nick = cl_GetNick(ip) End If TextBox1.ContextMenuStrip = ContextMenuStrip1 Timer1.Start() End Sub '---------- Début Context Menu ---------- 'Insertion des styles d'écriture dans la textbox Private Sub BoldToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles BoldToolStripMenuItem.Click TextBox1.Text = TextBox1.Text & " " End Sub Private Sub HighlightedToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles HighlightedToolStripMenuItem.Click TextBox1.Text = TextBox1.Text & "<mark></mark>" End Sub Private Sub ItalicToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles ItalicToolStripMenuItem.Click TextBox1.Text = TextBox1.Text & "" End Sub 'Insertion d'élements (videos, audio...) dans le chat 'Audio Private Sub AudioToolStripMenuItem1_Click(sender As System.Object, e As System.EventArgs) Handles AudioToolStripMenuItem1.Click Dim dialog As New Object dialog = InputBox("Paste the audio URL here:", "Audio", "") If Not dialog = Nothing Then sendChatFormatMsg("[ " & dialog2 & "]" End If End Sub 'Private Sub ColorToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles ColorToolStripMenuItem.Click 'Dim textcolor As String ' If ColorDialog1.ShowDialog() = DialogResult.OK Then ' textColor = System.Drawing.ColorTranslator.ToHtml(ColorDialog1.Color) ' End If 'End Sub 'Private Sub FontToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles FontToolStripMenuItem.Click 'Dim textfont As String ' If FontDialog1.ShowDialog() = DialogResult.OK Then ' textfont = FontDialog1.Font.Name ' End If 'End Sub 'Ouvrir le fichier de config skin.ini Private Sub EditChatSkinToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles EditChatSkinToolStripMenuItem.Click Dim proc As New Process proc.StartInfo.FileName = Application.StartupPath & "\skin.ini" proc.Start() End Sub 'Changer son nickname Private Sub NicknameToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles NicknameToolStripMenuItem.Click Dim OldNick As String = nick Dim dialog As New Object dialog = InputBox("Choose a nickname for this server:", "Nickname", nick) If Not dialog = Nothing Then nick = dialog cl_AddNick(ip, dialog) sendMsg(OldNick & " changed his nickname to " & nick & ".") End If OldNick = Nothing End Sub 'Envoyer un message en tant qu'administrateur Private Sub MessageAsAdminToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles MessageAsAdminToolStripMenuItem.Click Dim dialog As String dialog = InputBox("Write your message here:", "Message As Admin", "") If Not dialog = Nothing Then sendMsg("[ADMIN] >> " & dialog & "") End If End Sub Private Sub CleanNicknamesToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles CleanNicknamesToolStripMenuItem.Click Try Dim Reponse As MsgBoxResult Reponse = MsgBox("All saved nicknames are going to be removed, are you sure that you want to clear the nicknames?", vbEmpty Or vbYesNo) If Reponse = vbYes Then Dim objStreamWriter As New StreamWriter(Application.StartupPath & "\nicknames.ini") objStreamWriter.WriteLine("- Nicknames -") objStreamWriter.WriteLine(ip & " = " & nick) objStreamWriter.Close() MsgBox("Nicknames succesfully cleaned!") End If Catch ex As Exception MsgBox(" Error: " & ex.Message) End Try End Sub '---------- Fin Context Menu ---------- 'Afficher le context menu quand on appuis sur le bouton Private Sub Button4_Click(sender As System.Object, e As System.EventArgs) Handles Button4.Click ContextMenuStrip1.Show(MousePosition) End Sub Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick TimeToolStripMenuItem.Text = CultureInfo.CurrentCulture.ToString & " | " & Format(Now, "hh:mm:ss") End Sub End Class
AskIpLine: ip = InputBox("Choose the server IP:", "IP", "127.0.0.1") If Not isIp(ip) Then MsgBox("The text you typed isn't an ip!") GoTo AskIpLine End If
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionPrivate Sub Listen() While client.Connected Try Dim readLine As String = streamr.ReadLine Dim Msg As String = readLine.Replace(readLine.Split("::")(0) & "::", "") If readLine.Split("::")(0) = "NEW_MESSAGE" Then If Me.InvokeRequired Then Me.Invoke(New DAddItem(AddressOf AddItem), Msg) Else AddItem(Msg) End If If Me.WindowState = FormWindowState.Minimized Then EmitChatSound("new_msg.wav") End If ElseIf readLine.Split("::")(0) = "NEW_CONNECTION" Then If Me.InvokeRequired Then Me.Invoke(New DAddItem(AddressOf AddItem), Msg & " is now connected.") Else AddItem(Msg & " is now connected.") End If ElseIf readLine.Split("::")(0) = "NEW_DISCONNECTION" Then If Me.InvokeRequired Then Me.Invoke(New DAddItem(AddressOf AddItem), Msg & " is now disconnected.") Else AddItem(Msg & " is now disconnected.") End If End If Catch ex As Exception MessageBox.Show("Error: " & ex.Message) Application.Exit() End Try End While End Sub