1. Accueil
  2. Visual Basic / VB.NET
  3. Sources Visual Basic / VB.NET
  4. Sources API
  5. Echange de messages windows entre deux applications

Echange de messages windows entre deux applications

Soyez le premier à donner votre avis sur cette source.

Vue 15 534 fois - Téléchargée 1 546 fois

Télécharger le projet
Commenter

Description

L'objectif est de faire communiquer deux applications pour échanger des informations. Ce qui permet de faire passer des informations texte/ou numerique de l'un à l'autre en utilisant les messages Windows via le handle des fenêtres et les processus.
Cela peut être utile pour par exemple arrête et fermer une application en vu de son
desinstallation. Cela eviterait de killer l'application en cours d'utilisation. Le desinstalleur informe l'appli et l'appli se ferme correctement. Enfin c'est juste un exemple.

Après une recherche sur le Net, j'ai trouvé une source en delphi d'envoi et de reception que j'ai modifier pour Visual Basic : http://alphomega.developpez.com/EchangeVal/

Je me suis donc inspiré de cette source mais il m'a fallu développer une procédure de capture des messages Windows, ce qui m'a été assez dificile.
Je poste cette source car je pense que cela peut vous interesser et les exemples ne sont pas nombreux. De plus, l'utilisation de l'API "GlobalGetAtomName" n'est pas très utilisé.

Source / Exemple : 


'****Code source de l'Application Emetteur - Une forme****
'Le code reste simple
Option Explicit

'****Declaration API****
Private Declare Function RegisterWindowMessage Lib "user32" Alias _
    "RegisterWindowMessageA" (ByVal lpString As String) As Long
Private Declare Function FindWindow Lib "user32" _
   Alias "FindWindowA" _
  (ByVal lpClassName As String, _
   ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long
Private Declare Function GlobalAddAtom Lib "kernel32" _
   Alias "GlobalAddAtomA" _
  (ByVal lpString As String) As Long

Private WM_ENVOI_NUMERIQUE As Long
Private WM_ENVOI_ATOM As Long
Private Envoyer_Atom As Long

Private Sub Command1_Click()
'Declaration des variables
Dim Resultat_Find_Appli As Long
Dim Resultat_Msg As Long

'Trouve le Handle de l'application receveur
Resultat_Find_Appli = FindWindow(vbNullString, "Application_Receveur") 'Nom de la fenetre du receveur, ATTENTION elle doit être unique

'On test pour savoir si l'application receveur du message est en fonctionnement
If Resultat_Find_Appli = 0 Then
  MsgBox "L'application receveur est inactif", vbInformation, "Application Emetteur"
Else
  'Ici la valeur numerique qu'on envoie CLng(Combo1.Text)
  Resultat_Msg = SendMessage(Resultat_Find_Appli, WM_ENVOI_NUMERIQUE, CLng(Combo1.Text), 0)
End If
Combo1.SetFocus
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Command3_Click()
'Declaration des variables
Dim Resultat_Find_Appli As Long
Dim Resultat_Msg As Long

If Len(Text1.Text) = 0 Then 'Test si il y a un texte à envoyer
  MsgBox "Vous devez saisir un texte à envoyer", vbInformation, "Application Emetteur"
  Text1.Text = "Vous devez saisir un texte à envoyer"
Else
  If Len(Text1.Text) > 256 Then 'Test maxi 256 caractères
    MsgBox "Dépassement, votre message est supérieur à 256 caractères", vbInformation, "Application Emetteur"
    Text1.Text = "Dépassement, votre message est supérieur à 256 caractères"
  Else
    'Création d'un atom dans la table globale
    'Notification d'un atom au receveur du message
    Envoyer_Atom = GlobalAddAtom(Text1.Text)
    Resultat_Find_Appli = FindWindow(vbNullString, "Application_Receveur") 'Nom de la fenetre du receveur, ATTENTION elle doit être unique
    'On test pour savoir si l'application receveur en fonctionnement
    If Resultat_Find_Appli = 0 Then
      MsgBox "L'application receveur est inactif", vbInformation, "Application Emetteur"
    Else
    'L'atom est envoyé dans WParam de l'application receveur
    Resultat_Msg = SendMessage(Resultat_Find_Appli, WM_ENVOI_ATOM, Envoyer_Atom, 0)
    Text1.Text = "Ici votre texte à envoyer"
    End If
  End If
End If
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub

Private Sub Form_Load()
'Declaration to register custom messages
WM_ENVOI_NUMERIQUE = RegisterWindowMessage("WM_ENVOI_NUMERIQUE")
WM_ENVOI_ATOM = RegisterWindowMessage("WM_ENVOI_ATOM")

Do Until Combo1.ListCount = 20
  Combo1.AddItem Combo1.ListCount + 1
Loop
Combo1.Text = Combo1.List(0)
Text1.Text = "Ici votre texte à envoyer, 256 caractères maxi"
End Sub
'****Fin du code Application_Emetteur*******************

'****Code source de l'application Receveur - Une forme et un module ****
'Le code du Receveur est un peut plus compliquer
'Le code de la Fom1
Option Explicit

'Constante qui definit la fonction a executer par le Message Handler de Windows
Private Const GWL_WNDPROC = (-4)

'****Declaration API****
Private Declare Function RegisterWindowMessage Lib "user32" Alias _
  "RegisterWindowMessageA" (ByVal lpString As String) As Long
  
Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Form_Load()
'Declaration to register custom messages
WM_ENVOI_NUMERIQUE = RegisterWindowMessage("WM_ENVOI_NUMERIQUE")
WM_ENVOI_ATOM = RegisterWindowMessage("WM_ENVOI_ATOM")

'On remplace l'adresse de la routine Standard par celle de notre procedure => Capture_Message_Windows
'Cela permet de faire passer les messages Windows dans notre procédure Capture_Message_Windows
'Save_WndProc_adresse, récupère l'adresse de la routine standard Windows
Save_WndProc_Adresse = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf Capture_Message_Windows)
End Sub

Private Sub Form_Unload(Cancel As Integer)
'Restauration de l'adresse de la procédure standard avant de sortir du programme => C'est très important car risque de plantage Windows
Call SetWindowLong(Me.hwnd, GWL_WNDPROC, Save_WndProc_Adresse)
End Sub
'****Fin de la Form1****

'****Le module****
Option Explicit

Public Save_WndProc_Adresse As Long ' Adresse de la procédure standard windows

' Cet API insère l'adresse de votre procédure et retourne celle de la procédure standard
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

'Exécute une fonction située à une adresse spécifique en mémoire.
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

'Il est obigatoire de déclarer ces 2 variables en Public
Public WM_ENVOI_NUMERIQUE As Long
Public WM_ENVOI_ATOM As Long

'Modification de nAtom As Integer en nAtom As Long concernant l'API GlobalGetAtomName car j'avais un dépassement de capacité
'API originale : Declare Function GlobalGetAtomName Lib "kernel32.dll" Alias "GlobalGetAtomNameA" _
' (ByVal nAtom As Integer, ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GlobalGetAtomName Lib "kernel32.dll" Alias "GlobalGetAtomNameA" _
 (ByVal nAtom As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GlobalDeleteAtom Lib "kernel32" _
   (ByVal nAtom As Long) As Long

Public Function Capture_Message_Windows(ByVal hwnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
'Procédure de capture des messages Windows

'Interception du message recherché dans uMsg
'Recupération du contenu du message dans wParam
'Numéro del'adresse dans lParam
Select Case uMsg 'On regarde en rapport a nos messages enregistrés dans custom messages
  Case WM_ENVOI_NUMERIQUE 'Réception d'un chiffre
    Form1.Label6.Caption = CStr(wParam)
  Case WM_ENVOI_ATOM 'Réception d'un texte
    Dim Resultat As Long
    Dim Atom_Recu As Long
    Dim Texte_Recu As String * 256
    Atom_Recu = wParam
    Resultat = GlobalGetAtomName(Atom_Recu, Texte_Recu, 256)
    Form1.Label6.Caption = Left$(Texte_Recu, InStr(1, Texte_Recu, Chr$(0)) - 1)
    'Resultat = GlobalDeleteAtom(Resultat)   
    Resultat = GlobalDeleteAtom(Atom_Recu) 'Ne pas oublier de détruire l'atom puisqu'on a récupéré la valeur
  Case Else
    'On laisse passer le reste
End Select

'Les autres messages ne nous intéressant pas nous les faisons traiter par Windows
Capture_Message_Windows = CallWindowProc(Save_WndProc_Adresse, hwnd, uMsg, wParam, lParam)
End Function
'****Fin di module Application_Receveur***********

Conclusion :


C'est juste une démonstration de capture de messages Windows.
Trouver le zip des deux codes sources et exécuté les deux applications en même temps pour voir comment ca marche.

Il y a deux applications, Application Emetteur et Application Receveur.

Bonne prog à tous.
Nocturne.
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
2
Date d'inscription
lundi 12 juillet 2010
Statut
Membre
Dernière intervention
12 juillet 2010
Pb reglé en changeant comme indique plus haut le type long en integer (j'utilise visual basic 2010)
Par contre, lors de l'exécution de mon code, lorsque le receveur existe, j'ai le msg suivant :

Un appel à la fonction PInvoke 'MyFoxKey!WindowsApplication1.ModuleConnection::PostMessage' a déséquilibré la pile. Cela peut se produire, car la signature PInvoke managée ne correspond pas à la signature cible non managée. Vérifiez que la convention d'appel et les paramètres de la signature PInvoke correspondent à la signature non managée cible.

faut-il la aussi declare des integer ???????????
Messages postés
2
Date d'inscription
lundi 12 juillet 2010
Statut
Membre
Dernière intervention
12 juillet 2010
pour une raison X ma fonction findwindows ne retourne jamais 0 meme lorsque la fenetre n'existe pas ??

dim Resultat_Find_Appli as long = 0
Resultat_Find_Appli = FindWindow(vbNullString, "nom_de_fenetre_inexistant")

quelqu'un saurait-il pourquoi ?
Messages postés
24
Date d'inscription
mercredi 8 août 2007
Statut
Membre
Dernière intervention
8 septembre 2009
Hum. Effectivement, cela pourrait améliorer le système d'automatismes de MultiBotSystem en utilisant des applications externes qui lui envoient des requêtes IRC à traiter :p J'avais mon idée pour MBS Remote control Server :p
Merci pour cette source :)
Messages postés
218
Date d'inscription
dimanche 1 mai 2005
Statut
Membre
Dernière intervention
15 novembre 2009
 1
Pourquoi pas fair tout simplement une connexion local comme pratiquement toutes les applications travaillant en doubles processus... ? ( exemple : kaspersky anti-virus, kerio firewall)
Messages postés
241
Date d'inscription
mercredi 1 octobre 2003
Statut
Membre
Dernière intervention
19 février 2006
 2
Hello,

Il n'y a pas de déclaration entre les deux fenètres.
L'emetteur capte tous les messages par hooking, les analyses, puis les transmets uniquement à l'application qui porte un nom bien défini au moment de l'envoi. Le nom, est celui de l'appli qui recoit : Appli_receveur. Si une deuxième appli porte le meme nom, les deux recevront l'atom. Mais il faut que l'appli réceptrice sache le traiter et soit programmer pour capter les messages...
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 (cs_Nocturne)