TELNET SUPER EXPLIKE AVEC RICHTEXT + WINSOCK

Const OK = &HFF00&
Const ERREUR = &HFF&
Const FERMER = &H0&
Const ENCOURS = &H80FF&
Const NOIR = &H0&
Const ENVOI = &H0&
Const RECEPTION = &H40&

Private Sub Command1_Click()
    If W.State = sckClosed Then
    'Si le socket est  l'tat ferm on se connecte
        W.LocalPort = Text1.Text
        W.RemotePort = Text2.Text
        W.RemoteHost = Text3.Text
        W.Connect
    Else
        If W.State = sckConnected Then
        'Si le socket est connect on envoie la commande
            Envoyer Text4.Text
            Text4.SelStart = 0
            Text4.SelLength = Len(Text4.Text)
        Else
            'si C pas les 2 cas le socket n'est pas dans un etat
            'qui permettrai de se connecter ou d'envoyer des donnes
            MsgBox "Mauvais tat pour envoi ou connexion....", vbCritical, "Erreur"
            Fermer_Connexion
        End If
    End If
End Sub

Private Sub Command2_Click()
    W.Close
End Sub

Private Sub Rich_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
'on copie la slection dans l'envoi de donnes
If Button = 2 Then Text4.Text = Rich.SelText
'si on clik sur le boutton du milieu dans le richtext a le Clear
If Button = 4 Then Rich.Text = ""
End Sub

Private Sub Timer1_Timer()
Dim Color As String
Dim descriptif As String
'Tous les cas sont rpertoris, si on veut on peut attribuer 
'chaque tat une couleur particulire...
Select Case W.State
Case sckClosed: Color = NOIR: descriptif = "Ferm"
Case sckOpen: Color = ENCOURS: descriptif = "Ouvert"
Case sckListening: Color = ENCOURS: descriptif = "A l'coute"
Case sckConnectionPending: Color = ENCOURS: descriptif = "Connexion En Attente"
Case sckResolvingHost: Color = ENCOURS: descriptif = "En cours de Rsolution"
Case sckHostResolved: Color = ENCOURS: descriptif = "Hte rsolu"
Case sckConnecting: Color = ENCOURS: descriptif = "En cours de Connexion"
Case sckConnected: Color = OK: descriptif = "Connect"
Case sckClosing: Color = ENCOURS: descriptif = "Se Ferme"
Case sckError: Color = ERREUR: descriptif = "En Erreur"
End Select
Label4.BackColor = Color
'Pour ceux qui savent pas quand on passera sur la caption
'avec la souris on aura son tat en tooltiptext
Label4.ToolTipText = descriptif
End Sub

Private Sub W_DataArrival(ByVal bytesTotal As Long)
    Dim Temp As String
    Dim temp2 As String
    Dim dep As Long
    'on rcupere
    W.GetData Temp
    'puis on l'ajoute au Richtext avec la couleur spcifique  la recption
    Ajout_Rich Temp, RECEPTION, False
End Sub

Private Sub W_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    MsgBox Description, vbCritical, "Erreur n" & Val(Number)
    Fermer_Connexion
End Sub

Function Fermer_Connexion() As Boolean
On Error GoTo Err
    W.Close
    DoEvents
    If W.State = sckClosed Then Fermer_Connexion = True Else: Fermer_Connexion = False
    Exit Function
Err:
    Fermer_Connexion = False
End Function

Function Envoyer(Temp As String)
Dim cpt As Integer
Dim dep As Long
Dim temp2 As String
'on envoie caractere par caractere
    For cpt = 1 To Len(Temp) Step 1
        W.SendData Mid(Temp, cpt, 1)
    Next
    'puis le retour chariot
    W.SendData vbCrLf
    Ajout_Rich Temp & vbCrLf, ENVOI, True
End Function

Function Ajout_Rich(Temp As String, Color As String, Italik As Boolean)
'rien de bien complik
'on place le curseur  la fin du Richtext
    Rich.SelStart = Len(Rich.Text)
'on y ajoute le texte  insrer
    Rich.SelText = Temp
'on se remet au debut de ce que l'on a insr
    Rich.SelStart = Len(Rich.Text) - Len(Temp)
'sur une longueur de ce que l'on a insr ... logik
    Rich.SelLength = Len(Temp)
'et sur cette slection on dit que la couleur C celle passe en paramtre
    Rich.SelColor = Color
'pareil pour l'italique
    Rich.SelItalic = Italik
'on peut ajouter aussi des chgts de font de la mm facon ou des soulignements...
End Function
  

Télécharger le zip