ECHANGE DE MESSAGES WINDOWS ENTRE DEUX APPLICATIONS

'****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***********