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.
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.
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
- Chatirv
- Chatirc - Meilleures réponses
- Client irc (supprimée) - Codes sources - Visual Basic / VB.NET (VB.NET)
- Kirc (client irc) - Codes sources - Visual Basic / VB.NET (Réseau & Internet)
- Client irc en vb.net multiserver (supprimée) - Codes sources - Visual Basic / VB.NET (Réseau & Internet)
- Client irc (vc++ 5.0) - Codes sources - C / C++ / C++.NET (Réseaux & Internet)
- C / C++ / C++.NET : Client irc simple ! - CodeS SourceS - Guide
Tu peux te connecter sur à peu près tous les serveurs avec ça.
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.
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.