Module de communication entre application

Commenter

Contenu du snippet

Bonjour,

Avant j'utilisais la méthode DDE pour faire communiquer deux applications, il semble que cela ne puisse malheureusement pas répondre aux attentes de tous le monde, effectivement tous le monde ne peux pas passer par l'événement DDE.

En cherchant a droite a gauche j'ai monté ce module a la demande d'un utilisateur du site, cependant j'espère que certain d'entre vous seront a même de m'aide améliorer ce bout de code.

Mode d'utilisation :
1. Vous créez un nouveau module à votre code
2. Vous collez le code ci dessous dedans
3. Vous ajouter la commande : PROCEDURE_SENDINFINTEREXE Me, "Application Cible", "Message"

Application Cible est le Caption de l'application qui doit recevoir l'information
Message est le message que vous souhaitez transférer.

Source / Exemple : 


'=======================================================================================================
'MODULE DE COMMUNICATION INTER EXÉCUTABLE
'   - On devis la totalité des messages Windows vers l'application qui écoute
'   - Si les message nous intéresse on les traites dans le cas contraire on les rends a Windows
'   - Pour utiliser ce module :
'           1. Mettre dans le Form_Load l'instruction suivante :
'               PROCEDURE_MODEECOUTE Me, True, LBL_AFFICHAGE
'           2. Mettre dans la commande d'envoie d'information :
'               PROCEDURE_SENDINFINTEREXE Me, "Application Cible", "MEDIAVIDEO;POSITIONMINISUB"
'   - ATTENTION, un plantage avec le détournement des messages Windows rend le debugage de l'application très sensible
'=======================================================================================================
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lngParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Global lpPrevWndProc                                As Long
Global gHW                                          As Long

Public Const GWL_WNDPROC = (-4)
Public Const WM_COPYDATA = &H4A                                        'Numero du Message windows

Type COPYDATASTRUCT
    DwData                                          As Long
    CbData                                          As Long
    LpData                                          As Long
End Type

Public Temp                                         As Long
Public TempReceptInformation                        As String
Public ObjectReceptInformation                      As Label

'=======================================================================================================
'PROCEDURE POUR ENVOYER DES INFORMATIONS VERS UNE APPLICATION QUI EST A L'ECOUTE
'=======================================================================================================
'Exemple :
'PROCEDURE_SENDINFINTEREXE Me, "Application Cible", "Message"
'=======================================================================================================
Public Sub PROCEDURE_SENDINFINTEREXE(FormObjectName As Form, CaptionExeDest As String, StrTemp As String)
Dim CdCopyData                                      As COPYDATASTRUCT
Dim ThWnd                                           As Long
Dim ByteBuffer(1 To 255)                            As Byte

ThWnd = FindWindow(vbNullString, CaptionExeDest)                        'Recherche le handle de l'application

Call CopyMemory(ByteBuffer(1), ByVal StrTemp, Len(StrTemp))             'Copie la chaine dans la structure à envoyer
CdCopyData.DwData = 3
CdCopyData.CbData = Len(StrTemp) + 1
CdCopyData.LpData = VarPtr(ByteBuffer(1))
I = SendMessage(ThWnd, WM_COPYDATA, FormObjectName.hwnd, CdCopyData)    'Envoye du message

Do While ObjectReceptInformation.Caption = ""
    ObjectReceptInformation.Caption = "En Attente reception"
Loop

End Sub

'=======================================================================================================
'PROCEDURE POUR ENVOYER DES INFORMATIONS VERS UNE APPLICATION QUI EST A L'ECOUTE
'=======================================================================================================
'Attention le LabelObject est optionnel mais uniquement sur un retour de procedure de Ecoute a False
'=======================================================================================================
Public Sub PROCEDURE_MODEECOUTE(FormObject as Form, EcouteMode As Boolean, Optional LabelObject As Label)
gHW = FormObject.hwnd
Select Case EcouteMode 
    Case True                                                           'Détourne les Messages windows vers la fonction WindowProc
        lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)
        Set ObjectReceptInformation = LabelObject
    Case False                                                          'Demande à Windows de ne plus envoyer les Message
        Temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
        Set ObjectReceptInformation = Nothing
End Select

End Sub

'=======================================================================================================
'FONCTION SUR ECOUTE INTERCEPTE ET INTERPRETE LES MESSAGE WINDOWS UTILE POUR LE HOOK = TRUE
'=======================================================================================================
Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lngParam As Long) As Long
If uMsg = WM_COPYDATA Then                                          'On reçoit TOUS les messages mais seul WM_COPYDATA nous interresse
    Call InterProcessComms(lngParam)                                'On appel la procedure d'analyse du message
End If                                                              'Si le message n'est pas interressant on les rend à Windows pour les gérer
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lngParam)

End Function

'=======================================================================================================
'PROCEDURE PERMETTANT D'AFFICHER LE MESSAGE EN PROVENANCE DE L'ECOUTE SUR LA FONCTION WINDOWPROC
'=======================================================================================================
Sub InterProcessComms(lngParam As Long)
Dim CdCopyData                                      As COPYDATASTRUCT
Dim ByteBuffer(1 To 255)                            As Byte
Dim StrTemp                                         As String

Call CopyMemory(CdCopyData, ByVal lngParam, Len(CdCopyData))
Select Case CdCopyData.DwData
    Case 1
        Debug.Print "1"
    Case 2
        Debug.Print "2"
    Case 3
        Call CopyMemory(ByteBuffer(1), ByVal CdCopyData.LpData, CdCopyData.CbData)
        StrTemp = StrConv(ByteBuffer, vbUnicode)
        StrTemp = Left$(StrTemp, InStr(1, StrTemp, Chr$(0)) - 1)
        ObjectReceptInformation.Caption = StrTemp
End Select

End Sub

Conclusion :


Comme je l'ai dit plus haut. Détourner les messages Windows rends le debugage de l'application très très sensible. Je vous suggère de ne pas avoir d'erreur si vous avez déjà lancé la procédure de réception d'information !

Si quelqu'un (Reinfield vu que tu vas sans doute être le premier a poste :p) a une idée pour éviter le plantage de VB quand on passe en debugage.

P.S. Un grand merci a Sephiro pour le code initial

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.

Du même auteur (PROTEUS91)