LISTER LES PROCESSUS SYSTÈMES EN COURS DE FONCTIONNEMENT

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListeFen: TTreeView;
    ImageList1: TImageList;
    Label1: TLabel;
    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 prototypes 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'une structure 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..255] Of 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 processus
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 processus actifs
  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=1) Then
  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.