How can I detect whether a specific app (where the app's window handle and process-ID are known) currently has any MENU opened (main menu or popup menu)?
I have researched this but did not find anything.
A possible implementation might involve enumerating top level windows of the thread that the target application window belongs, to search if any one of them is the menu window class. This is '#32768' as per the documentation.
Following example does the same for Windows 7 calculator in a timer event handler. The example outputs a debug string if the program's menu or context menu is open.
function EnumThreadWindowsCallback(hwnd: HWND; lParam: LPARAM): BOOL; stdcall;
const
MenuWndClass = '#32768';
var
ClassName: array[0..256] of Char;
begin
Result := True;
if (GetClassName(hwnd, ClassName, Length(ClassName)) = Length(MenuWndClass)) and
(ClassName = MenuWndClass) then begin
PBoolean(lparam)^ := True;
Result := False;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
Wnd: HWND;
ThrId: DWORD;
MenuWnd: Boolean;
begin
Wnd := FindWindow('CalcFrame', 'Calculator');
if Wnd <> 0 then begin
ThrId := GetWindowThreadProcessId(Wnd);
MenuWnd := False;
EnumThreadWindows(ThrId, #EnumThreadWindowsCallback, LPARAM(#MenuWnd));
if MenuWnd then
OutputDebugString('active menu');
end;
end;
Related
I created a small application that adds an item to the system menu of all windows, and handles clicking on it with a hook (WH_CALLWNDPROC).
The code works when the window receives WM_SYSCOMMAND messages with the existing items (minimize, maximize, etc.) but does not capture clicks on my custom item.
The problem is, apparently, that I'm not getting the correct ID of the item I added, but I don't know why.
How will I do this?
Here is the code to add the item (works):
const
SC_MYITEM = $020;
MYITEM_STRING = 'My Item';
...
function AddMyMenuItem(hWnd: HWND): Boolean;
var
WndMenu: HMENU;
begin
Result := False;
if IsWindowVisible(hWnd) then
begin
WndMenu := GetSystemMenu(hWnd, False);
if WndMenu <> 0 then
Result := AppendMenu(WndMenu, MF_STRING or MF_ENABLED, SC_MYITEM, PChar(MYITEM_STRING));
end;
end;
And this is the code in the dll file that the hook runs:
const
SC_MYITEM = $020;
function CallWndProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
Window: HWND;
begin
Result := CallNextHookEx(0, nCode, wParam, lParam);
if nCode < HC_ACTION then Exit;
if (PCWPStruct(lParam)^.message = WM_SYSCOMMAND) and (PCWPStruct(lParam)^.wParam = SC_MYITEM) then
begin
Window := PCWPStruct(lParam)^.hwnd;
//The procedure that processes the window...
end;
end;
As mentioned, if I check this line PCWPStruct(lParam)^.wParam = SC_MAXIMIZE I will get the correct result when maximize is pressed, and the code will run.
Trying to navigate using WebBrowser component automatically through code it doesn't work. The navigation includes the login page and after that some other pages. The first page button login works fine. On second page the next button needed an application.processmessages before executing to make it work. On the next/third page I cannot make automatically the next button to work.
CODE:
//CLICK BUTTON
function clickForm1(WebBrowser: TWebBrowser; FieldName: string): Boolean;
var
i, j: Integer;
FormItem: Variant;
begin
Result := False;
//no form on document
if WebBrowser.OleObject.Document.all.tags('FORM').Length = 0 then
begin
Exit;
end;
//count forms on document
for I := 0 to WebBrowser.OleObject.Document.forms.Length - 1 do
begin
FormItem := WebBrowser.OleObject.Document.forms.Item(I);
for j := 0 to FormItem.Length - 1 do
begin
try
//when the fieldname is found, try to fill out
if FormItem.Item(j).Name = FieldName then
begin
FormItem.Item(j).click;
Result := True;
end;
except
Exit;
end;
end;
end;
end;
//SEARCH INSIDE THE MEMO
procedure TForm2.Button7Click(Sender: TObject);
var
i: Integer;
a: string;
begin
Memo1.Lines.Add('');
Memo1.Lines.Text := ' ' + Memo1.Lines.Text;
for i := 0 to Length(Memo1.Lines.Text) - Length(edit7.Text) do
begin
a := Copy(Memo1.Lines.Text, i, Length(edit7.Text));
if CheckBox1.Checked = True then //FIND CASE Sensitive
begin
if a = edit7.Text then
begin
find := True;
x := 2;
Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
Memo1.SetFocus;
Memo1.SelStart := i - 2;
Memo1.SelLength := Length(edit7.Text);
break;
end;
end
else
begin
if lowercase(a) = lowercase(edit7.Text) then
begin
Memo1.Lines.Text := Copy(Memo1.Lines.Text, 2, Length(Memo1.Lines.Text) - 1);
find := True;
x := 2;
Memo1.SetFocus;
Memo1.SelStart := i - 2;
Memo1.SelLength := Length(edit7.Text);
break;
end;
end;
end;
end;
//HTML TO MEMO
procedure TForm2.Button6Click(Sender: TObject);
var
iall : IHTMLElement;
begin
if Assigned(WebBrowser1.Document) then
begin
iall := (WebBrowser1.Document AS IHTMLDocument2).body;
while iall.parentElement <> nil do
begin
iall := iall.parentElement;
end;
memo1.Text := iall.outerHTML;
end;
end;
procedure TForm2.WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
Document: IHtmlDocument2;
CurWebrowser : IWebBrowser;
TopWebBrowser: IWebBrowser;
WindowName : string;
ovElements: OleVariant;
i: Integer;
begin
CurWebrowser := pDisp as IWebBrowser;
TopWebBrowser := (ASender as TWebBrowser).DefaultInterface;
if CurWebrowser=TopWebBrowser then
begin
button6.Click; // HTML TO MEMO
TRY
button7.Click; //SEARCH LOGIN FORM
if find=true then Begin
clickForm1(WebBrowser1, 'move'); //CLICK LOGIN BUTTON
End Else begin Null; End;
FINALLY find:=false; END;
TRY
button8.Click; //SEARCH HOME (AFTER LOGIN) FORM
if find1=true then Begin
Application.ProcessMessages;//NEEDED IN ORDER THE BUTTON TO BE PRESSED.
clickForm1(WebBrowser1, 'refresh'); //CLICK NEXT PAGE BUTTON
End;
FINALLY find1:=false;END;
TRY
button9.Click; //SEARCH WORKLIST FORM
if find2=true then Begin
clickForm1(WebBrowser1, 'next'); //CLICK NEW FORM BUTTON
End;
FINALLY find2:=false;END;
end;
end;
I'm not sure how much you know about working with Event Handlers in code.
Objects like Forms and WebBrowsers typically have one or more event properties that are used to define what happens when the event occurs. So, an event property is a property of an object that can hold the information necessary to invoke (call) a procedure (or function, but not usually) of the same object or another one. The procedure to call has to have the right "signature" for the type definition of the event. If it does then an "event handler" can be assigned to the event property in code, as I'll show below.
One can use event properties and event-handling code in Delphi in a simple way, without knowing any of this, just by going to the Events tab of the Object Inspector and double-clicking next to one of the event names. What that actually does is to create a new handler procedure and to assign it to the corresponding event property of the object (well, not quite, actually that assignment is done at run-time when the host form is loaded).
What I mean by "signature" is the routine type (procedure or function) and its list of parameters, and their types, in its definition.
So, for a WebBrowser, the signature of the OnDocumentComplete event is
procedure (Sender: TObject; const pDisp: IDispatch; var URL: OLEVariant);
The clever thing is that you can assign the OnDocumentComplete property to
any procedure of an object that has the exact same signature. The event type for the WB's OnDocumentComplete is defined in the import unit ShDocVw, btw
So, let's suppose you write three methods that contain the code you want to run
when the WB completes loading URLs A, B and C, respectively:
procedure TForm1.DocCompleteA(Sender: TObject; const
pDisp: IDispatch; var URL: OLEVariant);
begin
// Do your stuff for arrival at site/page A here
// Then update NavigationOK flag to reflect if you succeeded or failed
if NavigationOK then begin
WebBrowser1.OnDocumentComplete := DocCompleteB;
// Now navigate to site/page B
end
else
WebBrowser1.OnDocumentComplete := Nil;
end;
procedure TForm1.DocCompleteB(Sender: TObject; const
pDisp: IDispatch; var URL: OLEVariant);
begin
end;
procedure TForm1.DocCompleteC(Sender: TObject; const
pDisp: IDispatch; var URL: OLEVariant);
begin
end;
Then, you can assign the WB's OnDocumentComplete property to each of them in turn,
with something like the code at the end of DocCompleteA which updates the WB's OnDocumentComplete to the code needed for B, and so on, in turn. The NavigationOK variable is just a flag to indicate that our navigation stays "on course" as it progresses. If it gets set to false because something went wrong, we set the WB's OnDocumentComplete to Nil, so that it does nothing next time the event occurs.
Then, you can kick off the whole "tour" of sites with something like this:
procedure TForm1.NavigateSites;
begin
NavigationOK := True;
WebBrowser1.OnDocumentComplete := DocCompleteA;
WebBrowser1.Navigate(...); // Navigate to site A
end;
Of course, you don't have to do the updating of the WB's OnDocumentComplete property and navigation to the next URL in the current DocCompleteX. In fact, it's probably clearer if you do those if a higher level procedure like the NavigateSites one, and more easily maintainable, which can be important if you're navigating others' sites, which are apt to be changed without any prior warning.
I have the handle of an opened Windows Explorer window.
How can I send a command to it in order to change the path from
example: m:\programs to d:\programs.
Till now I was using ShellExecute() but it opens a new window. This is not good (user experience).
The following BrowseToFolder function navigates the existing instance of a Windows Explorer of the given AHandle handle (if exists) to a AFolderPath folder (if exists). If you won't specify the second parameter, the topmost window should be taken to navigate (or at least the documentation claims that; reality seems to take the oldest existing window). The function returns True, if the navigation has been successful, False otherwise:
uses
ActiveX, ShlObj, ShellAPI, SHDocVw;
const
IID_IServiceProvider: TGUID = '{6D5140C1-7436-11CE-8034-00AA006009FA}';
SID_STopLevelBrowser: TGUID = '{4C96BE40-915C-11CF-99D3-00AA004AE837}';
function GetItemIDListFromPath(const AFolderPath: WideString): PItemIDList;
var
Count: ULONG;
Attributes: ULONG;
ShellFolder: IShellFolder;
begin
Result := nil;
if Succeeded(SHGetDesktopFolder(ShellFolder)) then
begin
Count := 0;
if Failed(ShellFolder.ParseDisplayName(0, nil, PWideChar(AFolderPath),
Count, Result, Attributes))
then
Result := nil;
end;
end;
function BrowseToFolder(const AFolderPath: WideString;
AHandle: HWND = HWND_TOPMOST): Boolean;
var
I: Integer;
WndIface: IDispatch;
ItemIDList: PItemIDList;
ShellBrowser: IShellBrowser;
ShellWindows: IShellWindows;
WebBrowserApp: IWebBrowserApp;
ServiceProvider: IServiceProvider;
begin
Result := False;
if Succeeded(CoCreateInstance(CLASS_ShellWindows, nil, CLSCTX_LOCAL_SERVER,
IID_IShellWindows, ShellWindows)) then
begin
for I := 0 to ShellWindows.Count - 1 do
begin
if (AHandle <> HWND_TOPMOST) then
WndIface := ShellWindows.Item(VarAsType(I, VT_I4))
else
WndIface := ShellWindows.Item(VarAsType(SWC_EXPLORER, VT_UI4));
if Succeeded(WndIface.QueryInterface(IID_IWebBrowserApp,
WebBrowserApp)) then
begin
if (AHandle = HWND_TOPMOST) or (WebBrowserApp.HWnd = AHandle) then
begin
if Succeeded(WebBrowserApp.QueryInterface(IID_IServiceProvider,
ServiceProvider)) then
begin
if Succeeded(ServiceProvider.QueryService(SID_STopLevelBrowser,
IID_IShellBrowser, ShellBrowser)) then
begin
ItemIDList := GetItemIDListFromPath(AFolderPath);
Result := Succeeded(ShellBrowser.BrowseObject(ItemIDList,
SBSP_SAMEBROWSER or SBSP_ABSOLUTE));
end;
end;
Break;
end;
end;
end;
end;
end;
Here is the example usage:
procedure TForm1.Button1Click(Sender: TObject);
var
ExplorerHandle: HWND;
begin
ExplorerHandle := 123456;
if not BrowseToFolder('c:\Windows\System32\', ExplorerHandle) then
ShowMessage('Navigation to a folder failed!')
else
ShowMessage('Navigation to a folder succeeded!');
end;
Here is a complete testing project and the blog post from which I've taken the inspiration.
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.
This is a follow up to How can I get the Delphi IDE's Main Form? which I now have working.
I'd like to go one step further and place my designer on the same form as the Object Inspector, for those who use the classic undocked desktop layout and may have the Object Inspector on a different screen than the main Delphi IDE form.
Any ideas on how I find which monitor the Object Inspector is on from inside my design time package?
This should work whether the property inspector is docked or not, since it falls back to the main form for the docked case:
function EnumWindowsProc(hwnd: HWND; lParam: LPARAM): Integer; stdcall;
var
ClassName: string;
PID: Cardinal;
begin
Result := 1;
GetWindowThreadProcessId(hwnd, PID);
if PID = GetCurrentProcessId then
begin
SetLength(ClassName, 64);
SetLength(ClassName, GetClassName(hwnd, PChar(ClassName), Length(ClassName)));
if ClassName = 'TPropertyInspector' then
begin
PHandle(lParam)^ := hwnd;
Result := 0;
end;
end;
end;
function GetPropertyInspectorMonitor: TMonitor;
var
hPropInsp: HWND;
begin
hPropInsp := 0;
EnumWindows(#EnumWindowsProc, LPARAM(#hPropInsp));
if hPropInsp = 0 then
hPropInsp := Application.MainFormHandle;
Result := Screen.MonitorFromWindow(hPropInsp);
end;