Developpez.com - Delphi
X

Choisissez d'abord la catégorieensuite la rubrique :

Nono40.developpez.com
Le petit coin du web de Nono40
SOURCES TESTS DELPHI WIN32 AUTOMATISMES DELPHI .NET QUICK-REPORT
Retour à l'accueil
61 - EXPLORATEUR DE FENÊTRES

PRÉSENTATION : Explorer les fenêtre des autres applications
ZIP : Téléchargez le zip APERÇUS :

NOTES : Ce programme n'est qu'a son début. Il montre comment obtenir la liste des process et ensuite la liste des threads de chaque process. Enfin, pour chaque tread, la liste des fenêtres filles avec leur caractéristiques.
Ce programme sera compléter de temps en temps pour obtenir un maximum d'information sur les autres fenêtres.

CODE :
Unit Unit1;
//
// Sujet : Enumération des fenêtres d'une application
//
// Par Nono40 : http://nono40.developpez.com   http://nono40.fr.st
//              mailTo:nono40@fr.st
//
// Le 13/07/2003
//

Interface

Uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ImgList;

Type
  TForm1 = Class(TForm)
    ListeFen: TTreeView;
    ImageList1: TImageList;
    Procedure Form1Show(Sender: TObject);
    Procedure ListeFenExpanded(Sender: TObject; Node: TTreeNode);
  Private
    { Déclarations privées }
  Public
    { Déclarations publiques }
  End;

Var
  Form1: TForm1;

Implementation

{$R *.dfm}

Uses tlHelp32;

Type
  // Définition des prototype d'allocation étendue.
  // Les liens sont ici dynamiques afin de ne pas faire d'erreur
  // dans les applications Win9x
  TVirtualAllocEx = Function (hProcess : THandle;
    lpAddress : Pointer; dwSize, flAllocationType : DWORD;
    flProtect : DWORD) : Pointer; stdcall;
  TVirtualFreeEx = Function (hProcess : THandle;
    lpAddress : Pointer; dwSize, dwFreeType : DWORD) : Pointer;
    stdcall;

  // Définition d'unestructure pouvant contenir tout ce qui est utile
  // sur un Item. C'est ce type de structure qui est allouée en partage
  // sous Win9x ou allouée dans la mémoire de EXPLORER.EXE dans le cas
  // de WinNT.
  PDatas = ^TDatas;
  TDatas = Array[0..255Of Char;

Var
  HandleMAP  :THandle;  // Handle du mapping pour les système Win9x
  ProcessMEM :Cardinal; // Handle du process propriétaire de la ListView
  DatasMEM   :PDatas;   // Pointeur sur la mémoire allouée
  Datas      :TDatas;   // Données locales sur l'item

  WindowsNT      :Boolean;
  VirtualAllocEx :TVirtualAllocEx;
  VirtualFreeEx  :TVirtualFreeEx;

Const
  SB_GETPARTS = WM_USER + 6;
  SB_GETTEXT  = WM_USER + 2;

  TailleMap=SizeOf(TDatas);

// Procédure de copie de la mémoire allouée dans le process
// ou le memory-mapping vers la mémoire locale
Procedure LecturePartage;
Var N:Cardinal;
Begin
  If WindowsNT
    Then ReadProcessMemory(ProcessMEM, DatasMEM, @Datas, SizeOf(Datas), N)
    Else Datas:=DatasMEM^;
End;

// Procédure de copie de la mémoire locale vers la mémoire allouée
// dans le process ou le memory-mapping
Procedure EcriturePartage;
Var N:Cardinal;
Begin
  If WindowsNT
    Then WriteProcessMemory(ProcessMEM, DatasMEM, @Datas, SizeOf(Datas), N)
    Else DatasMEM^:=Datas;
End;

// Allocation de la mémoire pour les échanges des données sur les items
//  Win9x : création d'un MemoryMapping
//  WinNT : allocation dans la mémoire de Explorer.exe
Procedure CreationPartage(ProcessID :Cardinal);
Begin
  If WindowsNT
  Then Begin
    // Obtention d'un Handle de process à partir de l'identificateur
    ProcessMEM := OpenProcess(PROCESS_ALL_ACCESS,False,ProcessID);
    // Allocation d'une zone dans le Process obtenu
    DatasMEM   := VirtualAllocEx(ProcessMEM
                                , Nil
                                , TailleMAP
                                , MEM_COMMIT
                                , PAGE_READWRITE);
  End
  Else Begin
    // Création d'un mapping mémoire
    HandleMAP:=CreateFileMapping(
          $FFFFFFFF           // Handle mémoire
          ,Nil                // Sécurité par défaut
          ,PAGE_READWRITE     // Accès en lecture/écriture
          ,0                  // Taille de la zone partagée   HIGH
          ,TailleMAP          // Taille de la zone partagée   LOW
          ,'LISTVIEWINFO');   // Nom du partage
    DatasMEM:=MapViewOfFile(
          HandleMAP           // Handle du partage mémoire
          ,FILE_MAP_WRITE     // Accès en lecture/écriture
          ,0                  // Début de la zone  HIGH
          ,0                  // Début de la zone  LOW
          ,0);                // Zone entière
  End;
  EcriturePartage;
End;

// Libération de ce qui à été alloué précédemment
Procedure FinPartage;
Begin
  If WindowsNT
  Then Begin
    VirtualFreeEx(ProcessMEM, DatasMEM, 0, MEM_RELEASE);
  End
  Else Begin
    UnMapViewOfFile(DatasMEM);
    CloseHandle    (HandleMAP);
  End;
End;

// Procédure de recherche des propriétés d'une fenêtre
Procedure ListeProprietes(H:THandle;NodeParent:TTreeNode);
Var BuffTexte  : Array[0..255]Of Char;
    BuffClasse : Array[0..255]Of Char;
    Classe     : String;
    Node       : TTreeNode;
    Rect       : TRect;
    Long       : Cardinal;
    Style      : String;
    Liste      : TStrings;
    Nombre     : Integer;
    i          : Integer;
Begin
  // Obtention du nom de la classe
  GetClassName (H,@BuffClasse,SizeOf(BuffClasse));
  Classe       :=UpperCase(BuffClasse);

  // Obtention du style de la fenêtre
  Long:=GetWindowLong(H,GWL_STYLE);
  Style:=IntToHex(Long,8);
  If (Long And WS_BORDER            )<>0 Then Style:=Style+' WS_BORDER';
  If (Long And WS_CAPTION           )<>0 Then Style:=Style+' WS_CAPTION';
  If (Long And WS_CHILD             )<>0 Then Style:=Style+' WS_CHILD';
  If (Long And WS_CLIPCHILDREN      )<>0 Then Style:=Style+' WS_CLIPCHILDREN';
  If (Long And WS_CLIPSIBLINGS      )<>0 Then Style:=Style+' WS_CLIPSIBLINGS';
  If (Long And WS_DISABLED          )<>0 Then Style:=Style+' WS_DISABLED';
  If (Long And WS_DLGFRAME          )<>0 Then Style:=Style+' WS_DLGFRAME';
  If (Long And WS_GROUP             )<>0 Then Style:=Style+' WS_GROUP';
  If (Long And WS_HSCROLL           )<>0 Then Style:=Style+' WS_HSCROLL';
  If (Long And WS_ICONIC            )<>0 Then Style:=Style+' WS_ICONIC';
  If (Long And WS_MAXIMIZE          )<>0 Then Style:=Style+' WS_MAXIMIZE';
  If (Long And WS_MAXIMIZEBOX       )<>0 Then Style:=Style+' WS_MAXIMIZEBOX';
  If (Long And WS_MINIMIZE          )<>0 Then Style:=Style+' WS_MINIMIZE';
  If (Long And WS_OVERLAPPED        )<>0 Then Style:=Style+' WS_OVERLAPPED';
  If (Long And WS_OVERLAPPEDWINDOW  )<>0 Then Style:=Style+' WS_OVERLAPPEDWINDOW';
  If (Long And WS_POPUP             )<>0 Then Style:=Style+' WS_POPUP';
  If (Long And WS_POPUPWINDOW       )<>0 Then Style:=Style+' WS_POPUPWINDOW';
  If (Long And WS_SIZEBOX           )<>0 Then Style:=Style+' WS_SIZEBOX';
  If (Long And WS_SYSMENU           )<>0 Then Style:=Style+' WS_SYSMENU';
  If (Long And WS_TABSTOP           )<>0 Then Style:=Style+' WS_TABSTOP';
  If (Long And WS_THICKFRAME        )<>0 Then Style:=Style+' WS_THICKFRAME';
  If (Long And WS_TILED             )<>0 Then Style:=Style+' WS_TILED';
  If (Long And WS_TILEDWINDOW       )<>0 Then Style:=Style+' WS_TILEDWINDOW';
  If (Long And WS_VISIBLE           )<>0 Then Style:=Style+' WS_VISIBLE';
  If (Long And WS_VSCROLL           )<>0 Then Style:=Style+' WS_VSCROLL';
  With Form1.ListeFen.Items.AddChild(NodeParent,Style) Do
  Begin
    ImageIndex    := 7;
    SelectedIndex := 7;
  End;

  // Obtention du texte standard, WM_GETTEXT fonctionne bien pour
  // les contrôle de base, mais au dela...
  SendMessage  (H,WM_GETTEXT ,SizeOf(BuffTexte ),Integer(@BuffTexte));
  With Form1.ListeFen.Items.AddChild(NodeParent,'"'+String(BuffTexte)+'"'Do
  Begin
    ImageIndex    := 5;
    SelectedIndex := 5;
  End;

  // Obtention de la taille et position de la fenêtre
  GetWindowRect(H,Rect);
  With Form1.ListeFen.Items.AddChild(NodeParent
         ,'Top='    +IntToStr(Rect.Top)   +' Left=' +IntToStr(Rect.Left)
         +' Bottom='+IntToStr(Rect.Bottom)+' Right='+IntToStr(Rect.Right)) Do
  Begin
    ImageIndex    := 6;
    SelectedIndex := 6;
  End;

  // Obtention des infos plus détaillées pour certaines classes
  Liste:=TstringList.Create;
  Try
    If (Classe='COMBOBOX'  )Or(Classe='TCOMBOBOX')
     Or(Classe='LISTBOX'   )Or(Classe='TLISTBOX' )
     Or(Classe='TSTATUSBAR')Or(Classe='MSCTLS_STATUSBAR32'Then
    Begin
      // Liste des items d'une ComboBox
      If (Classe='COMBOBOX')Or(Classe='TCOMBOBOX'Then
      Begin
        Nombre:=SendMessage(H,CB_GETCOUNT,0,0);
        If Nombre<>CB_ERR Then For i:=0 To Nombre-1 Do
        Begin
          If SendMessage(H,CB_GETLBTEXT,i,Integer(@BuffTexte))<>CB_ERR
            Then Liste.Add(BuffTexte);
        End;
      End;

      // Liste des items d'une ListBox
      If (Classe='LISTBOX')Or(Classe='TLISTBOX'Then
      Begin
        Nombre:=SendMessage(H,LB_GETCOUNT,0,0);
        If Nombre<>LB_ERR Then For i:=0 To Nombre-1 Do
        Begin
          If SendMessage(H,LB_GETTEXT,i,Integer(@BuffTexte))<>CB_ERR
            Then Liste.Add(BuffTexte);
        End;
      End;

      // Liste des items d'un StatusBar
      If (Classe='TSTATUSBAR')Or(Classe='MSCTLS_STATUSBAR32'Then
      Begin
        Nombre:=SendMessage(H,SB_GETPARTS,0,0);
        If Nombre<>0 Then For i:=0 To Nombre-1 Do
        Begin
          FillChar(BuffTexte,SizeOf(BuffTexte),#0);
          If SendMessage(H,SB_GETTEXT,i,Integer(DatasMEM))<>0 Then
          Begin
            LecturePartage;
            Liste.Add(Datas);
          End;
        End;
      End;

      // Ajout de la liste des items trouvés
      Node:=Form1.ListeFen.Items.AddChild(NodeParent,'Items:('+IntToStr(Liste.Count)+')');
      With Node Do
      Begin
        ImageIndex    := 8;
        SelectedIndex := 8;
        For i:=0 To Liste.Count-1 Do
          With Form1.ListeFen.Items.AddChild(Node,Liste[i]) Do
          Begin
            ImageIndex    := -1;
            SelectedIndex := -1;
          End;
      End;
    End;
  Finally
    Liste.Free;
  End;
End;

// Procédure appelée par l'énumération des fenêtre d'un process
Function EnumThreadWindowProc(H:THandle;NodeParent:TTreeNode):Bool;Stdcall;
Var BuffTexte  : Array[0..255]Of Char;
    BuffClasse : Array[0..255]Of Char;
    Node       : TTreeNode;
Begin
  GetWindowText(H,@BuffTexte ,SizeOf(BuffTexte));
  GetClassName (H,@BuffClasse,SizeOf(BuffClasse));
  Node:= Form1.ListeFen.Items.AddChild(NodeParent,IntToHex(H,8)
                    +' = '+BuffClasse+' "'+BuffTexte+'"');
  With Node Do
  Begin
    Data          := Pointer(0);
    ImageIndex    := 2;
    SelectedIndex := 2;
    ListeProprietes(H,Node);
    With Form1.ListeFen.Items.AddChild(Node,'Fenêtres filles :'Do
    Begin
      Data          := Pointer(h);
      ImageIndex    := 4;
      SelectedIndex := 4;
      HasChildren   := True;
    End;
  End;
  Result:=True;
End;

Procedure TForm1.Form1Show(Sender: TObject);
Var h     :THandle;
    Pe32  :TProcessEntry32;
    Te32  :TThreadEntry32;
    NodeP :TTreeNode;
    NodeT :TTreeNode;
Begin
  h := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD,0);
  Pe32.dwSize := sizeof(Pe32);

  // Enumération des process
  If Process32First(h,Pe32) Then
  Repeat
    NodeP:=ListeFen.Items.AddChild(Nil,IntToHex(Pe32.th32ProcessID,8)+' = '+Pe32.szExeFile);
    NodeP.Data          :=Pointer(Pe32.th32ProcessID);
    NodeP.ImageIndex    :=0;
    NodeP.SelectedIndex :=0;
    // Recherche des Thread appartenant aux process
    Te32.dwSize := SizeOf(Te32);
    If Thread32First(h,Te32) Then
    Repeat
      If Te32.th32OwnerProcessID=Pe32.th32ProcessID Then
      Begin
        NodeT:=ListeFen.Items.AddChild(NodeP,IntToHex(Te32.th32ThreadID,8));
        NodeT.Data := Pointer(Te32.th32ThreadID);
        NodeT.ImageIndex    := 1;
        NodeT.SelectedIndex := 1;
        // Recherche des fenêtres appartenant aux Thread
        EnumThreadWindows(Te32.th32ThreadID,@EnumThreadWindowProc,Integer(NodeT));
      End;
    Until Not Thread32Next(h,Te32)
    Else RaiseLastOSError;
  Until Not Process32Next(h,Pe32);
  Te32.dwSize := sizeof(Te32);
  CloseHandle(h);
End;

Function EnumChildProc(H:THandle;NodeParent:TTreeNode):Bool;Stdcall;
Var BuffTexte  : Array[0..255]Of Char;
    BuffClasse : Array[0..255]Of Char;
    Node       : TTreeNode;
Begin
  If GetParent(H)=Cardinal(NodeParent.Data) Then
  Begin
    GetClassName (H,@BuffClasse,SizeOf(BuffClasse));
    SendMessage  (H,WM_GETTEXT ,SizeOf(BuffTexte ),Integer(@BuffTexte));

    Node := Form1.ListeFen.Items.AddChild(NodeParent,IntToHex(H,8)+' = '+BuffClasse+' "'+BuffTexte+'"');
    With Node Do
    Begin
      Data          := Pointer(h);
      ImageIndex    := 3;
      SelectedIndex := 3;
    End;
    ListeProprietes(H,Node);
    Node:= Form1.ListeFen.Items.AddChild(Node,'Fenêtres filles :');
    With Node Do
    Begin
      Data          := Pointer(h);
      ImageIndex    := 4;
      SelectedIndex := 4;
      EnumChildWindows(H,@EnumChildProc,Integer(Node));
      If Count=0 Then Delete;
    End;
  End;
  Result:=True;
End;

Procedure TForm1.ListeFenExpanded(Sender: TObject; Node: TTreeNode);
Var i,j :Integer;
    h   :THandle;
Begin
  // On met à jour les fenêtres des Thread que sur demande
  If   (Node<>Nil)
    And(Node.Level=1Then
  Try
    // Le champ tag du niveau supérieur ( Process ) donne
    // le ProcessID du thread en question. Une zone mémoire
    // est alors demandée pour accéder aux données de l'autre
    // application.
    CreationPartage(Cardinal(Node.Parent.Data));
    For j:=0 To Node.Count-1 Do
    Begin
      For i:=Node.Item[j].Count-1 Downto 0 Do With Node.Item[j].Item[i] Do
      Begin
        If Count=0 Then
        Begin
          H:= THandle(Data);
          If H<>0 Then
          Begin
            EnumChildWindows(H,@EnumChildProc,Integer(Node.Item[j].Item[i]));
            If Count=0 Then Delete;
          End;
        End;
      End;
    End;
  Finally
    // Libération de la zone mémoire réservée.
    FinPartage;
  End;

End;

Initialization
  // Obtention des routines utilisées sous WinNT
  WindowsNT:= Win32Platform = VER_PLATFORM_WIN32_NT;
  If WindowsNT Then
  Begin
    @VirtualAllocEx := GetProcAddress(
                  GetModuleHandle('KERNEL32.DLL'),'VirtualAllocEx');
    @VirtualFreeEx  := GetProcAddress(
                  GetModuleHandle('KERNEL32.DLL'),'VirtualFreeEx');
  End;
Finalization
end.

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2003 Bruno Guérangé. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.

Responsables bénévoles de la rubrique Delphi : Gilles Vasseur - Alcatîz -