Chatirc 8 - un client irc

Soyez le premier à donner votre avis sur cette source.

Vue 11 009 fois - Téléchargée 1 378 fois

Description

Ce projet est pour la version 2010 de Visual Basic.
Il n'utilise plus le composant Winsock.
C'est un client assez simple pour le chat sur l'IRC
Ce programme a toutefois le problème de la limitation
du Webbrowser qui ne peut pas accepter de texte à l'infini.

Source / Exemple :


Imports System.IO
Imports System.Net.Sockets
Imports System.Text

Public Class Form1
    Public police As String = "Comic sans MS"
    Public tpolice As String = "1"
    Public nn As String = "CHATIRCnr"
    Public taille As Integer = 3
    Public phetr(2, 25)
    Public nb As Integer
    Public nick As String = ""
    Dim data As String = ""
    Public codes As String = ""
    Dim topic, etopic As String
    Dim couper() As String
    Dim qui As String = ""
    Dim lPV As Boolean = False
    Dim personne As String = ""
    Public soleil As String
    Public ambiance As Color = Color.GreenYellow
    Dim emplacement As Integer
    Dim message As String = ""
    Dim estsalon As Boolean = False
    Public str As String
    Public qr() As String
    Dim verifquizz As String
    Public règlement As String
    Dim buf(1024) As Byte
    Public wsocket As New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.IP)
    Public WithEvents wwwsocket As New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.IP)
    Dim bytes(1024) As Byte
    Dim bytesRec As Integer = 0
    Dim oqp As Boolean = False
    Dim temp As String = ""
    Public myASV As String

    Private Sub Form1_HandleDestroyed(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.HandleDestroyed

    End Sub
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        If File.Exists(My.Computer.FileSystem.CurrentDirectory & "\Data\robot.ini") Then
            FileEdit.Button1_Click(Me, Nothing)
        End If

        str = File.ReadAllText(My.Computer.FileSystem.CurrentDirectory & "\Data\quizz.txt")
        qr = Split(str, vbCrLf)
        Randomize()
        If My.Computer.FileSystem.FileExists(My.Computer.FileSystem.CurrentDirectory & "\Data\theme.ini") Then
            Dim s() As String = Split(System.IO.File.ReadAllText(My.Computer.FileSystem.CurrentDirectory & "\Data\theme.ini"), vbCrLf)
            ambiance = Color.FromArgb(255, s(0), s(1), s(2))
        Else
            ambiance = Color.FromArgb(255, Rnd() * 255, Rnd() * 255, Rnd() * 255)
        End If
        Bcolor()
        If File.Exists(My.Computer.FileSystem.CurrentDirectory & "\Data\arcenciel.ini") Then
            Dim s() As String = Split(File.ReadAllText(My.Computer.FileSystem.CurrentDirectory & "\Data\arcenciel.ini"), vbCrLf)
            Arcenciel.noir.Checked = s(0)
            Arcenciel.gris.Checked = s(1)
            Arcenciel.grisf.Checked = s(2)
            Arcenciel.violet.Checked = s(3)
            Arcenciel.rose.Checked = s(4)
            Arcenciel.bleuf.Checked = s(5)
            Arcenciel.bleuj.Checked = s(6)
            Arcenciel.blanc.Checked = s(7)
            Arcenciel.bleutf.Checked = s(8)
            Arcenciel.bleut.Checked = s(9)
            Arcenciel.vertf.Checked = s(10)
            Arcenciel.vertc.Checked = s(11)
            Arcenciel.marron.Checked = s(12)
            Arcenciel.jaune.Checked = s(13)
            Arcenciel.rougef.Checked = s(14)
            Arcenciel.rougec.Checked = s(15)
            Arcenciel.gras.Checked = s(16)
            Arcenciel.OK.Checked = s(17)
        End If
        If File.Exists(My.Computer.FileSystem.CurrentDirectory & "\Data\config.ini") Then

            File.SetAttributes(My.Computer.FileSystem.CurrentDirectory & "\Data\config.ini", FileAttributes.Normal)
            Dim s As String = File.ReadAllText(My.Computer.FileSystem.CurrentDirectory & "\Data\config.ini")

            If s <> "" And s.Length = 14 Then
                If s(1) = s(13) Then
                    If Val(s(7)) * Val(s(8)) = Val(s.Substring(10, 2)) Then
                        File.SetAttributes(My.Computer.FileSystem.CurrentDirectory & "\Data\config.ini", FileAttributes.Hidden)
                        nn = "ChatIRC-7"
                        Exit Sub
                    End If
                End If
            End If

        Else
            Activation.ShowDialog()
        End If

    End Sub
    Function heure() As String
        Dim r As String = ""
        If Now.Hour.ToString.Length = 1 Then
            r &= "0" & Now.Hour
        Else
            r &= Now.Hour
        End If
        r &= ":"
        If Now.Minute.ToString.Length = 1 Then
            r &= "0" & Now.Minute
        Else
            r &= Now.Minute
        End If
        r &= ":"
        If Now.Second.ToString.Length = 1 Then
            r &= "0" & Now.Second
        Else
            r &= Now.Second
        End If
        Return r
    End Function
    Function vsalon(ByVal s As String)
        If s = "" Then Return "Aucun salon à afficher"
        Dim l As String() = Split(s, " ")
        Dim r As String = ""
        For i = 0 To l.Length - 1
            r &= l(i) & ","
        Next
        Return r.Substring(0, s.Length - 1)
    End Function
    Public Function Magie(ByVal fut As String) As String
        fut = Replace(fut, ">", ">")
        fut = Replace(fut, "<", "<")
        fut = Replace(fut, ":(", "<img src='" & My.Computer.FileSystem.CurrentDirectory & "\Smileys\icon_sad.gif' >") '
        fut = Replace(fut, ";)", "<img src='" & My.Computer.FileSystem.CurrentDirectory & "\Smileys\icon_wink.gif' >") '
        fut = Replace(fut, ":)", "<img src='" & My.Computer.FileSystem.CurrentDirectory & "\Smileys\icon_smile.gif' >") '
        fut = Replace(fut, "(a)", "<img src='" & My.Computer.FileSystem.CurrentDirectory & "\Smileys\ange.png' >") '
        fut = Replace(fut, "8)", "<img src='" & My.Computer.FileSystem.CurrentDirectory & "\Smileys\icon_cool.gif' >")
        fut = Replace(fut, ":?", "<img src='" & My.Computer.FileSystem.CurrentDirectory & "\Smileys\blink.gif' >") '
        fut = Replace(fut, ":'(", "<img src='" & My.Computer.FileSystem.CurrentDirectory & "\Smileys\icon_cry.gif' >") '
        fut = Replace(fut, ":sucre:", "<img src='" & My.Computer.FileSystem.CurrentDirectory & "\Smileys\icon_sucreblanc.gif' >") '
        fut = Replace(fut, ":love:", "<img src='" & My.Computer.FileSystem.CurrentDirectory & "\Smileys\icon_love.gif' >") '
        fut = Replace(fut, ":café:", "<img src='" & My.Computer.FileSystem.CurrentDirectory & "\Smileys\icon_tasse.gif' >") '
        fut = Replace(fut, ":mail:", "<img src='" & My.Computer.FileSystem.CurrentDirectory & "\Smileys\icon_mail.gif' >") '
        fut = Replace(fut, ":@", "<img src='" & My.Computer.FileSystem.CurrentDirectory & "\Smileys\angry.gif' >") '
        fut = Replace(fut, "(i)", "<img src='" & My.Computer.FileSystem.CurrentDirectory & "\Smileys\icon_idea.gif' >") '
        fut = Replace(fut, ":mage:", "<img src='" & My.Computer.FileSystem.CurrentDirectory & "\Smileys\magicien.png' >") '
        fut = Replace(fut, ":evil:", "<img src='" & My.Computer.FileSystem.CurrentDirectory & "\Smileys\diable.png' >") '
        fut = Replace(fut, ":p", "<img src='" & My.Computer.FileSystem.CurrentDirectory & "\Smileys\icon_razz.gif' >") '
        fut = Replace(fut, ":-°", "<img src='" & My.Computer.FileSystem.CurrentDirectory & "\Smileys\siffle.png' >") '
        fut = Replace(fut, ":D", "<img src='" & My.Computer.FileSystem.CurrentDirectory & "\Smileys\heureux.png' >") '
        fut = Replace(fut, ":_baleine_:", "<img src='" & My.Computer.FileSystem.CurrentDirectory & "\Smileys\baleine.gif' >") '
        fut = Replace(fut, ":X:", "<img src='" & My.Computer.FileSystem.CurrentDirectory & "\Smileys\icon_fight.gif' >") '
        If fut.Contains(Chr(3)) Then
            fut = Arcenciel.Tohtml(fut)
        End If
        Return "<b>" & fut & "</b>"
    End Function

    Public q As Boolean

    Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        On Error Resume Next
        e.Cancel = True
        Me.WindowState = FormWindowState.Minimized
        q = True

    End Sub
    Public Sub Bcolor()
        Dim bc As New Bitmap(1, 1)
        bc.SetPixel(0, 0, Color.FromArgb(ambiance.R, ambiance.G, ambiance.B))
        Me.BackgroundImage = bc
        Const force As Integer = 48
        If ambiance.R >= force Then
            soleil = Hex(ambiance.R - force)
        Else
            soleil = Hex(ambiance.R)
        End If
        If ambiance.G >= force Then
            soleil &= Hex(ambiance.G - force)
        Else
            soleil &= Hex(ambiance.G)
        End If
        If ambiance.B >= force Then
            soleil &= Hex(ambiance.B - force)
        Else
            soleil &= Hex(ambiance.B)
        End If
        Me.BackColor = ambiance
        MenuStrip1.BackColor = ambiance
        ToolStrip1.BackColor = ambiance
    End Sub
    Private Sub CouleurDeFondToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CouleurDeFondToolStripMenuItem.Click
        cdf.ShowDialog()
    End Sub
    Private Sub JoindreUnSalonToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles JoindreUnSalonToolStripMenuItem.Click
        Dim ib As String = InputBox("Entrez le ou les salons à rejoindre, avec # devant et séparés par une virgule (ex : #ChatIRC,#Aide ) : ", "ChatIRC 6", "#")
        If ib <> "" Then
            send("JOIN " & ib & vbCr)
        End If
    End Sub
    Private Sub ListeDesSmileysToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListeDesSmileysToolStripMenuItem.Click
        Smileys.Show()
    End Sub
    Private Sub ParlerEnPrivéAvecUnUtilisateurToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ParlerEnPrivéAvecUnUtilisateurToolStripMenuItem.Click
        Dim ib As String = InputBox("Entrez le pseudonyme de la personne avec laquelle vous voulez chatter : ", "ChatIRC 6")
        If ib <> "" Then
            For Each ff In Me.MdiChildren
                If ff.Name = ib Then
                    lPV = True
                    ff.Focus()
                    Exit Sub
                End If
            Next
            Dim NewMDIChild As New Salons
            NewMDIChild.MdiParent = Me
            With NewMDIChild
                .Name = ib
                .Text = ib ''''
                .ListBox1.Visible = False
                .WebBrowser1.Size = New Point(729, 401)
                .TextBox1.MaxLength = 436
            End With
            NewMDIChild.WebBrowser1.DocumentText = "<html>< head >"
            NewMDIChild.WebBrowser1.Document.Write("<font size='" & tpolice & "' face='" & police & "'><p>")
            NewMDIChild.Show()
            ToolStripLabel1.Text &= " " & ib & " "
            Navigo.ListBox1.Items.Add(ib)
        End If
    End Sub
    Private Sub ModeRobotEtSonsToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ModeRobotEtSonsToolStripMenuItem.Click
        Options.ShowDialog()
    End Sub
    Private Sub NoFlood_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NoFlood.Tick
        Dim ff As Salons
        For Each ff In Me.MdiChildren
            ff.Button1.Enabled = True
        Next
        NoFlood.Enabled = False
    End Sub
    Private Sub AfficherLeRèglementDuServeurToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles AfficherLeRèglementDuServeurToolStripMenuItem.Click
        Rules.Show()
    End Sub
    Private Sub ChangerDePseudonymeToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ChangerDePseudonymeToolStripMenuItem.Click
        Dim ib As String = InputBox("Entrez votre nouveau pseudonyme :")
        If ib <> "" Then
            send("NICK " & ib & vbCr)
        End If
    End Sub
    Private Sub BackgroundWorker1_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
ecoute: If BackgroundWorker1.CancellationPending Then Exit Sub
        If wsocket.Connected Then
            Try
                bytesRec = wsocket.Receive(bytes)
            Catch ex As Exception
                Exit Sub
            End Try
            If bytesRec > 0 Then
                oqp = True
                BackgroundWorker1.ReportProgress(99)
oqqp:           If oqp Then GoTo oqqp
            End If
        End If
        GoTo ecoute
    End Sub
    Private Sub BackgroundWorker1_ProgressChanged(ByVal sender As Object, ByVal e As System.ComponentModel.ProgressChangedEventArgs) Handles BackgroundWorker1.ProgressChanged
        Dim data As String = System.Text.Encoding.Default.GetString(bytes, 0, bytesRec)
        For i = 0 To Len(data) - 1
            If data(i) = Chr(13) Then
                Reception(temp)
                temp = ""
                i += 1
            Else
                temp &= data(i)
            End If
        Next
        bytesRec = 0
        oqp = False
    End Sub
    Public Sub send(ByVal datas As String)
        Dim Message As [Byte]() = System.Text.Encoding.Default.GetBytes(datas)
        If wsocket.Connected Then wsocket.Send(Message)
    End Sub
    Private Sub EntrerSonMotDePasseToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles EntrerSonMotDePasseToolStripMenuItem.Click
        IBPass.ShowDialog()
    End Sub
    Private Sub DemanderDesRensignementsSurUnUtilisateurToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DemanderDesRensignementsSurUnUtilisateurToolStripMenuItem.Click
        Dim ib As String = InputBox("Entrez le pseudonyme pour en obtenir des informations, elles seront affichée dans la fenêtre du serveur :")
        If ib <> "" Then
            send("WHOIS " & ib & vbCr)
        End If
    End Sub
    Private Sub Form1_Layout(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LayoutEventArgs) Handles MyBase.Layout
        If e.AffectedControl.ToString.Contains("ClientIRC.Form1") Then
            On Error Resume Next
            Dim ff As Salons
            For Each ff In Me.MdiChildren
                ff.WebBrowser1.Document.Body.ScrollTop += 999999999
            Next
        End If
    End Sub
    Private Sub NotifyIcon1_MouseDoubleClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles NotifyIcon1.MouseDoubleClick
        Me.WindowState = FormWindowState.Normal
        q = False

    End Sub
    Private Sub ConnexionToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ConnexionToolStripMenuItem.Click
        Connexion.ShowDialog()
    End Sub
    Private Sub QuitterToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles QuitterToolStripMenuItem.Click
        NotifyIcon1.Visible = False
        If wsocket.Connected Then
            If ToolStripLabel1.Text <> "" Then
                If MessageBox.Show("Vous êtes actuellement connecté." & vbCrLf & "Souhaitez-vous vous déconnecter" & vbCrLf & "et fermer les fenêtres :" & vbCrLf & ToolStripLabel1.Text & vbCrLf & "et quitter définitivement ?", "ChatIRC 6", MessageBoxButtons.YesNo, MessageBoxIcon.Question) = Windows.Forms.DialogResult.Yes Then
                    Form1_FormClosing(Me, Nothing) : End
                End If
            Else
                If MessageBox.Show("Vous êtes actuellement connecté." & vbCrLf & "Souhaitez-vous vous déconnecter" & vbCrLf & "et quitter définitivement ?", "ChatIRC 6", MessageBoxButtons.YesNo, MessageBoxIcon.Question) = Windows.Forms.DialogResult.Yes Then
                    Form1_FormClosing(Me, Nothing) : End
                End If
            End If
        Else
            End
        End If
    End Sub
    Private Sub RéorganiserLesFenêtresToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RéorganiserLesFenêtresToolStripMenuItem.Click
        Dim ff As Salons
        For Each ff In Me.MdiChildren
            ff.WindowState = FormWindowState.Normal
        Next
        Me.LayoutMdi(System.Windows.Forms.MdiLayout.Cascade)
    End Sub
    Private Sub ToolStrip1_DoubleClick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStrip1.DoubleClick
        Dim ff As Salons
        For Each ff In Me.MdiChildren
            ff.WindowState = FormWindowState.Normal
        Next
        Me.LayoutMdi(System.Windows.Forms.MdiLayout.Cascade)
    End Sub
    Private Sub AfficherLaFenêtreDuServeurToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles AfficherLaFenêtreDuServeurToolStripMenuItem.Click
        For Each ff In Me.MdiChildren
            If ff.Name = Connexion.Serveur.Text Then
                ff.Show()
                ff.Focus()
            End If
        Next
    End Sub
    Private Sub AProposDeChatIRCToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles AProposDeChatIRCToolStripMenuItem1.Click
        MessageBox.Show("ChatIRC" & vbCrLf & vbCrLf & "Client pour l'IRC simple d'utilisation." & vbCrLf & vbCrLf & "Orienté robot d'animation." & vbCrLf & vbCrLf & "Auteur : raffika" & vbCrLf & "Site Web : www.ramon.evoserv.net" & vbCrLf & "Réalisé avec Visual Basic 2010 Express", "ChatIRC 6", MessageBoxButtons.OK, MessageBoxIcon.Information)
    End Sub
    Private Sub EnregistrementDuProfilToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles EnregistrementDuProfilToolStripMenuItem1.Click
        MessageBox.Show("Enregistement du profil" & vbCrLf & vbCrLf & "Si vous souhaitez enregistrer vos" & vbCrLf & "information (Pseudo,Mot de passe etc.)" & vbCrLf & "vous pouvez le faire en cliquant avec le bouton" & vbCrLf & "droit de la souris dans la fenêtre de connexion." & vbCrLf & "Ensuite cliquez sur 'Enregistrer le profil'." & vbCrLf & vbCrLf & "Si votre profil contient un mot de passe, il sera crypté avant d'être enregistré afin de mieux respecter votre confidentialité." & vbCrLf, "ChatIRC - Aide", MessageBoxButtons.OK, MessageBoxIcon.Information)
    End Sub
    Private Sub ModeRobotToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ModeRobotToolStripMenuItem.Click
        MessageBox.Show("Mode robot" & vbCrLf & vbCrLf & "Editez le fichier comme ceci :" & vbCrLf & vbCrLf & "phrase_prononcée##réponse_à_envoyer" & vbCrLf & vbCrLf & "Donc la phrase prononcée et la réponse séparés de deux diez ##" & vbCrLf & "Sans espaces entre les ## et le texte." & vbCrLf & vbCrLf & "Vous pouvez créer plusieurs lignes à la suite des autres." & vbCrLf & vbCrLf & "Ensuite cliquez sur " & Chr(34) & "Enregistrer" & Chr(34) & " pour enregistrer le fichier." & vbCrLf & "Ensuite cliquez sur le bouton de mise à jour pour charger les nouvelles phrases" & vbCrLf & vbCrLf & "Et vous pouvez fermer la fenêtre avec le bouton " & Chr(34) & "Fermer la fenêtre" & Chr(34) & vbCrLf & vbCrLf & "Attention à ne pas inclure une partie de la question dans la réponse sous peine d'entrer en conflit avec un autre robot", "ChatIRC - Aide", MessageBoxButtons.OK, MessageBoxIcon.Information)
    End Sub
    Private Sub MinimiserToutesLesFenêtresToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MinimiserToutesLesFenêtresToolStripMenuItem.Click
        Dim f As Salons
        For Each f In Me.MdiChildren
            f.WindowState = FormWindowState.Minimized
        Next
    End Sub
    Private Sub AccéderRapidementÀUneFenêtreToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles AccéderRapidementÀUneFenêtreToolStripMenuItem.Click
        Navigo.Show()
    End Sub
    Private Sub ArcToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ArcToolStripMenuItem.Click
        Arcenciel.Show()
    End Sub
    Sub Reception(ByVal donnees As String)
        Try
            Dim mots() As String ''Coupe la ligne en mots
            mots = Split(donnees, " ") ''Coupe la ligne en mots
            If codes = "" Then
                codes = mots(0)
            End If
            Dim ff As Salons
            For Each ff In Me.MdiChildren
                If ff.Name = Connexion.Serveur.Text Then
                    ff.WebBrowser1.Document.Write("<" & heure() & "> " & donnees & "<br>")
                    ff.WebBrowser1.Document.Body.ScrollTop += 999999999
                End If
            Next
            Select Case mots(0)
                Case "PING"
                    send("PONG " & mots(1) & vbCr)
                    For Each ff In Me.MdiChildren
                        If ff.Name = Connexion.Serveur.Text Then
                            ff.WebBrowser1.Document.Write("PONG " & mots(1) & "<br>")
                            ff.WebBrowser1.Document.Body.ScrollTop += 999999999
                        End If
                    Next
                Case codes
                    Select Case mots(1)

                        Case "001"
                            send("JOIN " & Connexion.Salonàr.Text & vbCr)
                            If Connexion.tbpassword.Text <> "" Then send("NICKSERV IDENTIFY " & Connexion.tbpassword.Text & vbCr)
                        Case "311"
                            Dim s As String = donnees.Substring(1)
                            s = s.Substring(InStr(s, ":"))
                            Whois.Text = "ChatIRC 6 - Demande d'informations sur '" & mots(3) & "'"
                            Whois.asv.Text = "ASV : " & s
                            Whois.Show()
                            If Not Whois.Focused Then
                                Whois.Focus()
                            End If
                        Case "319"
                            ':irc.Super-Tchat.fr.ht 319 raffikaa raffika2 :@#test #Accueil 
                            Dim s As String = donnees.Substring(1)
                            'irc.Super-Tchat.fr.ht 319 raffikaa raffika2 :@#test #Accueil 

                            s = s.Substring(InStr(s, ":"))
                            s = vsalon(s)

                            'Dim temp As String = vsalon(s)
                            's = temp

                            's = vsalon(s)

                            Whois.save = s
                            Whois.RichTextBox1.Text = s

                            Whois.Label1.Text = "Informations sur : " & mots(3)
                            Whois.Show()
                            If Not Whois.Focused Then
                                Whois.Focus()
                            End If

                        Case "332" '' Sujet du salon

                            etopic = Len(mots(0)) + Len(mots(1)) + Len(mots(2)) + Len(mots(3)) + 2 + 4
                            topic = donnees.Substring(etopic - 1)

                            'topic = Mid(donnees, etopic, Len(donnees) - etopic)

                            For Each ff In Me.MdiChildren

                                If ff.Name = mots(3) Then

                                    ff.WebBrowser1.Document.Write("<font color='" & soleil & "'>Le sujet du salon est : <font color='000000'>" & Arcenciel.Tohtml(topic) & "</font></font><BR>")
                                    ff.WebBrowser1.Document.Body.ScrollTop += 999999999

                                End If

                            Next

                        Case "353" '' Liste des gens

                            For Each ff In Me.MdiChildren

                                If ff.Name = mots(4) Then

                                    ff.ListBox1.Items.Clear()

                                    For i = 5 To mots.Count - 2 ''Lit les nom uns par uns
                                        personne = mots(i)

                                        'If personne(0) = ":" Then personne = Mid(personne, 2, Len(personne) - 1)
                                        If personne(0) = ":" Then personne = personne.Substring(1)

                                        Select Case personne(0)
                                            Case "+", "@", "%", "&", "~"

                                                'personne = Mid(personne, 2, Len(personne) - 1)
                                                personne = personne.Substring(1)

                                        End Select

                                        ff.ListBox1.Items.Add(personne) ''Le nom est ajouté

                                    Next
                                End If

                            Next

                        Case "372" '' Règlement

                            règlement &= donnees.Substring(mots(0).Length + 1 + 3 + 1 + mots(2).Length + 3 - 1) & Environment.NewLine

                            ':irc.dialect.com 372 leno :- BON CHAT :)

                        Case "401"

                            If UCase(mots(4)) = ":NO" Then
                                For Each ff In Me.MdiChildren
                                    If ff.Name = mots(3) Then
                                        ff.WebBrowser1.Document.Write("<font color='" & soleil & "'>" & mots(3) & " n'est pas ou plus connecté(e) au Chat<BR>")
                                        ff.WebBrowser1.Document.Body.ScrollTop += 999999999
                                    End If
                                Next
                            End If

                        Case "421" '' Erreur du serveur

                            MessageBox.Show(donnees)

                        Case "433"

                    End Select

                Case Else

                    Select Case mots(1)
                        Case "TOPIC"

                            etopic = Len(mots(0)) + 1 + Len(mots(1)) + 1 + Len(mots(2)) + 3

                            'topic = Mid(donnees, etopic, Len(donnees) - etopic + 1)
                            topic = donnees.Substring(etopic - 1)

                            For Each ff In Me.MdiChildren

                                If UCase(ff.Name) = UCase(mots(2)) Then

                                    ff.WebBrowser1.Document.Write("<font color='" & soleil & "'>Le topic du salon est : " & Magie(topic) & "</font><BR>")

                                    ff.WebBrowser1.Document.Body.ScrollTop += 999999999

                                End If

                            Next

                        Case "PRIVMSG"

                            couper = Split(mots(0), "!")

                            qui = couper(0).Substring(1)

                            emplacement = Len(mots(0)) + 9 + Len(mots(2)) + 3 ''Pour obtenir le

                            message = donnees.Substring(emplacement - 1)

                            Dim reveil As Boolean = False

                            If message.Contains(nick & " " & nick) And Options.CheckBox5.Checked Then
                                My.Computer.Audio.Play(My.Computer.FileSystem.CurrentDirectory & "\Sons\REVEIL.wav")
                                reveil = True
                            End If

                            message = Magie(message)

                            'message = Replace(message, nick, "" & nick & "")

                            Select Case mots(2).Substring(0, 1)

                                Case "#" '' Message salon

                                    For Each ff In Me.MdiChildren

                                        If UCase(ff.Name) = UCase(mots(2)) Then

                                            '' ici réponse au quizz si posee = true

                                            ff.WebBrowser1.Document.Write(ff.Modos(qui) & ">" & message & "<br>")

                                            If Options.bot.Checked Then

                                                Dim bot As String

                                                For i = 0 To nb

                                                    bot = donnees.Substring(emplacement - 1)

                                                    If UCase(bot).Contains(UCase(phetr(0, i))) Then

                                                        Dim enforme As String = phetr(1, i)
                                                        enforme = Replace(enforme, "$nick", qui)

                                                        enforme = Replace(enforme, "$time", Now.ToString)
                                                        enforme = Replace(enforme, "$chan", mots(2))

                                                        send("PRIVMSG " & UCase(mots(2)) & " :" & enforme & vbCr)

                                                        ff.WebBrowser1.Document.Write("" & Salons.Modos(nick) & ">" & qui & "> " & enforme & "<br>")

                                                        ff.WebBrowser1.Document.Body.ScrollTop += 999999999

                                                        Exit For
                                                    End If
                                                Next

                                            End If

                                            ff.WebBrowser1.Document.Body.ScrollTop += 999999999

                                            If ff.posee Then
                                                'AndAlso UCase(donnees.Substring(emplacement - 1)).Contains(UCase(ff.lar)) Then
                                                verifquizz = donnees.Substring(emplacement - 1)

                                                If Trim(UCase(verifquizz)).Contains(Trim(UCase(ff.lar))) Then
                                                    send("PRIVMSG " & UCase(mots(2)) & " :" & qui & ">Bravo !! La réponse est bien : " & Trim(ff.lar) & " !!" & vbCr)
                                                    ff.WebBrowser1.Document.Write("" & Salons.Modos(nick) & ">" & qui & ">Bravo !! La réponse est bien : " & Trim(ff.lar) & " !!<br>")
                                                    ff.WebBrowser1.Document.Body.ScrollTop += 999999999
                                                    ff.posee = False
                                                End If

                                            End If

                                        End If
                                    Next
                                Case Else '' Message PV

                                    lPV = False

                                    If Options.CheckBox1.Checked And Not reveil Then '' Jouer son au PV
                                        My.Computer.Audio.Play(My.Computer.FileSystem.CurrentDirectory & "\Sons\PV.wav")
                                    End If

                                    For Each ff In Me.MdiChildren
                                        If UCase(ff.Name) = UCase(qui) Then '' Fenetre PV déjà ouverte

                                            ff.WebBrowser1.Document.Write(ff.Modos(qui) & ">" & message & "<br>")

                                            ff.WebBrowser1.Document.Body.ScrollTop += 999999999

                                            lPV = True '' 

                                            If ff.posee Then

                                                verifquizz = donnees.Substring(emplacement - 1)

                                                If Trim(UCase(verifquizz)).Contains(Trim(UCase(ff.lar))) Then

                                                    send("PRIVMSG " & UCase(qui) & " :Bravo !! La réponse est bien : " & Trim(ff.lar) & " !!" & vbCr)

                                                    ff.WebBrowser1.Document.Write(ff.Modos(qui) & ">Bravo !! La réponse est bien : " & Trim(ff.lar) & " !!<br>")
                                                    ff.WebBrowser1.Document.Body.ScrollTop += 999999999
                                                    ff.posee = False

                                                End If

                                            End If

                                        End If

                                    Next

                                    If Not lPV Then

                                        Dim fs As New Salons

                                        With fs
                                            .MdiParent = Me
                                            .Name = qui
                                            .Text = qui
                                            .WebBrowser1.DocumentText = "<html>< head >"
                                            .WebBrowser1.Document.Write("<font size='" & tpolice & "' face='" & police & "'><p>")
                                            .ListBox1.Visible = False '729; 401 sans ListBox
                                            .WebBrowser1.Size = New Point(729, 401)
                                            .WebBrowser1.Document.Write(fs.Modos(qui) & ">" & message & "<br>")
                                            .WebBrowser1.Document.Body.ScrollTop += 999999999
                                            .TextBox1.MaxLength = 436
                                        End With

                                        If Options.CheckBox3.Checked Then '' Répondeur
                                            send("PRIVMSG " & qui & " :" & Replace(Options.TextBox1.Text, "$nick", qui) & vbCr)
                                            fs.WebBrowser1.Document.Write("" & fs.Modos(nick) & ">" & Replace(Options.TextBox1.Text, "$nick", qui) & "<br>")
                                            fs.WindowState = FormWindowState.Minimized
                                        End If

                                        ToolStripLabel1.Text &= " " & qui & " "
                                        Navigo.ListBox1.Items.Add(qui)

                                        fs.Show()

                                    End If

                            End Select

                        Case "JOIN"

                            couper = Split(mots(0), "!")

                            qui = couper(0).Substring(1)

                            If qui = nick Then '' Je rejoins le salon mots(2)

                                If Not ToolStripLabel1.Text.Contains(" " & mots(2) & " ") Then
                                    If mots(2).Substring(0, 1) = ":" Then
                                        ToolStripLabel1.Text &= " " & mots(2).Substring(1) & " "
                                        Navigo.ListBox1.Items.Add(mots(2).Substring(1))
                                    Else
                                        ToolStripLabel1.Text &= " " & mots(2) & " "
                                        Navigo.ListBox1.Items.Add(mots(2))
                                    End If
                                End If

                                lPV = False

                                For Each ff In Me.MdiChildren

                                    If ff.Name = mots(2).Substring(1) Then
                                        lPV = True
                                    End If

                                Next

                                If Not lPV Then
                                    Dim fs As New Salons
                                    With fs
                                        .MdiParent = Me
                                        .Name = mots(2).Substring(1)
                                        .Text = mots(2).Substring(1) ''''s
                                        .BackColor = ambiance
                                        .WebBrowser1.DocumentText = "<html>< head >"
                                        .WebBrowser1.Document.Write("<font size='" & tpolice & "' face='" & police & "'><p>")
                                        .WebBrowser1.Document.Write("<font color='" & soleil & "'>" & "" & "Vous venez de rejoindre le salon " & mots(2).Substring(1) & "</font><br>")
                                        .TextBox1.MaxLength = 396
                                    End With
                                    '''''''''
                                    '''''''''
                                    fs.Show()

                                End If
                                ''''''''''''
                                ''''''''''''

                            Else '' Quelqu'un d'autre que moi rejoint le salon mots(2)

                                For Each ff In Me.MdiChildren

                                    'If ff.Name = Mid(mots(2), 2, mots(2).Length - 1) Then
                                    If ff.Name = mots(2).Substring(1) Then

                                        ff.ListBox1.Items.Add(qui)

                                        ff.WebBrowser1.Document.Write("<font color='" & soleil & "'>" & "" & qui & " vient de rejoindre le salon." & "</font><Br>")

                                        ff.WebBrowser1.Document.Body.ScrollTop += 999999999

                                        If Options.CheckBox4.Checked Then

                                            Dim welcome As String = Options.TextBox2.Text
                                            welcome = Replace(welcome, "$nick", qui)
                                            welcome = Replace(welcome, "$chan", mots(2).Substring(1))

                                            send("PRIVMSG " & mots(2).Substring(1) & " :" & welcome & vbCr)

                                            ff.WebBrowser1.Document.Write("" & ff.Modos(nick) & ">" & welcome & "<br>")

                                        End If

                                    End If

                                Next

                            End If

                            If Options.CheckBox2.Checked Then
                                My.Computer.Audio.Play(My.Computer.FileSystem.CurrentDirectory & "\Sons\JOIN.wav")
                            End If

                        Case "PART"

                            couper = Split(mots(0), "!")
                            'qui = Mid(couper(0), 2, Len(couper(0)) - 1) '' qui
                            qui = couper(0).Substring(1) ' qui

                            For Each ff In Me.MdiChildren

                                If ff.Name = mots(2) Then

                                    ff.ListBox1.Items.Remove(qui)

                                    ff.WebBrowser1.Document.Write("<font color='" & soleil & "'>" & "" & qui & " vient de partir du salon." & "</font><Br>")
                                    If Options.parti.Checked Then
                                        Dim s As String
                                        s = Replace(Options.TextBox4.Text, "$nick", qui)

                                        s = Replace(s, "$chan", ff.Name)
                                        send("PRIVMSG " & ff.Name & " :" & s & vbCrLf)
                                        ff.WebBrowser1.Document.Write(ff.Modos(nick) & ">" & s & "<br>")

                                    End If
                                    ff.WebBrowser1.Document.Body.ScrollTop += 999999999

                                End If

                            Next

                        Case "QUIT"

                            couper = Split(mots(0), "!")
                            'qui = Mid(couper(0), 2, Len(couper(0)) - 1) '' qui
                            qui = couper(0).Substring(1) ' qui

                            For Each ff In Me.MdiChildren

                                If ff.ListBox1.Items.Contains(qui) Then
                                    ff.ListBox1.Items.Remove(qui)

                                    ff.WebBrowser1.Document.Write("<font color='" & soleil & "'>" & "" & qui & " vient de quitter le chat " & donnees.Substring(Len(mots(0)) + 1 + Len(mots(1)) + 2 - 1) & "</font></b><Br>")
                                    If Options.quitta.Checked Then
                                        Dim s As String

                                        s = Replace(Options.TextBox5.Text, "$nick", qui)
                                        s = Replace(s, "$chan", ff.Name)
                                        s = Replace(s, "$bye", donnees.Substring(Len(mots(0)) + 1 + Len(mots(1)) + 2 - 1))

                                        send("PRIVMSG " & ff.Name & " :" & s & vbCrLf)

                                        ff.WebBrowser1.Document.Write(ff.Modos(nick) & ">" & s & "<br>")

                                    End If

                                    ff.WebBrowser1.Document.Body.ScrollTop += 999999999

                                End If

                            Next

                        Case "NICK"
                            couper = Split(mots(0), "!")
                            '                           qui = Mid(couper(0), 2, Len(couper(0)) - 1) '' qui
                            qui = couper(0).Substring(1) ' qui

                            If qui = nick Then
                                'nick = Mid(donnees, Len(mots(0)) + 1 + Len(mots(1)) + 3, Len(donnees) - (Len(mots(0)) + 1 + Len(mots(1)) + 3) + 1)
                                nick = donnees.Substring(Len(mots(0)) + 1 + Len(mots(1)) + 3 - 1)
                            End If

                            For Each ff In Me.MdiChildren

                                If ff.ListBox1.Items.Contains(qui) Then
                                    ff.ListBox1.Items.Remove(qui)
                                    'ff.ListBox1.Items.Add(Mid(donnees, Len(mots(0)) + 1 + Len(mots(1)) + 3, Len(donnees) - (Len(mots(0)) + 1 + Len(mots(1)) + 3) + 1))
                                    ff.ListBox1.Items.Add(donnees.Substring(Len(mots(0)) + 1 + Len(mots(1)) + 3 - 1))

                                    ff.WebBrowser1.Document.Write("<font color='" & soleil & "'>" & "" & qui & " à changé son pseudonyme pour : " & donnees.Substring(Len(mots(0)) + 1 + Len(mots(1)) + 3 - 1) & "</font><Br>")

                                    ff.WebBrowser1.Document.Body.ScrollTop += 999999999
                                End If

                            Next

                        Case "KICK"

                            couper = Split(mots(0), "!")
                            qui = couper(0).Substring(1) ' qui

                            'qui = Mid(couper(0), 2, Len(couper(0)) - 1) '' qui

                            Dim motif As String = donnees.Substring(Len(mots(0)) + 1 + Len(mots(1)) + 1 + Len(mots(2)) + 1 + Len(mots(3)) + 3 - 1)

                            For Each ff In Me.MdiChildren

                                If ff.ListBox1.Items.Contains(qui) Then

                                    ff.ListBox1.Items.Remove(mots(3))

                                    ff.WebBrowser1.Document.Write("<font color='" & soleil & "'>" & "" & mots(3) & " à été éjecté par " & qui & " pour le motif suivant : " & motif & "</font><Br>")

                                    ff.WebBrowser1.Document.Body.ScrollTop += 999999999
                                End If

                            Next

                    End Select

            End Select

        Catch ex As Exception

        End Try

    End Sub
    Private Sub ArcencielToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ArcencielToolStripMenuItem.Click
        MessageBox.Show("Arc-en-ciel" & vbCrLf & vbCrLf & "Arc-en-ciel est une fonction de ChatIRC" & vbCrLf & "vous permettant de colorer vos messages." & vbCrLf & "Cette fonction se trouve dans le menu Arc-en-ciel." & vbCrLf & vbCrLf & "Son utilisation est simple, cochez les couleurs" & vbCrLf & "que vous souhaitez et vos messages seront automatiquement" & vbCrLf & "colorés avec ces couleurs en les calculant au hasard." & vbCrLf & vbCrLf & "Vous pouvez enregistrer votre style de couleurs" & vbCrLf & "en cliquant avec le bouton droit sur la fenêtre" & vbCrLf & "et en cliquant sur Enregistrer ces options.", "ChatIRC - Aide", MessageBoxButtons.OK, MessageBoxIcon.Information)
    End Sub
    Private Sub AfficherToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles AfficherToolStripMenuItem.Click
        NotifyIcon1_MouseDoubleClick(Me, Nothing)
    End Sub
    Private Sub QuitterToolStripMenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles QuitterToolStripMenuItem1.Click
        QuitterToolStripMenuItem_Click(Me, Nothing)
    End Sub
End Class

Conclusion :


Ce client a plusieurs options :
Mode répondeur automatique,
mode robot
Mais aussi des smileys (utilisation du Webbrowser)
et des thèmes colorés choisis au hazard.
2 serveurs sont disponibles au démarrage.
Et enfin un bouton quizz pour jouer sur les salons
ou en PV.
Ce programme a toutefois le problème de la limitation
du Webbrowser qui ne peut pas accepter de texte à l'infini.

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
269
Date d'inscription
dimanche 31 mai 2009
Statut
Membre
Dernière intervention
12 mars 2011

Personne pour me mettre une note ?
Messages postés
269
Date d'inscription
dimanche 31 mai 2009
Statut
Membre
Dernière intervention
12 mars 2011

Non, c'est un client, pas un serveur ^^
Tu peux te connecter sur à peu près tous les serveurs avec ça.
Messages postés
15
Date d'inscription
lundi 16 juin 2008
Statut
Membre
Dernière intervention
7 mars 2014

Ok merci mais avec sa je pourrais mettre un Chat IRC sur mon site free ?
Messages postés
269
Date d'inscription
dimanche 31 mai 2009
Statut
Membre
Dernière intervention
12 mars 2011

Il faut avoir la version 2010 de visual basic
et avoir rajouté l'outil Winsock à la boîte à outils comme
expliqué dans la description de la source.
Le fichier MSWINSCK.OCX est fourni dans le fichier Zip du projet.
Une fois le Winsock ajouté à la boîte à outils
on peux ouvrir le projet et le générer.
Si en faisant cela le projet ne marche pas ce n'est pas normal.
Messages postés
15
Date d'inscription
lundi 16 juin 2008
Statut
Membre
Dernière intervention
7 mars 2014

J'ai pas trop compris comment le lancer... j'ai windows vista et le truc winsock marche pas.

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.