i have thread in my application shows messageboxs in another application with title 'Test' on every event the thread create it,by the end of this thread i wanna close all of this messages.
i tried to create loop like this
while FindWindow(Nil,PChar('Test')) <> 0 do
begin
Sleep(5); //if i remove the sleep the application will hanging and froze.
SendMessage(FindWindow(Nil,PChar('Test')), WM_CLOSE, 0, 0); // close the window message
end;
but this loop works only if i close the last message manually
Note: the messageboxs comes from another applaction not in the same application have this thread.
Try this instead:
var
Wnd: HWND;
begin
Wnd := FindWindow(Nil, 'Test');
while Wnd <> 0 do
begin
PostMessage(Wnd, WM_CLOSE, 0, 0);
Wnd := FindWindowEx(0, Wnd, Nil, 'Test');
end;
end;
Or:
function CloseTestWnd(Wnd: HWND; Param: LPARAM): BOOL; stdcall;
var
szText: array[0..5] of Char;
begin
if GetWindowText(Wnd, szText, Length(szText)) > 0 then
if StrComp(szText, 'Test') = 0 then
PostMessage(Wnd, WM_CLOSE, 0, 0);
Result := True;
end;
begin
EnumWindows(#CloseTestWnd, 0);
end;
Your logic seems to be somewhat... off. :-) You may or may not be sending the WM_CLOSE to the same window, since you're using one FindWindow to see if it exists and a different call to FindWindow to send the message.
I'd suggest doing it more like this:
var
Wnd: HWnd;
begin
Wnd := FindWindow(nil, 'Test'); // Find the first window (if any)
while Wnd <> 0 do
begin
SendMessage(Wnd, WM_CLOSE, 0, 0); // Send the message
Sleep(5); // Allow time to close
Wnd := FindWindow(nil, 'Test'); // See if there's another one
end;
end;
Depending on what the other application is doing, you may need to increase the Sleep time in order to allow the window time to receive and process the WM_CLOSE message; otherwise, you'll be simply sending it multiple times to the same window. (I'm suspecting that 5 ms is far too little time.)
Related
In the Delphi IDE, create a VCL Forms Application. Then add a TApplicationEvents component and a TButton on the form. Then add these two event-handlers:
uses
JclShell;
procedure TForm3.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
begin
if Msg.Message = WM_LBUTTONDOWN then
begin
Self.Caption := 'WM_LBUTTONDOWN';
end
else if Msg.Message = WM_LBUTTONUP then
begin
Self.Caption := 'WM_LBUTTONUP';
end
end;
procedure TForm3.Button1Click(Sender: TObject);
begin
JclShell.ShellExecAndWait('C:\Windows\system32\notepad.exe');
Self.Caption := 'Notepad closed';
end;
Now click on the button. The following happens:
"WM_LBUTTONDOWN" appears on the form's title-bar.
"WM_LBUTTONUP" appears on the form's title-bar.
Notepad is executed.
Then click again on the button which starts another instance of Notepad BUT this time without writing anything on the form's title-bar.
Obviously, the program is stuck in JclShell.ShellExecAndWait which returns only when Notepad is closed. So when Notepad is closed any mouse-click again writes to the form's title-bar.
So we can see that while Notepad is running in JclShell.ShellExecAndWait everything in the program works normally: You could even make mathematical calculations while Notepad is running in JclShell.ShellExecAndWait. Only the ApplicationEvents1Message is not triggered while Notepad is running.
So how can I get a WM_LBUTTONDOWN message while Notepad is running in JclShell.ShellExecAndWait?
While JclShell.ShellExecAndWait is waiting for the spawned process to exit it uses following basic message pump:
while WaitForSingleObject(Sei.hProcess, 10) = WAIT_TIMEOUT do
repeat
Msg.hwnd := 0;
Res := PeekMessage(Msg, Sei.Wnd, 0, 0, PM_REMOVE);
if Res then
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
until not Res;
CloseHandle(Sei.hProcess);
I say basic, because the looped part of the VCLs message pump looks like this:
if PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE) then
begin
Unicode := (Msg.hwnd = 0) or IsWindowUnicode(Msg.hwnd);
if Unicode then
MsgExists := PeekMessageW(Msg, 0, 0, 0, PM_REMOVE)
else
MsgExists := PeekMessageA(Msg, 0, 0, 0, PM_REMOVE);
if MsgExists then
begin
Result := True;
if Msg.Message <> WM_QUIT then
begin
Handled := False;
if Assigned(FOnMessage) then FOnMessage(Msg, Handled);
if not IsPreProcessMessage(Msg) and not IsHintMsg(Msg) and
not Handled and not IsMDIMsg(Msg) and
not IsKeyMsg(Msg) and not IsDlgMsg(Msg) then
begin
TranslateMessage(Msg);
if Unicode then
DispatchMessageW(Msg)
else
DispatchMessageA(Msg);
end;
end
else
begin
{$IF DEFINED(CLR)}
if Assigned(FOnShutDown) then FOnShutDown(self);
DoneApplication;
{$IFEND}
FTerminate := True;
end;
end;
The code line
if Assigned(FOnMessage) then FOnMessage(Msg, Handled);
is what will hand the message to your TApplicationEvents.OnMessage via the TMultiCaster that TApplicationEvents has assigned to Application.OnMessage. This is not done in the JCL source.
Additional issues might be that JCL is not UniCode aware regarding messages at this point and there is no handling for WM_QUIT.
What to do about this is depending on what you want to achieve, too. Why do you want to receive this messages in the first place?
I mean it is possible to alter the JCL source - if you are willing to do so - and to add VCL.Forms to the uses, and then call the event handler if assigned like the VCL does:
while WaitForSingleObject(Sei.hProcess, 10) = WAIT_TIMEOUT do
repeat
Msg.hwnd := 0;
Res := PeekMessage(Msg, Sei.Wnd, 0, 0, PM_REMOVE);
if Res then
begin
Handled := False;
if Assigned(Application.OnMessage) then
Application.OnMessage(Msg, Handled);
if not Handled then
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
until not Res;
CloseHandle(Sei.hProcess);
Or even call Application.ProcessMessages, to have the same message processing in place the VCL does:
while WaitForSingleObject(Sei.hProcess, 10) = WAIT_TIMEOUT do
Application.ProcessMessages;
CloseHandle(Sei.hProcess);
This is working, I could not see any side effects like commenters suggested. But before changing the JCL source in this way I would probably implement my own ShellExecAndWait. Depending on what you would like to achieve, the normal dispatching of messages should still work. So if your TFrom has e.g.
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
implemented, it should be called. This is, however, only the case if the message was directed at your form. If the button is clicked, the resulting messages will be directed to the button itself. You would need to implement your own descendant class then.
Maybe a completely different suggestion?
If your goal is to let certain controls not to be clicked while JclShell.ShellExecAndWait is waiting, and using message handling is your approach to make this possible, there might be other things you can try.
Why not disable them? This will also give the user a visible indication that clicking is a no-go.
Button1.Enabled := False;
try
JclShell.ShellExecAndWait('C:\Windows\system32\notepad.exe');
Self.Caption := 'Notepad closed';
finally
Button1.Enabled := True;
end;
If you are concerned about multiple controls create a TAction, assign it to every control you want to disable and disable all of them together with the Enabled property of the TAction.
Or, just hide your form while notepad.exe is opened?
Hide;
try
JclShell.ShellExecAndWait('C:\Windows\system32\notepad.exe');
Self.Caption := 'Notepad closed';
finally
Show;
end;
Or you could remove the event handlers:
var
ATmpOnClick: TNotifyEvent;
begin
ATmpOnClick := Button1.OnClick;
Button1.OnClick := nil;
try
JclShell.ShellExecAndWait('C:\Windows\system32\notepad.exe');
Self.Caption := 'Notepad closed';
finally
Button1.OnClick := ATmpOnClick;
end;
end;
I'm trying to get text from terminal window.
https://www.attachmate.com/products/extra/
it looks like below:
I'm using WM_GETTEXT to get text from this terminal window. As you can see above, the window has text (in green) but i'm not able to get anything, even after trying out all windows and child windows under this applications.
the code i use is:
function TForm1.fn_get_text(): string;
var
NpWnd, NpEdit: HWnd;
Buffer: string;
BufLen: Integer;
begin
Memo1.Clear;
NpWnd := FindWindow('#32769', nil);
if NpWnd <> 0 then
begin
//NpEdit := FindWindowEx(NpWnd, 0, 'Afx:400000:202b:10003:6:0', nil);
//if NpEdit <> 0 then
//begin
BufLen := SendMessage(NpWnd, WM_GETTEXTLENGTH, 0, 0);
SetLength(Buffer, BufLen + 1);
SendMessage(NpWnd, WM_GETTEXT, BufLen, LParam(PChar(Buffer)));
Memo1.Lines.Text := Buffer;
//end;
end;
end;
I used Winspy++ to get all window classes. In Win spy++, different window classes look like below:
I tried all window classes under Extra.exe . But nothing seems to be able to get me the text from terminal window. Could anyone please provide me some tips to identify the issue?
I have this code right here that modifies the clipboard and then restores it back:
function SetClipText(szText:WideString):Boolean;
var
pData: DWORD;
dwSize: DWORD;
begin
Result := FALSE;
if OpenClipBoard(0) then
begin
dwSize := (Length(szText) * 2) + 2;
if dwSize <> 0 then
begin
pData := GlobalAlloc(MEM_COMMIT, dwSize);
if pData <> 0 then
begin
CopyMemory(Pointer(pData), #szText[1], dwSize - 2);
if SetClipBoardData(CF_UNICODETEXT, pData) <> 0 then
Result := TRUE;
end;
end;
CloseClipBoard;
end;
end;
function GetClipText(var szText:WideString):Boolean;
var
hData: DWORD;
pData: Pointer;
dwSize: DWORD;
begin
Result := FALSE;
if OpenClipBoard(0) then
begin
hData := GetClipBoardData(CF_UNICODETEXT);
if hData <> 0 then
begin
pData := GlobalLock(hData);
if pData <> nil then
begin
dwSize := GlobalSize(hData);
if dwSize <> 0 then
begin
SetLength(szText, (dwSize div 2) - 1);
CopyMemory(#szText[1], pData, dwSize);
Result := TRUE;
end;
GlobalUnlock(DWORD(pData));
end;
end;
CloseClipBoard;
end;
end;
var
OldClip : WideString;
begin
repeat until GetClipText (OldClip);
repeat until SetClipText ('NewClipBoardText');
// PASTE
keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0);
keybd_event(Ord('V'), MapVirtualKey(Ord('V'), 0), 0, 0);
keybd_event(Ord('V'), MapVirtualKey(Ord('V'), 0), KEYEVENTF_KEYUP, 0);
keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KEYEVENTF_KEYUP, 0);
repeat until SetClipText (OldClip);
end.
I use keybd_event to paste new clipboard text to a window (e.g. notepad).
It seems like that keybd_event is so fast, that repeat until SetClipText (OldClip); get's called before the keys got pressed. Is there way to check when and if the keys were pressed?
keybd_event never fails. It merely places they event that you specify into the currently active input queue.
Because the function is asynchronous the keyboard event is not processed until the other application gets round to processing it. So, most likely the other application has not processed the keyboard event by the time you call SetClipText. You can't expect to know when a particular keyboard event is processed, unless you have control of the other application. But in that case you would not be communicating with it by faking input.
I have a hopefully quick question: Is it possible to delay execution of ShellExecute a little bit?
I have an application with autoupdater. After it downloads all necessary files etc, it renames current files to *.OLD and the new as the previous. Simple enough. But then I need to delete those .OLD files. This 'cleanup' procedure is executed on MainForm.OnActivate (with a check if it is the first activate proc). But this apparently happens too fast (I get False from DeleteFile). This is the procedure:
procedure TUpdateForm.OKBtnClick(Sender: TObject);
const SHELL = 'ping 127.0.0.1 -n 2';
begin
ShellExecute(0,'open',pchar(SHELL+#13+Application.ExeName),nil,nil,SW_SHOWNORMAL);
Application.Terminate;
end;
This procedure is supposed to restart the application. I am certain that the deleting problem is caused by the quick start of the second application, because if I restart it myself, giving it a little time, the files get deleted normally.
tl;dr version: I need to call ShellExecute() which waits a bit (0.1 sec or so) and THEN executes the command.
Note
I tried using the -ping command to try to delay it, but it didn't work.
Thank you very much in advance
Edit: Rephrased
I need this to happen || First app closes; Wait 100 ms; second app opens ||. I need to call ShellExecute first, then wait until the calling application closes itself completely, then execute the shell (i.e. open second application)
You're doing an autopatcher right ?
I've had the same problem and this is how I bypassed it :
You run second app with argument "--delay" or something like that.
Second app handles argument "--delay" and sleeps for 100 ms, then continues running normally.
This routine is some utils code in our game engine. It can run an executable and optionally wait for it to exit. It will return its exit code:
function TSvUtils.FileExecute(ahWnd: Cardinal; const aFileName, aParams, aStartDir: string; aShowCmd: Integer; aWait: Boolean): Integer;
var
Info: TShellExecuteInfo;
ExitCode: DWORD;
begin
Result := -1;
FillChar(Info, SizeOf(Info), 0);
Info.cbSize := SizeOf(TShellExecuteInfo);
with Info do begin
fMask := SEE_MASK_NOCLOSEPROCESS;
Wnd := ahWnd;
lpFile := PChar(aFileName);
lpParameters := PChar(aParams);
lpDirectory := PChar(aStartDir);
nShow := aShowCmd;
end;
if ShellExecuteEx(#Info) then
begin
if aWait then
begin
repeat
Sleep(1);
Application.ProcessMessages;
GetExitCodeProcess(Info.hProcess, ExitCode);
until (ExitCode <> STILL_ACTIVE) or Application.Terminated;
CloseHandle(Info.hProcess);
Result := ExitCode;
end;
end
end;
Here is some code that can check to see if a process exists. So... current app calls the updater and terminates. The updater can check to see if old app has terminated and do it's thing (rename, update, delete, etc):
function TSvUtils.ProcessExists(const aExeFileName: string; aBringToForgound: Boolean=False): Boolean;
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(aExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(aExeFileName))) then
begin
if aBringToForgound then
EnumWindows(#BringToForgroundEnumProcess, FProcessEntry32.th32ProcessID);
Result := True;
end;
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;
If you can use CreateProcess instead of ShellExecute, you can wait on the process handle. The process handle is signalled when the application exits. For example:
function ExecAndWait(APath: string; var VProcessResult: cardinal): boolean;
var
LWaitResult : integer;
LStartupInfo: TStartupInfo;
LProcessInfo: TProcessInformation;
begin
Result := False;
FillChar(LStartupInfo, SizeOf(TStartupInfo), 0);
with LStartupInfo do
begin
cb := SizeOf(TStartupInfo);
dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
wShowWindow := SW_SHOWDEFAULT;
end;
if CreateProcess(nil, PChar(APath), nil, nil,
False, NORMAL_PRIORITY_CLASS,
nil, nil, LStartupInfo, LProcessInfo) then
begin
repeat
LWaitResult := WaitForSingleObject(LProcessInfo.hProcess, 500);
// do something, like update a GUI or call Application.ProcessMessages
until LWaitResult <> WAIT_TIMEOUT;
result := LWaitResult = WAIT_OBJECT_0;
GetExitCodeProcess(LProcessInfo.hProcess, VProcessResult);
CloseHandle(LProcessInfo.hProcess);
CloseHandle(LProcessInfo.hThread);
end;
end;
After ExecAndWait returns, then you can sleep for 100ms if you need to.
N#
Is there a way to Minimize an external application that I don't have control over from with-in my Delphi application?
for example notepad.exe, except the application I want to minimize will only ever have one instance.
You can use FindWindow to find the application handle and ShowWindow to minimize it.
var
Indicador :Integer;
begin
// Find the window by Classname
Indicador := FindWindow(PChar('notepad'), nil);
// if finded
if (Indicador <> 0) then begin
// Minimize
ShowWindow(Indicador,SW_MINIMIZE);
end;
end;
I'm not a Delphi expert, but if you can invoke win32 apis, you can use FindWindow and ShowWindow to minimize a window, even if it does not belong to your app.
Thanks for this, in the end i used a modifyed version of Neftali's code, I have included it below in case any one else has the same issues in the future.
FindWindow(PChar('notepad'), nil);
was always returning 0, so while looking for a reason why I found this function that would find the hwnd, and that worked a treat.
function FindWindowByTitle(WindowTitle: string): Hwnd;
var
NextHandle: Hwnd;
NextTitle: array[0..260] of char;
begin
// Get the first window
NextHandle := GetWindow(Application.Handle, GW_HWNDFIRST);
while NextHandle > 0 do
begin
// retrieve its text
GetWindowText(NextHandle, NextTitle, 255);
if Pos(WindowTitle, StrPas(NextTitle)) <> 0 then
begin
Result := NextHandle;
Exit;
end
else
// Get the next window
NextHandle := GetWindow(NextHandle, GW_HWNDNEXT);
end;
Result := 0;
end;
procedure hideExWindow()
var Indicador:Hwnd;
begin
// Find the window by Classname
Indicador := FindWindowByTitle('MyApp');
// if finded
if (Indicador <> 0) then
begin
// Minimize
ShowWindow(Indicador,SW_HIDE); //SW_MINIMIZE
end;
end;
I guess FindWindow(PChar('notepad'), nil) should be FindWindow(nil, PChar('notepad')) to find the window by title.