Soyez le premier à donner votre avis sur cette source.
Vue 13 033 fois - Téléchargée 1 186 fois
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.
26 mars 2007 à 11:31
Oui tu a raison, je n'est pas compilé
je l'est fait est c'est trés PRO COM PROG
rien @ dir.
26 mars 2007 à 02:31
@Kimi1632 : as-tu au moins téléchargé, compilé et exécuté la source ?
C'est bien plus poussé et complet que le code que tu proposes !
Pour faire court : ton code ne liste que 10% des processus comparé au code d'OliverDev
@+
Cirec
25 mars 2007 à 23:20
pour lister les process actives il existe
plus simple :
uses TLHLP32;
// voici la procedure avec un memo en paramétre
procedure processActives(M:Tmemo);
var
pHandle:THANDLE;
pEntry32 :TprocessEntry32;
BEGIN
pHandle := CreatetoolHelp32SnapShot(TH32CS_SNAPPROCESS,0);
pEntry32.dwSize := SizeOF(ProcessEntry32);
Process32First(pHandle,pEntry32);
m.Clear;
repeat
m.lines.Add(pEntry32.szExeFile);
Until not
Process32Next(pHandle,pEntry32);
CloseHandle(pHandle);
end;
// fin
GoodCoding
23 oct. 2006 à 02:20
Peut-être aurait-il été judicieux de vérifier que les différentes API utilisées ont fonctionné correctement (par exemple pour OpenProcess, CreateFile, VirtualAlloc etc... il suffit de tester que la valeur retournée est non nulle).
Et certains Handle de process ne sont pas fermés (ceux ouverts avec OpenProcess).
En dehors de ça c'est nickel, vivement d'autres sources!
19 oct. 2006 à 18:26
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.