Soyez le premier à donner votre avis sur cette source.
Vue 15 858 fois - Téléchargée 1 585 fois
'****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***********
12 juil. 2010 à 13:12
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 ???????????
12 juil. 2010 à 12:37
dim Resultat_Find_Appli as long = 0
Resultat_Find_Appli = FindWindow(vbNullString, "nom_de_fenetre_inexistant")
quelqu'un saurait-il pourquoi ?
8 nov. 2008 à 13:16
Merci pour cette source :)
30 janv. 2007 à 14:34
25 janv. 2006 à 23:01
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...
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.