sniceper
Messages postés19Date d'inscriptiondimanche 14 août 2005StatutMembreDernière intervention20 septembre 2010
-
25 nov. 2008 à 15:21
sniceper
Messages postés19Date d'inscriptiondimanche 14 août 2005StatutMembreDernière intervention20 septembre 2010
-
25 nov. 2008 à 16:39
Bonjour, je suis actuellement en train de coder un mini jeux client serveur en VB6 à 1 serveur et 1 à 4 clients.
Desireux de gérer les coupures de connexion, j'y ais ajouté la fonction Error disponible avec un winsock, censée se lire a chaque erreur du socket.
Cependant, lors d'une erreur avec mon socket, le programme crash sans passer par la fonction error. Aurais-je oublié quelque chose?
Merci d'avance
' definition des entetes des flux de données
' t : tchat
' p : compte a rebours de debut de partie
' c: case cochée
Dim a, b, c, d As Boolean
Dim sa, sb, sc, sd As Integer
Dim coche(100) As Boolean
Function envoi(data As String) 'fonction qui permet l'envoi de l'ensemble des données vers les clients
Call j(1).SendData(data)
'DoEvents
If b = True Then
Call j(2).SendData(data)
'DoEvents
End If
If c = True Then
Call j(3).SendData(data)
'DoEvents
End If
If d = True Then
Call j(4).SendData(data)
'DoEvents
End If
End Function
'Function ferm()
'MsgBox (" bim fermé")
'End Function
Private Sub Command1_Click() 'lancer l'écoute
Dim lport As Integer
lport = Val(Text1.Text)
Winsock1.LocalPort = lport
Open "historique.txt" For Append As 1
Print #1, Date & " --> Ecoute du serveur lancée au port " & lport
Close
Winsock1.Listen
End Sub
Private Sub Command2_Click() 'lancer la partie sur tous les clients
Dim x As Integer
envoi ("p")
sa = 0
sb = 0
sc = 0
sd = 0
Timer1.Enabled = True
For x = 0 To 99
coche(x) = False
Next
Open "historique.txt" For Append As 1
Print #1, Date & " --> partie lancée"
Print #1, "*********************SCORES******************************"
Close
End Sub
Private Sub Form_Load() 'ouverture du serveur
a = False
b = False
c = False
d = False
End Sub
Private Sub j_Error(Index As Integer, 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 ("Problème de connexion avec le joueur " & Index & "." & Chr(13) & "Description de l'erreur: " & Description & Chr(13) & Chr(13) & "Emplacement ouvert pour nouveau joueur")
j(Index).Close
envoi ("tJoueur " & Index & " deconnecté.")
If Index = 1 Then
a = False
ElseIf Index = 2 Then 'Gestion des erreurs
b = False
ElseIf Index = 3 Then
c = False
Else
d = False
End If
Private Sub Timer1_Timer() 'MAJ des scores
j(1).SendData ("s" & sa)
DoEvents
If b = True Then
j(2).SendData ("s" & sb)
DoEvents
End If
If c = True Then
j(3).SendData ("s" & sc)
DoEvents
End If
If d = True Then
j(4).SendData ("s" & sd)
DoEvents
End If
Open "historique.txt" For Append As 1
Print #1, "scores: J1: " & sa & ", J2:" & sb & ", J3:" & sc & ", J4:" & sd
Close
End Sub
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
Dim x As Integer
x = 0
Winsock1.Close
If a = False Then 'on cherche un socket libre pour stocker la connexion avec le client entrant
x = 1
a = True
ElseIf b = False Then
x = 2
b = True
ElseIf c = False Then
x = 3
c = True
ElseIf d = False Then
x = 4
d = True
End If
If x <> 0 Then
j(x).Close
j(x).Accept requestID
Open "historique.txt" For Append As 1
Print #1, Date & " --> Connection de joueur : " & j(x).RemoteHostIP
Close
List1.AddItem ("Le client '" & j(x).RemoteHostIP & "' s'est connecté en tant que joueur " & x)
envoi ("tLe client '" & j(x).RemoteHostIP & "' s'est connecté en tant que joueur " & x) 'le t montre que cest un message tchat
If a True Or b True Or c = True Or d = True Then 'si des joueurs, on peut commencer une partie
Command2.Enabled = True
End If
End If
Winsock1.Listen
End Sub
Private Sub j_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim data As String
Dim logue As Integer
Dim x As Integer
Call j(Index).GetData(data)
If Mid(data, 1, 1) = "t" Then 'si les données reçus sont de type tchat
logue = Len(data)
data = Mid(data, 2, logue)
data = "joueur " & Index & ": " & data
envoi ("t" & data)
List1.AddItem (data)
ElseIf Mid(data, 1, 1) = "c" Then 'si les données sont les coordonées d'une case cochée
Dim c As Integer
Dim pris As Boolean
pris = False
If Len(data) = 2 Then 'DATA A 2 CARACTERES
If Not coche(Val(Mid(data, 2, 1))) = True Then
coche(Val(Mid(data, 2, 1))) = True
If Index = 1 Then
sa = sa + 1
ElseIf Index = 2 Then
sb = sb + 1
ElseIf Index = 3 Then
sc = sc + 1
Else
sd = sd + 1
End If
envoi ("c" & Index & Mid(data, 2, 1))
If sa + sb + sc + sd = 100 Then 'si partie terminée
If sa > sb Then
x = sa
End If
If sc > x Then
x = sc
End If
If sd > x Then
x = sd
End If
j(1).SendData ("s" & sa)
DoEvents
If b = True Then
j(2).SendData ("s" & sb)
DoEvents
End If
If c = True Then
j(3).SendData ("s" & sc)
DoEvents
End If
If d = True Then
j(4).SendData ("s" & sd)
DoEvents
End If
envoi ("z" & x)
Timer1.Enabled = False
End If
End If
Else 'DATA A 3 CARACTERES
If Not coche(Val(Mid(data, 2, 2))) = True Then
coche(Val(Mid(data, 2, 2))) = True
If Index = 1 Then
sa = sa + 1
ElseIf Index = 2 Then
sb = sb + 1
ElseIf Index = 3 Then
sc = sc + 1
Else
sd = sd + 1
End If
envoi ("c" & Index & Mid(data, 2, 2)) 'si partie terminée
If sa + sb + sc + sd = 100 Then
If sa > sb Then
x = sa
End If
If sc > x Then
x = sc
End If
If sd > x Then
x = sd
End If
j(1).SendData ("s" & sa)
DoEvents
If b = True Then
j(2).SendData ("s" & sb)
DoEvents
End If
If c = True Then
j(3).SendData ("s" & sc)
DoEvents
End If
If d = True Then
j(4).SendData ("s" & sd)
DoEvents
End If
envoi ("z" & x)
Timer1.Enabled = False
Open "historique.txt" For Append As 1
Print #1, "*****************PARTIE TERMINEE************************"
Close
End If
End If
End If
End If
End Sub
' definition des entetes des flux de données
' t : tchat
' p : compte a rebours de debut de partie
' c: case cochée
Dim a, b, c, d As Boolean
Dim sa, sb, sc, sd As Integer
Dim coche(100) As Boolean
Function envoi(data As String) 'fonction qui permet l'envoi de l'ensemble des données vers les clients
Call j(1).SendData(data)
'DoEvents
If b = True Then
Call j(2).SendData(data)
'DoEvents
End If
If c = True Then
Call j(3).SendData(data)
'DoEvents
End If
If d = True Then
Call j(4).SendData(data)
'DoEvents
End If
End Function
'Function ferm()
'MsgBox (" bim fermé")
'End Function
Private Sub Command1_Click() 'lancer l'écoute
Dim lport As Integer
lport = Val(Text1.Text)
Winsock1.LocalPort = lport
Open "historique.txt" For Append As 1
Print #1, Date & " --> Ecoute du serveur lancée au port " & lport
Close
Winsock1.Listen
End Sub
Private Sub Command2_Click() 'lancer la partie sur tous les clients
Dim x As Integer
envoi ("p")
sa = 0
sb = 0
sc = 0
sd = 0
Timer1.Enabled = True
For x = 0 To 99
coche(x) = False
Next
Open "historique.txt" For Append As 1
Print #1, Date & " --> partie lancée"
Print #1, "*********************SCORES******************************"
Close
End Sub
Private Sub Form_Load() 'ouverture du serveur
a = False
b = False
c = False
d = False
End Sub
Private Sub j_Error(Index As Integer, 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 ("Problème de connexion avec le joueur " & Index & "." & Chr(13) & "Description de l'erreur: " & Description & Chr(13) & Chr(13) & "Emplacement ouvert pour nouveau joueur")
j(Index).Close
envoi ("tJoueur " & Index & " deconnecté.")
If Index = 1 Then
a = False
ElseIf Index = 2 Then 'Gestion des erreurs
b = False
ElseIf Index = 3 Then
c = False
Else
d = False
End If
Private Sub Timer1_Timer() 'MAJ des scores
j(1).SendData ("s" & sa)
DoEvents
If b = True Then
j(2).SendData ("s" & sb)
DoEvents
End If
If c = True Then
j(3).SendData ("s" & sc)
DoEvents
End If
If d = True Then
j(4).SendData ("s" & sd)
DoEvents
End If
Open "historique.txt" For Append As 1
Print #1, "scores: J1: " & sa & ", J2:" & sb & ", J3:" & sc & ", J4:" & sd
Close
End Sub
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
Dim x As Integer
x = 0
Winsock1.Close
If a = False Then 'on cherche un socket libre pour stocker la connexion avec le client entrant
x = 1
a = True
ElseIf b = False Then
x = 2
b = True
ElseIf c = False Then
x = 3
c = True
ElseIf d = False Then
x = 4
d = True
End If
If x <> 0 Then
j(x).Close
j(x).Accept requestID
Open "historique.txt" For Append As 1
Print #1, Date & " --> Connection de joueur : " & j(x).RemoteHostIP
Close
List1.AddItem ("Le client '" & j(x).RemoteHostIP & "' s'est connecté en tant que joueur " & x)
envoi ("tLe client '" & j(x).RemoteHostIP & "' s'est connecté en tant que joueur " & x) 'le t montre que cest un message tchat
If a True Or b True Or c = True Or d = True Then 'si des joueurs, on peut commencer une partie
Command2.Enabled = True
End If
End If
Winsock1.Listen
End Sub
Private Sub j_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim data As String
Dim logue As Integer
Dim x As Integer
Call j(Index).GetData(data)
If Mid(data, 1, 1) = "t" Then 'si les données reçus sont de type tchat
logue = Len(data)
data = Mid(data, 2, logue)
data = "joueur " & Index & ": " & data
envoi ("t" & data)
List1.AddItem (data)
ElseIf Mid(data, 1, 1) = "c" Then 'si les données sont les coordonées d'une case cochée
Dim c As Integer
Dim pris As Boolean
pris = False
If Len(data) = 2 Then 'DATA A 2 CARACTERES
If Not coche(Val(Mid(data, 2, 1))) = True Then
coche(Val(Mid(data, 2, 1))) = True
If Index = 1 Then
sa = sa + 1
ElseIf Index = 2 Then
sb = sb + 1
ElseIf Index = 3 Then
sc = sc + 1
Else
sd = sd + 1
End If
envoi ("c" & Index & Mid(data, 2, 1))
If sa + sb + sc + sd = 100 Then 'si partie terminée
If sa > sb Then
x = sa
End If
If sc > x Then
x = sc
End If
If sd > x Then
x = sd
End If
j(1).SendData ("s" & sa)
DoEvents
If b = True Then
j(2).SendData ("s" & sb)
DoEvents
End If
If c = True Then
j(3).SendData ("s" & sc)
DoEvents
End If
If d = True Then
j(4).SendData ("s" & sd)
DoEvents
End If
envoi ("z" & x)
Timer1.Enabled = False
End If
End If
Else 'DATA A 3 CARACTERES
If Not coche(Val(Mid(data, 2, 2))) = True Then
coche(Val(Mid(data, 2, 2))) = True
If Index = 1 Then
sa = sa + 1
ElseIf Index = 2 Then
sb = sb + 1
ElseIf Index = 3 Then
sc = sc + 1
Else
sd = sd + 1
End If
envoi ("c" & Index & Mid(data, 2, 2)) 'si partie terminée
If sa + sb + sc + sd = 100 Then
If sa > sb Then
x = sa
End If
If sc > x Then
x = sc
End If
If sd > x Then
x = sd
End If
j(1).SendData ("s" & sa)
DoEvents
If b = True Then
j(2).SendData ("s" & sb)
DoEvents
End If
If c = True Then
j(3).SendData ("s" & sc)
DoEvents
End If
If d = True Then
j(4).SendData ("s" & sd)
DoEvents
End If
envoi ("z" & x)
Timer1.Enabled = False
Open "historique.txt" For Append As 1
Print #1, "*****************PARTIE TERMINEE************************"
Close
sniceper
Messages postés19Date d'inscriptiondimanche 14 août 2005StatutMembreDernière intervention20 septembre 2010 25 nov. 2008 à 16:18
oui désole je debute encore en prog.. je n'ais pas encore toujours les bons relfexes. Ceci dit, sa ne m'explique pas pourquoi quand je fais j(x).senddata et que celui ci rencontre un erreur, il ne va pas dans:
Private Sub j_Error(Index As Integer, 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 ("Problème de connexion avec le joueur " & Index & "." & Chr(13) & "Description de l'erreur: " & Description & Chr(13) & Chr(13) & "Emplacement ouvert pour nouveau joueur")
j(Index).Close
envoi ("tJoueur " & Index & " deconnecté.")
If Index = 1 Then
a = False
ElseIf Index = 2 Then 'Gestion des erreurs
b = False
ElseIf Index = 3 Then
c = False
Else
d = False
End If