I have this code:
procedure TForm1.Button1Click(Sender: TObject);
var
MyHandle: THandle;
begin
MyHandle:=FindWindow(nil, 'Delphi');
SendMessage(MyHandle, WM_CLOSE, 0, 0);
// Here will be a message like ' title found and it's test.exe that has 'Delphi' Title
end;
For example, it is test.exe that is the process that has the 'Delphi' title, and I want to get the EXE file name of that process by using the window handle. Is that possible? If so, may I have some reference for doing it?
Given any valid HWND, you can do the following:
use GetWindowThreadProcessId() to get the process ID that created it.
then use OpenProcess() to open a HANDLE to that process.
then use either GetModuleFileNameEx(), GetProcessImageFileName(), or QueryFullProcessImageName() (depending on OS version) to get the file path of the EXE that created that process.
Here is a procedure which I use, which you are likely to find in other places on the internet. I don't recall the exact source, it may have been https://www.swissdelphicenter.ch.
uses
Windows, TlHelp32, ...
function WindowHandleToEXEName(handle : THandle) : string;
var
snap : THandle;
pe : tagPROCESSENTRY32;
pid : THandle;
found : boolean;
begin
Windows.SetLastError(ERROR_SUCCESS);
result := '';
if (handle = 0) then exit;
snap := TLHelp32.CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if (snap = Cardinal(-1)) then exit;
Windows.GetWindowThreadProcessId(handle, #pid);
pe.dwSize := Sizeof(pe);
found := TLHelp32.Process32First(snap, pe);
while found do
begin
if (pe.th32ProcessID = pid) then
begin
result := String(pe.szExeFile);
break;
end;
found := TLHelp32.Process32Next(snap, pe);
end;
CloseHandle(snap);
end;
Related
I'm trying to verify whether a resource exists in another Delphi application, the problem is that only know how to do it locally, I mean in the application itself.
Source:
function exists_resource(name: string): boolean;
begin
if (FindResource(HInstance, PChar(name), RT_RCDATA) <> 0) then
begin
Result := True;
end
else
begin
Result := False;
end;
end;
As I can verify this in a different application?
Use LoadLibraryEx to load the external file.
function exists_resource(const name, filename: string): boolean;
var
HInst: THandle;
begin
HInst:= LoadLibraryEx(PChar(Filename), 0, LOAD_LIBRARY_AS_DATAFILE or LOAD_LIBRARY_AS_IMAGE_RESOURCE);
//Win32Check(HInst); //Uncomment if you want to generate errors.
if HInst = 0 then exit(false);
try
Exit((FindResource(HInst, PChar(name), RT_RCDATA) <> 0));
finally
FreeLibrary(Hinst);
end; {try}
end;
Note that using LoadLibraryEx in this way will work for loading both dll's and exe's.
We want a program of ours in D7 to know if it was run via a ShellExecute command from one of our apps, or directly started by the user.
Is there a reliable way for a Delphi 7 program to determine the name of the program that ran it?
We of course could have our parent program use a command line argument or other flag, but we'd prefer the above approach.
TIA
There's no way to do what you want, I'm afraid. The application isn't told whether it's being run pro grammatically via ShellExecute (or CreateProcess), via a command line, a shortcut, or a double-click in Explorer.
Raymond Chen did an article a while back on this very topic, if I remember correctly; I'll see if I can find it and update my answer here.
Based on another answer and some code on Torry.net, I came to this function to get the parent process id. It seems to return a relevant number on Windows 7, and the windows functions it uses should be available at least since Win 2000.
uses Tlhelp32;
function GetProcessInfo(ProcessId: Cardinal; out ParentProcessId: Cardinal; out ExeFileName: string): Boolean;
var
hSnapShot: THandle;
ProcInfo: TProcessEntry32;
begin
hSnapShot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if (hSnapShot <> THandle(-1)) then
try
ProcInfo.dwSize := SizeOf(ProcInfo);
if (Process32First(hSnapshot, ProcInfo)) then
repeat
if ProcInfo.th32ProcessID = ProcessId then
begin
ExeFileName := string(ProcInfo.szExeFile);
ParentProcessId := ProcInfo.th32ParentProcessID;
Result := True;
Exit;
end;
until not Process32Next(hSnapShot, ProcInfo);
finally
CloseHandle(hSnapShot);
end;
Result := False;
end;
procedure Test;
var
ProcessId, ParentProcessId, Dummy: Cardinal;
FileName: string;
begin
ProcessId := GetCurrentProcessId();
// Get info for current process
if GetProcessInfo(ProcessId, ParentProcessId, FileName) then
// Get info for parent process
if GetProcessInfo(ParentProcessId, Dummy, FileName) then
// Show it.
ShowMessage(IntToStr(ParentProcessId) + FileName);
end;
A word of caution! The parent process may no longer exist. Even worse, it's ID may have been recycled, causing this function to give you a different process than you asked for.
The simple answer is "No".
A more complex answer is "Not as easily as simply passing a command line param would be".
:)
What you need to do is identify the parent process of your process. Obtaining this is possible but not straightforward. Details of how to go about it can be obtained in this CodeProject article.
The biggest problem is that there is not strict hierarchical relationship between processes in Windows and PID (Process ID's) may be re-used. The PID you identify as your "parent" may not be your parent at all. If the parent process has subsequently terminated then it's PID may be re-used which could lead to some seemingly perplexing results ("My process was started by calc.exe? How is that possible?").
Trying to find bullet, water and idiot proof mechanisms to protect against the possible ways such a process might fail will be significantly more effort than simply devising and implementing a command line based convention between your launcher applications and the launchee by which the latter may identify the former.
A command line parameter is one such option but could be "spoofed" (if someone figures out what you are passing on the command line and for some reason could derive some value or benefit from mimicking this themselves).
Depending on how reliable and tamper proof you need the mechanism to be, this could still be enough however.
I've found getpids which does it using NtQueryInformationProcess to not only to obtain the parent process ID but also compare the process creation times - if the reported parent process was created after the child it means the reported parent ID has already been recycled.
Here is my Delphi unit I wrote to test it:
unit ProcInfo;
interface
uses
Windows, SysUtils;
function GetParentProcessId(ProcessID: DWORD; out ProcessImageFileName: string): DWORD; overload;
implementation
uses
PsApi;
var
hNtDll: THandle;
NtQueryInformationProcess: function(ProcessHandle: THandle; ProcessInformationClass: DWORD;
ProcessInformation: Pointer; ProcessInformationLength: ULONG; ReturnLength: PULONG): DWORD; stdcall;
const
UnicodeStringBufferLength = 1025;
type
PPEB = Pointer; // PEB from winternl.h not needed here
PPROCESS_BASIC_INFORMATION = ^PROCESS_BASIC_INFORMATION;
PROCESS_BASIC_INFORMATION = record
Reserved1: Pointer; // exit status
PebBaseAddress: PPEB;
Reserved2: array[0..1] of Pointer; // affinity mask, base priority
UniqueProcessId: ULONG_PTR;
Reserved3: Pointer; // parent process ID
end;
PProcessBasicInformation = ^TProcessBasicInformation;
TProcessBasicInformation = PROCESS_BASIC_INFORMATION;
PKernelUserTimes = ^TKernelUserTimes;
TKernelUserTimes = record
CreateTime: LONGLONG;
ExitTime: LONGLONG;
KernelTime: LONGLONG;
UserTime: LONGLONG;
end;
PUNICODE_STRING = ^UNICODE_STRING;
UNICODE_STRING = record
Length: USHORT;
MaximumLength: USHORT;
PBuffer: PChar;
Buffer: array[0..UnicodeStringBufferLength - 1] of Char;
end;
PUnicodeString = ^TUnicodeString;
TUnicodeString = UNICODE_STRING;
function GetProcessCreateTime(hProcess: THandle): LONGLONG;
var
ProcessTimes: TKernelUserTimes;
begin
Result := 0;
FillChar(ProcessTimes, SizeOf(ProcessTimes), 0);
if NtQueryInformationProcess(hProcess, 4, #ProcessTimes, SizeOf(ProcessTimes), nil) <> 0 then
Exit;
Result := ProcessTimes.CreateTime;
end;
function GetProcessParentId(hProcess: THandle): DWORD;
var
ProcessInfo: TProcessBasicInformation;
begin
Result := 0;
FillChar(ProcessInfo, SizeOf(ProcessInfo), 0);
if NtQueryInformationProcess(hProcess, 0, #ProcessInfo, SizeOf(ProcessInfo), nil) <> 0 then
Exit;
Result := DWORD(ProcessInfo.Reserved3);
end;
function GetProcessImageFileName(hProcess: THandle): string;
var
ImageFileName: TUnicodeString;
begin
Result := '';
FillChar(ImageFileName, SizeOf(ImageFileName), 0);
ImageFileName.Length := 0;
ImageFileName.MaximumLength := UnicodeStringBufferLength * SizeOf(Char);
ImageFileName.PBuffer := #ImageFileName.Buffer[0];
if NtQueryInformationProcess(hProcess, 27, #ImageFileName, SizeOf(ImageFileName), nil) <> 0 then
Exit;
SetString(Result, ImageFileName.PBuffer, ImageFileName.Length);
end;
function GetParentProcessId(ProcessId: DWORD; out ProcessImageFileName: string): DWORD;
var
hProcess, hParentProcess: THandle;
ProcessCreated, ParentCreated: LONGLONG;
begin
Result := 0;
ProcessImageFileName := '';
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessId);
if hProcess = 0 then
RaiseLastOSError;
try
Result := GetProcessParentId(hProcess);
if Result = 0 then
Exit;
ProcessCreated := GetProcessCreateTime(hProcess);
finally
CloseHandle(hProcess);
end;
hParentProcess := OpenProcess(PROCESS_QUERY_INFORMATION, False, Result);
if hParentProcess = 0 then
RaiseLastOSError;
try
ParentCreated := GetProcessCreateTime(hParentProcess);
if ParentCreated > ProcessCreated then
begin
Result := 0;
Exit;
end;
ProcessImageFileName := GetProcessImageFileName(hParentProcess);
finally
CloseHandle(hParentProcess);
end;
end;
initialization
hNtDll := GetModuleHandle('ntdll.dll');
if hNtDll <> 0 then
NTQueryInformationProcess := GetProcAddress(hNtDll, 'NtQueryInformationProcess');
end.
When I run the code from the IDE, I get the following results:
parent ID: 5140, parent image file name:
"\Device\HarddiskVolume1\Program Files\Embarcadero\RAD
Studio\8.0\bin\bds.exe"
so you may need to find a way to translate that into a "normal" path, e.g. "C:\Program Files\Embarcadero\RAD Studio\8.0\bin\bds.exe".
I'd like to automatically checkout a file when I start to edit it in Delphi 7 IDE.
ClearCase is my version control system and I really hate the need to checkout a file before starting to edit. It always breaks my thought flow: I'm trying to solve a problem, find where I need to change, try to edit it, fail because the file is read only, open clearcase, search the file, finally checkout, try to edit the file again, fail because the IDE still thinks it is readonly, tell the IDE that isn't readonly. When I finally go back to code, I forgot what I was trying do do.
I've found this nice and simple ClearCase IDE integration code. It works, but uses the deprecated ToolIntf unit. I've added a couple of shortcuts. Here is a simplified version of it (didn't try to compile):
unit clearcase;
interface
uses ToolsApi, ToolIntf;
implementation
uses
Windows, Dialogs, Classes, ExptIntf, Menus, ShellApi, SysUtils;
type
TDelphiClearcase = class
private
FClearcaseMenu,
FDoCheckOutPasDfm,
FDoCheckInPasDfm : TIMenuItemIntf;
procedure ExecCommand(const command: string; path: PChar = nil);
public
destructor Destroy;override;
procedure DoClick(Sender: TIMenuItemIntf);
property ClearcaseMenu: TIMenuItemIntf read FClearcaseMenu write FClearcaseMenu;
property DoCheckOutPasDfm:TIMenuItemIntf write FDoCheckOutPasDfm;
property DoCheckInPasDfm: TIMenuItemIntf write FDoCheckInPasDfm;
end;
var
dcc: TDelphiClearcase = nil;
{ TDelphiClearcase }
destructor TDelphiClearcase.Destroy;
procedure Remove(item: TIMenuItemIntf);
begin
if( item = nil )then
Exit;
item.DestroyMenuItem;
FreeAndNil(item);
end;
begin
Remove(FDoCheckOutPasDfm);
Remove(FDoCheckInPasDfm);
inherited;
end;
procedure TDelphiClearcase.DoClick(Sender: TIMenuItemIntf);
function GetPasDfm(const f: string): string;
var
aux: string;
begin
aux := Copy(f, 1, Length(f) - 4);
Result := aux + '.pas' + ' ' + aux + '.dfm'
end;
var
command, fileName : string;
begin
fileName := ToolServices.GetCurrentFile;
if( Sender = FDoCheckOutPasDfm )then
command := 'cleartool co ' + GetPasDfm(fileName)
else if( Sender = FDoCheckInPasDfm )then
command := 'cleartool ci ' + GetPasDfm(fileName);
ExecCommand(command);
ToolServices.ReloadFile(fileName);
end;
procedure TDelphiClearcase.ExecCommand(const command: string; path: PChar);
var
pi : TProcessInformation;
stinfo : TStartupInfo;
begin
FillChar(stinfo, SizeOf(stinfo), 0);
stinfo.cb := SizeOf(stinfo);
if( CreateProcess(nil, PChar(command), nil, nil, True, CREATE_NEW_CONSOLE,
nil, path, stinfo, pi) )then begin
WaitForSingleObject(pi.hProcess, INFINITE);
CloseHandle(pi.hProcess)
end
end;
procedure CreateMenus;
var
services: TIToolServices;
begin
if( BorlandIDEServices = nil )then
Exit;
services := ToolServices;
if( services = nil )then
Exit;
dcc := TDelphiClearcase.Create;
dcc.ClearcaseMenu := services.GetMainMenu.GetMenuItems.InsertItem(6,
'C&learcase', 'ClearcaseMenu', 'ClearcaseTools', 0, 0, 0,
[mfEnabled, mfVisible], nil);
dcc.DoCheckOutPasDfm := dcc.ClearcaseMenu.InsertItem(2,
'Check Out pas and dfm', 'DoCheckOutPasDfm', 'Undo the check outs', ShortCut(Ord('>'),
[ssCtrl]), 0, 2,
[mfEnabled, mfVisible], dcc.DoClick);
dcc.DoCheckInPasDfm:= dcc.ClearcaseMenu.InsertItem(4,
'Check In pas and dfm', 'DoCheckInPasDfm', 'Check in current files', ShortCut(Ord('<'),
[ssCtrl]), 0, 2,
[mfEnabled, mfVisible], dcc.DoClick);
end;
procedure DestroyMenus;
begin
FreeAndNil(dcc);
end;
initialization
CreateMenus;
finalization
DestroyMenus
end.
I'd like to checkout the file when I first start editing it and it is read only. I have no idea how to hook a function to the IDE edit event of a file. Any pointers are welcome.
Aternative to writing API or the like is to simply use snapshot views and automatically write files using "Highjack" functionality ...then just check'em in later.
Alternatively you can use the open ToolsAPI to listen for changes in the editor and checkout the file when the user has changed any of the content in the file.
I want to make a Task Manager program that displays this information:
Image name
memory usage
PID
How can I do this?
You don't need the J(WS)CL therefore, there is a simple WinAPI call that does almost all you want, and this is CreateToolhelp32Snapshot. To get a snapshot of all running processes, you have to call it as follows:
var
snapshot: THandle;
begin
snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
Now you have a list of all running processes. You can navigate through this list with the Process32First and Process32Next functions, the list entries are PROCESSENTRY32-structures (which contain, amongst others, the process ID and image name).
uses
Windows, TLHelp32, SysUtils;
var
snapshot: THandle;
ProcEntry: TProcessEntry32;
s: String;
begin
snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if (snapshot <> INVALID_HANDLE_VALUE) then begin
ProcEntry.dwSize := SizeOf(ProcessEntry32);
if (Process32First(snapshot, ProcEntry)) then begin
s := ProcEntry.szExeFile;
// s contains image name of the first process
while Process32Next(snapshot, ProcEntry) do begin
s := ProcEntry.szExeFile;
// s contains image name of the current process
end;
end;
end;
CloseHandle(snapshot);
However, memory consumption information doesn't seem to be included, but you can get this via another simple API call, GetProcessMemoryInfo
uses
psAPI;
var
pmc: TProcessMemoryCounters;
begin
pmc.cb := SizeOf(pmc) ;
if GetProcessMemoryInfo(processID, #pmc, SizeOf(pmc)) then
// Usage in Bytes: pmc.WorkingSetSize
else
// fail
You just have to call this function with the process IDs retrieved from the snapshot.
Use the PSAPI (Process Status API).
The open source JCL has a Delphi wrapper for the PSAPI.
There are some more good stackoverflow Delphi PSAPI questions you can check for answers.
--jeroen
you can use the WMI Win32_Process class to get all the running process info. addtionally you can check the Win32_PerfFormattedData_PerfProc_Process class to get the performance counters related to CPU and memory usage.
Check this sample
program WMIProcessInfo;
{$APPTYPE CONSOLE}
uses
SysUtils
,ActiveX
,ComObj
,Variants;
procedure GetWin32_Process;
var
objWMIService : OLEVariant;
colItems : OLEVariant;
colItem : OLEVariant;
oEnum : IEnumvariant;
iValue : LongWord;
User : OLEVariant;
Domain : OLEVariant;
function GetWMIObject(const objectName: String): IDispatch;
var
chEaten: Integer;
BindCtx: IBindCtx;
Moniker: IMoniker;
begin
OleCheck(CreateBindCtx(0, bindCtx));
OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), chEaten, Moniker));
OleCheck(Moniker.BindToObject(BindCtx, nil, IDispatch, Result));
end;
begin
objWMIService := GetWMIObject('winmgmts:\\localhost\root\cimv2');
colItems := objWMIService.ExecQuery('SELECT * FROM Win32_Process','WQL',0);
oEnum := IUnknown(colItems._NewEnum) as IEnumVariant;
WriteLn(Format('%-20s %6s %10s %10s %10s',['Caption','PID','User','Domain','Working Set ( Kb Memory)']));
while oEnum.Next(1, colItem, iValue) = 0 do
begin
colItem.GetOwner(User,Domain);
if colItem.GetOwner( User, Domain ) =0 then //get the user and domain
WriteLn(Format('%-20s %6s %10s %10s %10s',[colItem.Caption,colItem.ProcessId,User,Domain,colItem.WorkingSetSize / 1024]))
else
WriteLn(Format('%-20s %6s %10s %10s %10s',[colItem.Caption,colItem.ProcessId,'','',colItem.WorkingSetSize / 1024]));
end;
end;
begin
try
CoInitialize(nil);
try
GetWin32_Process;
Readln;
finally
CoUninitialize;
end;
except
on E:Exception do
Begin
Writeln(E.Classname, ': ', E.Message);
Readln;
End;
end;
end.
In Jwscl there is a class that can do this for you (JwsclTerminalServer):
var
ATerminalServer: TJwTerminalServer;
i: Integer;
begin
// Create Terminal Server instance and allocate memory for it
ATerminalServer := TjwTerminalServer.Create;
// Set servername (only in case of remote server)
ATerminalServer.Server := 'TS001';
// Remember that EnumerateProcesses will automatically connect to the
// Terminal Server for you. The connect function raises an Exception
// if the connection attempt was unsuccessfull, so better use try..except
try
if ATerminalServer.EnumerateProcesses then
begin
// Now loop through the list
for i := 0 to ATerminalServer.Processes.Count - 1 do
begin
Memo1.Lines.Add(ATerminalServer.Processes[i].ProcessName);
end;
end;
except
on E: EJwsclWinCallFailedException do
begin
// Handle Exception here
end;
end;
// Free Memory
ATerminalServer.Free;
end;
Although the unit is aimed at Terminal Server this part works both with and without and as a bonus you can use it on remote systems as well.
For each process detailed information is returned, check the docs for details.
For memory usage you can use the ProcessMemUsage and ProcessVirtualSize properties, for the Pid there is the ProcessId property
ProcessInfo provides basic information about running processes in Windows. It is open-source, and contains a demo of a task manager.
How do I get a list of the running processes (with details of PID, Owner etc) on my machine using Delphi?
EDIT: None of the solutions proposed gives me the user that owns the process, only info such as PID, ExeName etc...
One way is using the Tool Help library (see TlHelp32 unit), or EnumProcesses on Windows NT (see PsAPI unit). Have a look at JclSysInfo.RunningProcessesList in the JCL for an example.
Here's a quick example of how to get the user name of a process:
type
PTokenUser = ^TTokenUser;
TTokenUser = packed record
User: SID_AND_ATTRIBUTES;
end;
function GetProcessUserName(ProcessID: Cardinal; out DomainName, UserName: string): Boolean;
var
ProcessHandle, ProcessToken: THandle;
InfoSize, UserNameSize, DomainNameSize: Cardinal;
User: PTokenUser;
Use: SID_NAME_USE;
_DomainName, _UserName: array[0..255] of Char;
begin
Result := False;
DomainName := '';
UserName := '';
ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, ProcessID);
if ProcessHandle = 0 then
Exit;
try
if not OpenProcessToken(ProcessHandle, TOKEN_QUERY, ProcessToken) then
Exit;
try
GetTokenInformation(ProcessToken, TokenUser, nil, 0, InfoSize);
User := AllocMem(InfoSize * 2);
try
if GetTokenInformation(ProcessToken, TokenUser, User, InfoSize * 2, InfoSize) then
begin
DomainNameSize := SizeOf(_DomainName);
UserNameSize := SizeOf(_UserName);
Result := LookupAccountSid(nil, User^.User.Sid, _UserName, UserNameSize, _DomainName, DomainNameSize, Use);
if Result then
begin
SetString(DomainName, _DomainName, StrLen(_DomainName));
SetString(UserName, _UserName, StrLen(_UserName));
end;
end;
finally
FreeMem(User);
end;
finally
CloseHandle(ProcessToken);
end;
finally
CloseHandle(ProcessHandle);
end;
end;
This is the function we use to check if a process exists, the FProcessEntry32 holds all the info on the process, so you should be able to extend it to what every you need.
it was taken from here
uses TlHelp32
function processExists(exeFileName: string): Boolean;
{description checks if the process is running
URL: http://www.swissdelphicenter.ch/torry/showcode.php?id=2554}
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
Result := False;
while Integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName))) then
begin
Result := True;
end;
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;
The TProcessEntry32 record looks like so:
tagPROCESSENTRY32 = packed record
dwSize: DWORD;
cntUsage: DWORD;
th32ProcessID: DWORD; // this process
th32DefaultHeapID: DWORD;
th32ModuleID: DWORD; // associated exe
cntThreads: DWORD;
th32ParentProcessID: DWORD; // this process's parent process
pcPriClassBase: Longint; // Base priority of process's threads
dwFlags: DWORD;
szExeFile: array[0..MAX_PATH - 1] of Char;// Path
end;
You have to use:
CreateToolhelp32Snapshot Function
Process32First Function
Process32Next Function
PROCESSENTRY32 Structure will contain all the informations that you may need.
The documentation is from MDSN, for C++, but it's the same in Delphi.
This class will give you a list of all open windows (listed below) with PID, caption, dimensions, etc. It's not exactly running processes information, but I've used it to find apps via it.
// Window List Component 1.5 by Jerry Ryle
//
// Aaugh! I accidentally uploaded the wrong source
// which had a nasty bug in the refresh procedure!
// Thanks to Serge, who found my mistake and suggested
// a few other improvements!
//
// This component will enumerate windows and return
// information about them in the Windows property.
// The component currently returns a handle, caption text,
// associated ProcessID, visibility, and dimensions.
// For documentation, please read the accompanying
// WindowList.txt
//
// This component is completely free of course. If you find
// it useful, and are compelled to send me cash, beer, or
// dead things in envelopes, please feel free to do so.
//
// email me if you make it better: gryle#calpoly.edu
unit WindowList;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TWindowObject = record
WinHandle : HWnd; // Window Handle
WinCaption : String; // Window Caption Text (If any)
ProcessID : Integer; // Process the window belongs to
IsVisible : Boolean; // Is the window visible?
IsEnabled : Boolean; // Is the window enabled for mouse/keyboard input?
IsIconic : Boolean; // Is the window minimized?
WindowRect : TRect; // Window Dimensions
// Add more properties here if you like,
// then fill them in at the WindowCallback
// function.
end;
PTWindowObject = ^TWindowObject;
TWindowList = class(TComponent)
private
WindowLst : TList;
FCount : Integer;
protected
Function GetAWindow(Index : Integer) : TWindowObject;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
Procedure Refresh;
Property Windows[Index : Integer]: TWindowObject read GetAWindow;
Property Count : Integer read FCount;
published
// Published declarations
end;
procedure Register;
implementation
// Note that this function is not a member of WindowList.
// Therefore, the list to be filled needs to be passed
// as a pointer. Note that this is passed as a VAR. if you
// don't do this, bad things happen in memory.
Function WindowCallback(WHandle : HWnd; Var Parm : Pointer) : Boolean; stdcall;
// This function is called once for each window
Var MyString : PChar;
MyInt : Integer;
MyWindowPtr : ^TWindowObject;
begin
New(MyWindowPtr);
// Window Handle (Passed by the enumeration)
MyWindowPtr.WinHandle := WHandle;
// Window text
MyString := Allocmem(255);
GetWindowText(WHandle,MyString,255);
MyWindowPtr.WinCaption := String(MyString);
FreeMem(MyString,255);
// Process ID
MyInt := 0;
MyWindowPtr.ProcessID := GetWindowThreadProcessId(WHandle,#MyInt);
// Visiblity
MyWindowPtr.IsVisible := IsWindowVisible(WHandle);
// Enabled
MyWindowPtr.IsEnabled := IsWindowEnabled(WHandle);
// Iconic
MyWindowPtr.IsIconic := IsIconic(WHandle);
// Window Dimensions
MyWindowPtr.WindowRect := Rect(0,0,0,0);
GetWindowRect(WHandle,MyWindowPtr.WindowRect);
// Add the structure to the list. Do not dereference Parm...
// once again, bad things happen.
TList(Parm).Add(MyWindowPtr);
Result := True; // Everything's okay. Continue to enumerate windows
end;
constructor TWindowList.Create(AOwner: TComponent);
var MyWindowPtr : PTWindowObject;
begin
inherited;
WindowLst := TList.Create;
// Thanks Serge, I should've done this from the start :)
// Sloppy me.
If Not ( csDesigning in ComponentState ) Then
Begin
EnumWindows(#WindowCallback,Longint(#WindowLst));
FCount := WindowLst.Count;
End
Else
FCount := 0;
end;
destructor TWindowList.Destroy;
var I : Integer;
begin
If WindowLst.Count > 0 Then
Begin
For I := 0 To (WindowLst.Count - 1) Do
Dispose(PTWindowObject(WindowLst[I]));
End;
WindowLst.Free;
inherited;
end;
procedure TWindowList.Refresh;
begin
WindowLst.Clear; {Clear the list!}
EnumWindows(#WindowCallback,Longint(#WindowLst));
FCount := WindowLst.Count;
end;
function TWindowList.GetAWindow(Index : Integer) : TWindowObject;
begin
Result := PTWindowObject(WindowLst[Index])^;
end;
procedure Register;
begin
RegisterComponents('System', [TWindowList]);
end;
end.
You could look at using the WMISet components ($69 single licence, $199 for site licence, trial version available). The TWmiProcessControl component seems to encapsulate calls to Win32_Process. They also have an example of getting a process owner.
I think Madshi madKernel could be interesting to check out.