MODULE DE COMMUNICATION ENTRE APPLICATION

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