Option Explicit

Private Type tConnect
    lgRequestID As Long
    stPseudo As String
End Type

' Tableau des connexions courantes
Private tabConnect() As tConnect
' Taille du tableau
Private lgConnect As Long

' Pseudo de l'utilisateur courant
Private stPseudo As String

' Port de connexion au serveur
Private Const WSK_PORT = 6667

Private Sub cmdConnect_Click()
' Démarre une connexion au serveur, ou lance un serveur.
' Ferme une connexion, ou arrête le serveur
' En fonction de l'état du bouton...
Dim lgTmp As Long
cmdConnect.Enabled = False
If cmdConnect.Caption = "&Démarrer" Then
    fraConnexion.Enabled = False
    If optConnect(0).Value Then
' Démarre un serveur
        wskIRC(0).LocalPort = WSK_PORT
        wskIRC(0).Listen
        stPseudo = "Serveur"
    Else
' Démarre une connexion cliente
        On Error GoTo ErrConnectClient
        lgTmp = wskIRC(0).LocalPort
ResConnectClient:
        If wskIRC(0).State <> sckClosed Then wskIRC(0).Close
        wskIRC(0).LocalPort = lgTmp
        wskIRC(0).Connect txtServeur.Text, WSK_PORT
    End If
    cmdConnect.Caption = "A&rreter"
    txtMot.Enabled = True
    txtMot.SetFocus
Else
    If optConnect(0).Value Then
' Arrête le serveur courant
        wskIRC(0).Close
        For lgTmp = 1 To lgConnect
            If (tabConnect(lgTmp).lgRequestID > 0) Then
                wskIRC(lgTmp).Close
                Unload wskIRC(lgTmp)
                DoEvents
            End If
        Next lgTmp
        lgConnect = 0
    Else
' Arrête la connexion cliente courante
        wskIRC(0).Close
    End If
    stPseudo = vbNullString
    fraConnexion.Enabled = True
    cmdConnect.Caption = "&Démarrer"
    txtMot.Enabled = False
End If
cmdConnect.Enabled = True
Exit Sub
' Gestion d'erreur, pour permettre des tests en local
ErrConnectClient:
If Err.Number = 40020 Or Err.Number = 10048 Then
    lgTmp = lgTmp - 1
    Resume ResConnectClient
End If
End Sub
Private Sub cmdQuitter_Click()
' Quitte l'application
Unload Me
End Sub
Private Sub Form_Load()
' Initialisation des zones
lblIP.Caption = "Adresse IP : " & wskIRC(0).LocalIP
rtbForum.Text = vbNullString
txtMot.Text = vbNullString
' Initialisation des variables
lgConnect = 0
End Sub

Private Sub optConnect_Click(Index As Integer)
If Index = 1 Then txtServeur.SetFocus
End Sub

Private Sub txtMot_KeyPress(KeyAscii As Integer)
' Gestion des phrases à afficher
Dim lgFor As Long
Dim stEnvoi As String
If KeyAscii = vbKeyReturn Then
    If Left$(txtMot.Text, 1) = "/" Then
' Envoi d'un mot clé
        stEnvoi = txtMot.Text & vbCrLf
    Else
' Envoi d'un message standard
        stEnvoi = "[" & stPseudo & "] " & txtMot.Text & vbCrLf
' Affichage du message
        rtbWrite stEnvoi
    End If
    If optConnect(0).Value Then
' Cas SERVEUR - pour tous les clients
        Call Distribution(stEnvoi)
    Else
' Cas CLIENT - pour le serveur
        wskIRC(0).SendData stEnvoi
    End If
    txtMot.Text = vbNullString
End If
End Sub

Private Sub txtServeur_Click()
optConnect(1).Value = True
End Sub

Private Sub txtServeur_GotFocus()
' Sélection de l'ensemble du texte
txtServeur.SelStart = 0
txtServeur.SelLength = Len(txtServeur.Text)
End Sub

Private Sub rtbWrite(stTexte As String, Optional blGras As Boolean = False, Optional blItalique As Boolean = False, Optional blSouligne As Boolean = False, Optional vColor As OLE_COLOR = vbBlack)
' Ecrit un texte dans le contrôle RichTextBox avec les options souhaitées
rtbForum.SelStart = Len(rtbForum.Text)
rtbForum.SelText = rtbForum.SelText & stTexte
rtbForum.SelStart = Len(rtbForum.Text) - Len(stTexte)
rtbForum.SelLength = Len(stTexte)
rtbForum.SelBold = blGras
rtbForum.SelItalic = blItalique
rtbForum.SelUnderline = blSouligne
rtbForum.SelColor = vColor
rtbForum.SelStart = Len(rtbForum)
End Sub
Private Sub wskIRC_Close(Index As Integer)
' Fermeture d'une connexion
Dim lgFor As Long
Dim stEnvoi As String
wskIRC(Index).Close
If optConnect(0).Value Then
' Cas SERVEUR - Déconnexion + avertissement pour départ du participant
    stEnvoi = tabConnect(Index).stPseudo & " a quitté VBIRC." & vbCrLf
    rtbWrite stEnvoi
    tabConnect(Index).lgRequestID = -1
    tabConnect(Index).stPseudo = vbNullString
    Call Distribution(stEnvoi)
Else
' Cas CLIENT
    rtbWrite "Le serveur a fermé la connexion..." & vbCrLf, True, , , vbRed
    fraConnexion.Enabled = True
    cmdConnect.Caption = "&Démarrer"
    txtMot.Enabled = False
    wskIRC(0).Close
End If
End Sub
Private Sub wskIRC_Connect(Index As Integer)
rtbWrite "Connexion sur " & txtServeur.Text & " acceptée..." & vbCrLf, True, , , vbRed
End Sub
Private Sub wskIRC_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Dim lgFor As Long
Dim stEnvoi As String
' Recherche du premier indice de connexion disponible
For lgFor = 1 To lgConnect
    If tabConnect(lgFor).lgRequestID < 0 Then Exit For
Next lgFor
If lgFor > lgConnect Then
' Augmente le tableau des connexions
    ReDim Preserve tabConnect(lgFor) As tConnect
' Création d'un nouveau WinSock de dialogue
    Load wskIRC(lgFor)
    lgConnect = lgFor
End If
' Enregistrement du requestId
tabConnect(lgFor).lgRequestID = requestID
' Accepte la connexion
wskIRC(lgFor).Accept requestID
tabConnect(lgFor).stPseudo = Pseudo
wskIRC(lgFor).SendData "/PSEUDO " & tabConnect(lgFor).stPseudo & vbCrLf
' Avertissement pour l'arrivée d'un participant
stEnvoi = tabConnect(lgFor).stPseudo & " arrive sur VBIRC." & vbCrLf
rtbWrite stEnvoi
Call Distribution(stEnvoi, lgFor)
End Sub
Private Sub wskIRC_DataArrival(Index As Integer, ByVal bytesTotal As Long)
' Réception de données
Dim stTmp As String, stEnvoi As String
Dim lgFor As Long
Dim tabTmp, tabLst
' Récupère les données
wskIRC(Index).GetData stTmp, vbString
If optConnect(0).Value Then
' Cas SERVEUR - on redistribue à tous les autres clients (sauf à l'expéditeur)
' Réception d'un commande
    tabLst = Split(stTmp, vbCrLf)
    For lgFor = 0 To UBound(tabLst) - 1
        tabTmp = Split(tabLst(lgFor), " ")
        Select Case UCase$(tabTmp(0))
            Case "/PSEUDO"
                stEnvoi = tabTmp(1)
                If PseudoExiste(stEnvoi) Then
                    wskIRC(Index).SendData "Ce pseudo est déjà utilisé..." & vbCrLf
                Else
                    stEnvoi = tabConnect(Index).stPseudo & " s'appelle maintenant " & tabTmp(1) & vbCrLf
                    tabConnect(Index).stPseudo = tabTmp(1)
                    rtbWrite stEnvoi
                    wskIRC(Index).SendData "/PSEUDO " & tabTmp(1) & vbCrLf
                    DoEvents
                    Call Distribution(stEnvoi, CLng(Index))
                End If
            Case Else
    ' Réception d'un texte quelconque
                stEnvoi = tabLst(lgFor) & vbCrLf
                rtbWrite stEnvoi
                Call Distribution(stEnvoi, CLng(Index))
        End Select
    Next lgFor
Else
' Cas CLIENT
' Réception d'une commande serveur
    tabLst = Split(stTmp, vbCrLf)
' Décompose le texte reçu en lignes de texte
    For lgFor = 0 To UBound(tabLst) - 1
        tabTmp = Split(tabLst(lgFor), " ")
        Select Case UCase$(tabTmp(0))
        ' Mot clé reconnu
            Case "/PSEUDO"
                stPseudo = tabTmp(1)
                rtbWrite "Votre pseudo est " & stPseudo & ", pour le changer /pseudo <NouveauPseudo>" & vbCrLf
            Case Else
        ' Réception d'un message standard
                stEnvoi = tabLst(lgFor) & vbCrLf
        ' Ecrit les données
                rtbWrite stEnvoi
        End Select
    Next lgFor
End If
End Sub
Private Function Distribution(stTexte As String, Optional lgSauf As Long = -1)
' Envoi un texte à l'ensemble des connectés
' On peut éventuellement enlever une personne en donnant son
' indice dans le tableau
Dim lgFor As Long
For lgFor = 1 To lgConnect
    If (tabConnect(lgFor).lgRequestID > 0) And lgFor <> lgSauf Then
        wskIRC(lgFor).SendData stTexte
        DoEvents
    End If
Next lgFor
End Function
Private Function Pseudo() As String
' Création d'un pseudo temporaire pour les nouveaux connectés
Dim lgFor As Long
Dim blOK As Boolean
Dim stTmp As String
stTmp = "00"
Do
    blOK = True
' Incrémente au fur et à mesure Nouveau01, Nouveau02, Nouveau03, ...
    stTmp = "Nouveau" & Format(Val(Right$(stTmp, 2)) + 1, "00")
    For lgFor = 1 To lgConnect
        If tabConnect(lgFor).stPseudo = stTmp Then
            blOK = False
            Exit For
        End If
    Next lgFor
Loop Until blOK
Pseudo = stTmp
End Function
Private Function PseudoExiste(stPseudoReq As String) As Boolean
' Verifie l'existence d'un pseudo
Dim lgFor As Long
Dim blOK As Boolean
' Il ne faut qu'il soit vide ou pareil à celui du serveur
blOK = Not ((stPseudoReq <> vbNullString) And (UCase$(stPseudoReq) <> UCase$(stPseudo)))
For lgFor = 1 To lgConnect
    If UCase$(tabConnect(lgFor).stPseudo) = UCase$(stPseudoReq) Then
        blOK = True
        Exit For
    End If
Next lgFor
PseudoExiste = blOK
End Function