World chatting

Commenter

Contenu du snippet

C'est un Chatt comme son nom l'indique . Utilisable de partout dans l'monde . Il suffit juste de posséder l'ip de son interlocuteur de l'entrée dans la case correspondante et puis voilà . Un ou deux bugz persistent ... Aidé de Microsoft Atelier ...

Source / Exemple : 


Private Sub Form_Load()
sckTCP.LocalPort = "1000"
sckTCP.Listen
ShowText "A l'écoute"
End Sub

Private Sub mnuConnect_Click()
    Dim strRemoteHost As String
    
    strRemoteHost = InputBox("Entrer le nom ou l'adresse IP de l'ordinateur " & _
        "auquel se connecter.", vbOKCancel)
   
    If strRemoteHost = "" Then Exit Sub
    
    sckTCP.Close
    
    sckTCP.RemoteHost = strRemoteHost
    
    sckTCP.RemotePort = 1000
   
    DoEvents
  
    sckTCP.Connect
End Sub

Private Sub mnuDisconnect_Click()
sckTCP.Close
DoEvents
sckTCP.Listen
ShowText "Ecouter"
End Sub

Private Sub sckTCP_Close()
ShowText "Fermer"

sckTCP.Listen
sckTCP.Close
ShowText "Ecouter"
End Sub

Private Sub sckTCP_Connect()
ShowText "Connecté"
End Sub

Private Sub sckTCP_ConnectionRequest(ByVal requestID As Long)
    sckTCP.Close
    sckTCP.Accept requestID
    ShowText "Acceptation de la demande de " & sckTCP.RemoteHostIP
End Sub

Private Sub sckTCP_DataArrival(ByVal bytesTotal As Long)
    Dim strText As String
    
    sckTCP.GetData strText
   
    txtChat = txtChat & ">>" & strText & vbCrLf
    
    txtChat.SelStart = Len(txtChat)
    ShowText "Octets reçus: " & bytesTotal
End Sub

Private Sub sckTCP_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 _
)
    ShowText "Erreur " & Number & " " & Description
End Sub
Private Sub sckTCP_SendComplete()
    ShowText "Octets envoyés: " & mlngBytes
End Sub

Private Sub sckTCP_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)
    
    mlngBytes = bytesSent
End Sub

Private Sub txtChat_KeyPress(KeyAscii As Integer)
    Static strSend As String
    
    If sckTCP.State <> sckConnected Then Exit Sub
    
    If KeyAscii = Asc(vbCr) Then
        
        sckTCP.SendData strSend
        
        strSend = ""
    Else
        
        strSend = strSend & Chr(KeyAscii)
    End If
End Sub

Sub ShowText(Text As String)
    sbrChat.Panels(1).Text = Text
End Sub

A voir également

S'inscrire maintenant

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.

Du même auteur (Kruptos)