Why does ReadDirectoryChangesW omit events? - windows

I use ReadDirectoryChangesW to watch a specified directory and update indexing structures whenever a change is detected. I use the following code (roughly)
var
InfoPointer : PFileNotifyInformation;
NextOffset : DWORD;
...
while (not Terminated) do begin
if ReadDirectoryChangesW (FDirHandle, FBuffer, FBufferLength, True,
FFilter, #BytesRead, #FOverlap, nil) then
begin
WaitResult := WaitForMultipleObjects (2, #FEventArray, False, INFINITE);
if (WaitResult = waitFileChange) then
begin
InfoPointer := FBuffer;
repeat
NextOffset := InfoPointer.NextEntryOffset;
...
PByte (InfoPointer) := PByte (InfoPointer) + NextOffset;
until NextOffset = 0;
end;
end;
end;
Filter is
FFilter := FILE_NOTIFY_CHANGE_FILE_NAME or
FILE_NOTIFY_CHANGE_DIR_NAME or
FILE_NOTIFY_CHANGE_SIZE or
FILE_NOTIFY_CHANGE_LAST_WRITE;
and the directory handle is obtained like this:
FDirHandle := CreateFile (PChar (FDirectoryWatch.WatchedDirectory),
FILE_LIST_DIRECTORY or GENERIC_READ,
FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS or
FILE_FLAG_OVERLAPPED, 0);
When I delete multiple files I get only one event and NextOffset is 0! And when I delete a directory I get only one event for the directory. What if I want one event for each file in the directory?
Any help would be appreciated.

It seems to me that you are mixing the various ways to use ReadDirectoryChangesW(), you do both specify the FILE_FLAG_OVERLAPPED flag when opening the directory and provide a pointer to the lpOverlapped parameter, meaning you want to wait on the event in the structure and handle the asynchronous I/O; and at the same time you call ReadDirectoryChangesW() in a loop in a worker thread. I would first try again with lpOverlapped set to nil, as you have a dedicated thread and can use the synchronous mode.
In the documentation of the ReadDirectoryChangesW() API function the different ways to use it are described. Note that it is also possible that the buffer overflows, so change events can be lost anyway. Maybe you should rethink your strategy of relying solely on this function, comparing snapshots of directory contents could work as well.
Edit:
Your edited code looks better. In my tests however ReadDirectoryChangesW() did work as advertised, there were either several data entries in the returned buffer, or there were more than one buffer to process. This depends on timing, after hitting a breakpoint in Delphi I get several entries in one buffer.
For completeness I attach the test code, implemented using Delphi 5:
type
TWatcherThread = class(TThread)
private
fChangeHandle: THandle;
fDirHandle: THandle;
fShutdownHandle: THandle;
protected
procedure Execute; override;
public
constructor Create(ADirectoryToWatch: string);
destructor Destroy; override;
procedure Shutdown;
end;
constructor TWatcherThread.Create(ADirectoryToWatch: string);
const
FILE_LIST_DIRECTORY = 1;
begin
inherited Create(TRUE);
fChangeHandle := CreateEvent(nil, FALSE, FALSE, nil);
fDirHandle := CreateFile(PChar(ADirectoryToWatch),
FILE_LIST_DIRECTORY or GENERIC_READ,
FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OVERLAPPED, 0);
fShutdownHandle := CreateEvent(nil, FALSE, FALSE, nil);
Resume;
end;
destructor TWatcherThread.Destroy;
begin
if fDirHandle <> INVALID_HANDLE_VALUE then
CloseHandle(fDirHandle);
if fChangeHandle <> 0 then
CloseHandle(fChangeHandle);
if fShutdownHandle <> 0 then
CloseHandle(fShutdownHandle);
inherited Destroy;
end;
procedure TWatcherThread.Execute;
type
PFileNotifyInformation = ^TFileNotifyInformation;
TFileNotifyInformation = record
NextEntryOffset: DWORD;
Action: DWORD;
FileNameLength: DWORD;
FileName: WideChar;
end;
const
BufferLength = 65536;
var
Filter, BytesRead: DWORD;
InfoPointer: PFileNotifyInformation;
Offset, NextOffset: DWORD;
Buffer: array[0..BufferLength - 1] of byte;
Overlap: TOverlapped;
Events: array[0..1] of THandle;
WaitResult: DWORD;
FileName, s: string;
begin
if fDirHandle <> INVALID_HANDLE_VALUE then begin
Filter := FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_DIR_NAME
or FILE_NOTIFY_CHANGE_SIZE or FILE_NOTIFY_CHANGE_LAST_WRITE;
FillChar(Overlap, SizeOf(TOverlapped), 0);
Overlap.hEvent := fChangeHandle;
Events[0] := fChangeHandle;
Events[1] := fShutdownHandle;
while not Terminated do begin
if ReadDirectoryChangesW (fDirHandle, #Buffer[0], BufferLength, TRUE,
Filter, #BytesRead, #Overlap, nil)
then begin
WaitResult := WaitForMultipleObjects(2, #Events[0], FALSE, INFINITE);
if WaitResult = WAIT_OBJECT_0 then begin
InfoPointer := #Buffer[0];
Offset := 0;
repeat
NextOffset := InfoPointer.NextEntryOffset;
FileName := WideCharLenToString(#InfoPointer.FileName,
InfoPointer.FileNameLength);
SetLength(FileName, StrLen(PChar(FileName)));
s := Format('[%d] Action: %.8xh, File: "%s"',
[Offset, InfoPointer.Action, FileName]);
OutputDebugString(PChar(s));
PByte(InfoPointer) := PByte(DWORD(InfoPointer) + NextOffset);
Offset := Offset + NextOffset;
until NextOffset = 0;
end;
end;
end;
end;
end;
procedure TWatcherThread.Shutdown;
begin
Terminate;
if fShutdownHandle <> 0 then
SetEvent(fShutdownHandle);
end;
////////////////////////////////////////////////////////////////////////////////
procedure TForm1.FormCreate(Sender: TObject);
begin
fThread := TWatcherThread.Create('D:\Temp');
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if fThread <> nil then begin
TWatcherThread(fThread).Shutdown;
fThread.Free;
end;
end;
Deleting a directory does indeed only return one change for it, nothing for the files contained in it. But it does make sense, as you are watching the handle of the parent directory only. If you need notifications for subdirectories you probably need to watch them as well.

We've had the same problem with losing events, especially if a lot of changes happens at the same time, ie. 500 files are copied to the monitored directory.
In the end we found Cromis and use the Directory watch. We have never looked back again.

Related

How to debug startup of app run by SendTo menu

On Windows, I'd like for my FMX app to run from the SendTo context menu. If the app is already running I'd like for the second instance to pass its command line to the first and then exit. Code is below. The problem is that if I have first instance running in the debugger, and then double-click an appropriate file, I see no evidence that the first instance receives a message from a newly started instance. If the app is not already running then the double click starts a new instance as expected.
Is there a way to debug the startup of the instance launched by the SendTo menu?
This code adds the app to the SendTo menu:
class procedure TInstallationController.CreateSendTo;
var
lExePath: string;
lObject: IUnknown;
lSLink: IShellLink;
lPFile: IPersistFile;
lFolderPath: array[0..MAX_PATH] of char;
lLinkName: WideString;
begin
SHGetFolderPath(0, CSIDL_SENDTO, 0, 0, lFolderPath);
lLinkName := Format('%s\%s.lnk', [lFolderPath, 'AppName']);
{$IFNDEF DEBUG}
if String(lLinkName).Contains('debug') then
Tfile.Delete(lLinkName);
{$ENDIF DEBUG}
if not TFile.Exists(lLinkName) then
if CoInitializeEx(nil, COINIT_MULTITHREADED) = S_OK then
begin
lExePath := ParamStr(0);
lObject := CreateComObject(CLSID_ShellLink);
lSLink := lObject as IShellLink;
lPFile := lObject as IPersistFile;
with lSlink do
begin
SetPath(pChar(lExePath));
SetWorkingDirectory(PChar(TPath.GetDirectoryName(lExePath)));
end;
lPFile.Save(PWChar(WideString(lLinkName)), false);
end;
end;
This code is placed before Application.Initialize in the .dpr file:
var
lWindow: HWND;
lMutex: THandle;
lCopyDataStruct: TCopyDataStruct;
i: integer;
lArg: string;
lResult: DWORD;
begin
lMutex := CreateMutex(nil, False, PChar('43671EDF1E5A4B419F213336F2387B0D'));
if lMutex = 0 then
RaiseLastOSError;
if GetLastError = Error_Already_Exists then
begin
FillChar(lCopyDataStruct, Sizeof(lCopyDataStruct), 0);
for I := 1 to ParamCount do
begin
lArg := ParamStr(i);
lCopyDataStruct.cbData := (Length(lArg) + 1)*SizeOf(Char);
lCopyDataStruct.lpData := PChar(lArg);
lWindow := FindWindow('FMT' + STRMainWindowClassName, nil);
SendMessageTimeout(lWindow, WM_COPYDATA, 0, NativeInt(#lCopyDataStruct),
SMTO_BLOCK, 3000, #lResult);
end;
exit;
end;
...
end.
Assignments in FormCreate of the main form to support Windows message forwarding:
...
FHwnd := FmxHandleToHwnd(Handle);
FOldWndProc := GetWindowLongPtr(FHwnd, GWL_WNDPROC);
SetWindowLongPtr(FHwnd, GWL_WNDPROC, NativeInt(#WindowProc));
...
This forwards Windows messages to my main FMX form:
function WindowProc (HWND: HWND; Msg: UINT; wParam: wParam; lParam: lParam): LRESULT; stdcall;
begin
Result := MasterDetailView.WndProc (HWND, Msg, wParam, lParam);
end;
This main form method receives forwarded messages:
function TViewMasterDetail.WndProc(aHwnd: HWND; aMsg: UINT; aWParam: WPARAM;
aLParam: LPARAM): LResult;
begin
Result := 0;
if aMsg = WM_COPYDATA then
begin
TUtils.Log('External file: ' + PChar(PCopyDataStruct(aLParam)^.lpData));
Viewmodel.HandleExternalFile(PChar(PCopyDataStruct(aLParam)^.lpData));
Exit;
end;
result := CallWindowProc(Ptr(fOldWndProc), aHwnd, aMsg, aWParam, aLParam);
end;
TViewMasterDetail.WndProc is called many time, but as far as I can tell aMsg is never WM_COPYDATA. The 'External file:' message never appears in the log. Thanks
Programmer error. To approximate debugging the startup code I ran a copy of the app outside the debugger and then launched a second copy of the app in the debugger, passing the path to the target file on the command line. This told me FindWindow was failing. I wrote this startup code a long time ago and since then have changed the names of UI classes in the app, including the main window. But I neglected to change the constant I used for the class name of the main window and pass to FindWindow. Fixing the constant cleared the error. Just another win for the evils of using text!

Find HID/PID in DELPHI / ARDUINO Interface

(First, I am not sure whether this question is placed in the correct section of Stack Exchange. If not so, please give me a notice and delete the question.)
I have 8 Arduino's (Ards). Some Uno's and some 2650 Mega's. In an attempt to automatize the connection process (I use Delphi D-7 SE as I/O), I want to differentate between the UNO and the 2650 (mostly because the hardware differences in the appropriate chip). The way to do this (I think), is to get the PID and VID from the board. But I don't know how to do this. The code below gives me the correct driver, but not PID/VID . Is it possible to get PID/VID for this code-snippet ?? IF so, HOW ?
Thanks a lot.
Code here:
unit ArduinoTestU;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, JVsetupAPI, Registry, StdCtrls,
CPortCtl, CPort, Menus, XPMan;
type
TMainForm = class(TForm)
ListBox1: TListBox;
Label1: TLabel;
Button1: TButton;
procedure FormCreate(Sender: TObject);
function SetupEnumAvailableComPorts : TstringList;
procedure ListBox1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
ArdType : Integer;
end;
var
MainForm : TMainForm;
ComPortStringList : TStringList;
MyComPort : String;
CurDir : String;
implementation
uses Form1Unit, ArdFormU; (* , ArdFormU; *)
{$R *.dfm}
procedure TMainForm.Button1Click(Sender: TObject);
begin
MainForm.FormActivate(NIL);
end;
procedure TMainForm.FormActivate(Sender: TObject);
var
index : integer;
begin
ComPortStringList := SetupEnumAvailableComPorts;
if (ComPortStringList <> nil) and (ComPortStringList.Count > 0) then
for Index := 0 to ComPortStringList.Count - 1 do
Listbox1.Items.Add(ComPortStringList[Index]);
if Listbox1.Items.Count <> 0 then
BEGIN
Listbox1.Enabled := True;
Button1.Enabled := False;
END;
end;
procedure TMainForm.FormCreate(Sender: TObject);
BEGIN
Curdir := ExtractFileDir(Application.Exename);
end;
(*
The function below returns a list of available COM-ports
(not open by this or an other process), with friendly names. The list is formatted as follows:
COM1: = Communications Port (COM1)
COM5: = NI Serial Port (Com5)
COM6: = NI Serial Port (Com6)
COM7: = USB Serial Port (COM7)
COM8: = Bluetooth Communications Port (COM8)
COM9: = Bluetooth Communications Port (COM9)
This code originally posted at http://www.delphi3000.com/articles/article_4001.asp?SK=
errors have been fixed so it will work with Delphi 7 and SetupAPI from JVCL
*)
function TMainForm.SetupEnumAvailableComPorts : TstringList;
//
// Enumerates all serial communications ports that are available and ready to
// be used.
//
var
RequiredSize: Cardinal;
GUIDSize: DWORD;
Guid: TGUID;
DevInfoHandle: HDEVINFO;
DeviceInfoData: TSPDevInfoData;
MemberIndex: Cardinal;
PropertyRegDataType: DWord;
RegProperty: Cardinal;
RegTyp: Cardinal;
Key: Hkey;
Info: TRegKeyInfo;
S1,S2: string;
hc: THandle;
begin
Result := Nil;
//
//If we cannot access the setupapi.dll then we return a nil pointer.
//
if not LoadsetupAPI then
exit;
try
//
// get 'Ports' class guid from name
//
GUIDSize := 1; // missing from original code - need to tell function that the Guid structure contains a single GUID
if SetupDiClassGuidsFromName('Ports',#Guid,GUIDSize,RequiredSize) then
begin
//
//get object handle of 'Ports' class to interate all devices
//
DevInfoHandle := SetupDiGetClassDevs(#Guid,Nil,0,DIGCF_PRESENT);
if Cardinal(DevInfoHandle) <> Invalid_Handle_Value then
begin
try
MemberIndex := 0;
result := TStringList.Create;
//iterate device list
repeat
FillChar(DeviceInfoData,SizeOf(DeviceInfoData),0);
DeviceInfoData.cbSize := SizeOf(DeviceInfoData);
//get device info that corresponds to the next memberindex
if Not SetupDiEnumDeviceInfo(DevInfoHandle,MemberIndex,DeviceInfoData) then
break;
//query friendly device name LIKE 'BlueTooth Communication Port (COM8)' etc
RegProperty := SPDRP_FriendlyName; {SPDRP_Driver, SPDRP_SERVICE, SPDRP_ENUMERATOR_NAME,SPDRP_PHYSICAL_DEVICE_OBJECT_NAME,SPDRP_FRIENDLYNAME,}
SetupDiGetDeviceRegistryProperty(DevInfoHandle, DeviceInfoData,RegProperty, PropertyRegDataType,NIL,0,RequiredSize);
SetLength(S1,RequiredSize);
// ShowMessage('TEST: ' + S1);
if SetupDiGetDeviceRegistryProperty(DevInfoHandle,DeviceInfoData,RegProperty,PropertyRegDataType,#S1[1],RequiredSize,RequiredSize) then
begin
KEY := SetupDiOpenDevRegKey(DevInfoHandle,DeviceInfoData,DICS_FLAG_GLOBAL,0,DIREG_DEV,KEY_READ);
if key <> INValid_Handle_Value then
begin
FillChar(Info, SizeOf(Info), 0);
//query the real port name from the registry value 'PortName'
if RegQueryInfoKey(Key, nil, nil, nil, #Info.NumSubKeys,#Info.MaxSubKeyLen, nil, #Info.NumValues, #Info.MaxValueLen,
#Info.MaxDataLen, nil, #Info.FileTime) = ERROR_SUCCESS then
begin
RequiredSize := Info.MaxValueLen + 1;
SetLength(S2,RequiredSize);
if RegQueryValueEx(KEY,'PortName',Nil,#Regtyp,#s2[1],#RequiredSize) = Error_Success then
begin
If (Pos('COM',S2) = 1) then
begin
//Test if the device can be used
hc := CreateFile(pchar('\\.\' + S2 + #0), GENERIC_READ or GENERIC_WRITE,
0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if hc <> INVALID_HANDLE_VALUE then
begin
Result.Add(Strpas(PChar(S2)) + ' := ' + StrPas(PChar(S1)));
CloseHandle(hc);
end;
end;
end;
end;
RegCloseKey(key);
end;
end;
Inc(MemberIndex);
until False;
//If we did not found any free com. port we return a NIL pointer.
if Result.Count = 0 then
begin
Result.Free;
Result := NIL;
end
finally
SetupDiDestroyDeviceInfoList(DevInfoHandle);
end;
end;
end;
finally
UnloadSetupApi;
end;
end;
procedure TMainForm.ListBox1Click(Sender: TObject);
begin
Ardtype := Listbox1.ItemIndex;
MainForm.Hide;
ArdForm.ShowModal;
if Ardform.ModalResult <> mrOK then
ShowMessage('Der opstod en fejl ')
ELSE
BEGIN
MainForm.Show;
END;
end;
end.
Kris aka snestrup2016

How to use the EnumWindows call back function?

I would like to have a single neat (close and self contained) function (let's call it GetDesktopHandle) that returns a handle to the Desktop window. I use the code below. But it only works in the DeskHandle is a global var.
How to get rid of this global variable? If I make it local I get an AV in getDesktopWnd when I try to DeskHandle := hChild
VAR DeskHandle : HWND;
function GetDesktopHandle: HWND;
function getDesktopWnd (Handle: HWND; NotUsed: Longint): bool; stdcall; { Callback function }
VAR hChild : HWND;
begin
if handle <> 0 then
begin
hChild := FindWindowEx(handle, 0, 'SHELLDLL_DefView', nil);
if hChild <> 0 then
begin
hChild := FindWindowEx(hChild, 0, 'SysListView32', nil);
if hChild <> 0
then DeskHandle := hChild;
end;
end;
Result:= TRUE;
end;
begin
DeskHandle := 0;
EnumWindows(#getDesktopWnd, 0);
Result:= DeskHandle;
end;
The main question is: can I write this code as a single function or AT LEAST, can I get rid of the external/global var?
Possible solution:
The documentation says that the second parameter is only a IN parameter.
lParam [in]
Type: LPARAM
An application-defined value to be passed to the callback function.
https://msdn.microsoft.com/en-us/library/windows/desktop/ms633497%28v=vs.85%29.aspx
Would it be wrong to use it to pass the result back?
Local functions cannot be used as callbacks. If you hadn't used the # operator to pass your function, the compiler would have told you that. (Using the operator turns the argument into an ordinary untyped pointer, so the compiler can't check anymore.)
You'll have to make your callback be a standalone function.
To pass data between the callback and the caller, use the second parameter, which you've currently named NotUsed. For example, you could pass a pointer to a handle variable, and then the callback could dereference the pointer to return a result.
type
TMyData = record
Handle: HWND;
Pid: DWORD;
Caption: String;
ClassName: String;
end;
PMyData = ^TMyData;
function GetWindowClass(const Handle: HWND): String;
begin
SetLength(Result, MAX_PATH);
SetLength(Result, GetClassName(Handle, PChar(Result), Length(Result)));
end;
function GetWindowCaption(const Handle: HWND): String;
begin
SetLength(Result, MAX_PATH);
SetLength(Result, GetWindowText(Handle, PChar(Result), Length(Result)));
end;
function EnumChildWindowsProc(Handle: THandle; MyData: PMyData): BOOL; stdcall;
var
ClassName: String;
Caption: String;
Pid: DWORD;
begin
ClassName := GetWindowClass(Handle);
Caption := GetWindowCaption(Handle);
Result := (ClassName = 'SysListView32') and (Caption = 'FolderView');
if Result then
begin
MyData.Handle := Handle;
GetWindowThreadProcessId(Handle, MyData.Pid);
MyData.Caption := Caption;
MyData.ClassName := ClassName;
end;
// To continue enumeration, the callback function must return TRUE;
// to stop enumeration, it must return FALSE
Result := not Result;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
MyData: TMyData;
begin
ZeroMemory(#MyData, SizeOf(MyData));
EnumChildWindows(GetDesktopWindow, #EnumChildWindowsProc, NativeInt(#MyData));
if MyData.Handle > 0 then
begin
ShowMessageFmt('Found Window in Pid %d', [MyData.Pid]);
end
else begin
ShowMessage('Window not found!');
end;
end;

How to compile using Free Pascal

Guys I got a source from a friend that is suppose to help me learn RE a lot but I got error
Error:identifier not found "TResourceStream"
"Bool"
"TMemoryStream"
"TResourceInfo"
"try"
And
Fatal: Syntax error, ";" expected but " identifier MS" found
Please help I need to compile this.
Excuse me please I know nothing yet, about programming.
Here is the source
function EnumResourceNames(hModule: HMODULE; // EXE handle returned from LoadLibrary/Ex
lpType: PChar; // resource type (eg: RT_RCDATA)
lpEnumFunc: ENUMRESNAMEPROC; // callback function address
lParam: Integer // long integer (eg: pointer to an object)
): BOOL; stdcall;
function CB_EnumDfmNameProc(hModule: THandle; lpszType, lpszName: PChar;
lParam: Integer): Boolean; stdcall;
var
ms: TMemoryStream;
rs: TResourceStream;
Buffer: array of Byte;
begin
with TResourceInfo(lParam) do
begin
rs := TResourceStream.Create(TResourceInfo(lParam).Module,
lpszname, lpszType); // load resource in memory
try
ms := TMemoryStream.Create;
try
try
SetLength(Buffer, 4);
rs.Read(Buffer[0], SizeOf(Buffer)); // read the first 4 bytes
if string(Buffer) = 'TPF0' then // is it a DFM resource?
begin
rs.Seek(0, 0);
ObjectBinaryToText(rs, ms); // decode DFM
ms.Seek(0, 0);
AddDfm(StrPas(lpszName), ms); // add it to our own list
end;
except
raise;
end;
finally
ms.Free;
end;
finally
rs.free;
end;
end;
Result := True;
end;
procedure TResourceInfo.EnumDfmNames;
begin
if FModule > 0 then // if an EXE file has been loaded
EnumResourceNames(FModule, RT_RCDATA, // go and search RCDATA resources
#CB_EnumDfmNameProc, Integer(Self));
end;

How to Start an application and obtain a handle to it with Delphi?

I want to start an application from Delphi, and obtain a handle to it, so I can embed the main window of said application on a frame of type TFrame. So far I have tried:
Function TFrmEmbeddedExe.StartNewApplication : Boolean;
var
SEInfo: TShellExecuteInfo;
ExitCode : DWORD;
begin
FillChar(SEInfo, SizeOf(SEInfo), 0) ;
SEInfo.cbSize := SizeOf(TShellExecuteInfo) ;
with SEInfo do
begin
fMask := SEE_MASK_NOCLOSEPROCESS;
Wnd := self.Handle;
lpFile := PChar(self.fexecuteFileName) ;// Example could be 'C:\Windows\Notepad.exe'
nShow := SW_SHOWNORMAL;//SW_HIDE;
end;
if ShellExecuteEx(#SEInfo) then
begin
sleep(1500);
self.fAppWnd := FindWindow(nil, PChar(self.fWindowCaption)); //Example : 'Untitled - Notepad'
if self.fAppWnd <> 0 then
begin
Windows.SetParent(self.fAppWnd, SEInfo.Wnd);
ShowWindow(self.fAppWnd, SW_SHOWMAXIMIZED);
result := true;
end
else
result := false;
end
else
result := false;
end ;
The above code actually works, but findWindow will find any given instans of the application I started. I want to embed the exact instans that I Shellexecuted.
So if Notepad had been started a couple of times, there is no way I can get the correct one using FindWindow.
I have tried:
Function TfrmEmbeddedExe.CreateProcessNewApplication : Boolean;
var
zAppName: array[0..512] of char;
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
Res : DWORD;
DoWait : Boolean;
begin
DoWait := False;
StrPCopy(zAppName, self.fexecuteFileName); //'C:\Windows\Notepad.exe'
FillChar(StartupInfo, Sizeof(StartupInfo), #0);
StartupInfo.cb := Sizeof(StartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := SW_SHOWNORMAL;
if CreateProcess (zAppName,
nil, { pointer to command line string }
nil, { pointer to process security attributes }
nil, { pointer to thread security attributes }
false, { handle inheritance flag }
CREATE_NEW_CONSOLE or { creation flags }
NORMAL_PRIORITY_CLASS,
nil, { pointer to new environment block }
nil, { pointer to current directory name }
StartupInfo, { pointer to STARTUPINFO }
ProcessInfo) then { pointer to PROCESS_INF }
begin
if DoWait then //just set it to false... so it will never enter here
begin
WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
GetExitCodeProcess(ProcessInfo.hProcess, Res);
end
else
begin
self.fAppWnd := ProcessInfo.hProcess;
Windows.SetParent(self.fAppWnd, self.Handle);
ShowWindow(self.fAppWnd, SW_SHOWMAXIMIZED);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
end;
result := true;
end
else begin
Result := false;
end;
end;
PLEASE DO NOT RUN THE ABOVE CODE! It produces weird results involving picking a seemingly random window anywhere in all running applications and embedding that (even menu-items from the Windows start menu..)
So basically what I need is how do I start an application, and grab a handle to the application's main window.
Here's the rough outline of what you need to do. I'll leave the coding up to you:
Start your process with either ShellExecuteEx or CreateProcess. This will yield a process handle.
Call WaitForInputIdle on the process handle. This gives the process a chance to load and start its message loop.
Pass the process handle to GetProcessId to obtain the process ID.
Use EnumWindows to enumerate the top level windows.
Pass each of these windows to GetWindowThreadProcessId to check whether or not you have found the top level window of your target process.
Once you find a window whose process ID matches your target process, you're done!
Don't forget to close your process handles once you are done with them.
This code works for me:
Create a "Utils"- Unit with the following >>
....
interface
.....
function RunProg(PName, CmdLine: String; out ProcessHdl: HWND): HWND;
implementation
type
TEnumData = record // Record Type for Enumeration
WHdl: HWND;
WPid: DWORD;
WTitle: String;
end;
PEnumData = ^TEnumData; // Pointer to Record Type
// Enumeration Function for GetWinHandleFromProcId (below)
function EnumWindowsProcMatchPID(WHdl: HWND; EData: PEnumData): bool; stdcall;
var
Wpid : DWORD;
begin
Result := True; // continue enumeration
GetWindowThreadProcessID(WHdl, #Wpid);
// Filter for only visible windows, because the Pid is not unique to the Main Form
if (EData.WPid = Wpid) AND IsWindowVisible(WHdl) then
begin
EData.WHdl := WHdl;
Result := False; // stop enumeration
end;
end;
// Find Window from Process Id and return the Window Handle
function GetWinHandleFromProcId(ProcId: DWORD): HWND;
var
EnumData: TEnumData;
begin
ZeroMemory(#EnumData, SizeOf(EnumData));
EnumData.WPid := ProcId;
EnumWindows(#EnumWindowsProcMatchPID, LPARAM(#EnumData));
Result := EnumData.WHdl;
end;
// Run Program using CreateProcess >> Return Window Handle and Process Handle
function RunProg(PName, CmdLine: String; out ProcessHdl: HWND): HWND;
var
StartInfo: TStartupInfo;
ProcInfo: TProcessInformation;
ProcessId : DWORD;
WinHdl : HWND;
bOK : boolean;
ix : integer;
begin
FillChar(StartInfo, SizeOf(StartInfo), 0);
StartInfo.cb := SizeOf(StartInfo);
StartInfo.dwFlags := STARTF_USESHOWWINDOW;
StartInfo.wShowWindow := SW_Show;
bOK := CreateProcess(PChar(PName), PChar(CmdLine), nil, nil, False, 0, nil, nil, StartInfo, ProcInfo);
ProcessHdl := ProcInfo.hProcess;
ProcessId := ProcInfo.dwProcessId;
// Note : "WaitForInputIdle" does not always wait long enough, ...
// so we combine it with a repeat - until - loop >>
WinHdl := 0;
if bOK then // Process is running
begin
WaitForInputIdle(ProcessHdl,INFINITE);
ix := 0;
repeat // Will wait (up to 10+ seconds) for a program that takes very long to show it's main window
WinHdl := GetWinHandleFromProcId(ProcessId);
Sleep(25);
inc(ix);
until (WinHdl > 0) OR (ix > 400); // Got Handle OR Timeout
end;
Result := WinHdl;
CloseHandle(ProcInfo.hThread);
end;
Put this in your main program that uses the "Utils"- Unit >>
var
SlaveWinHdl : HWND; // Slave Program Window Handle
SlaveProcHdl : HWND; // Slave Program Process Handle
// Button to run Notepad - Returning Window Handle and Process Handle
procedure TForm1.Button1Click(Sender: TObject);
var
Pname, Pcmnd: string;
begin
Pname := 'C:\WINDOWS\system32\notepad.exe';
Pcmnd := '';
SlaveWinHdl := RunProg(Pname, Pcmnd, SlaveProcHdl);
end;
// Button to Close program using Window Handle
procedure TForm1.Button2Click(Sender: TObject);
begin
PostMessage(SlaveWinHdl, WM_CLOSE, 0, 0);
end;
// Button to Close program using Process Handle
procedure TForm1.Button3Click(Sender: TObject);
begin
TerminateProcess(SlaveProcHdl, STILL_ACTIVE);
CloseHandle(SlaveProcHdl);
end;
So there you have it, a complete solution of how to Run an external program,
and then Close it by using either the Window Handle or Process Handle.
Extra Bonus: Sometimes you have to find the handles for a program that is already running.
You can find it based on the Window- Title with the following code (added to your “Utils” unit) >>
function EnumWindowsProcMatchTitle(WHdl: HWND; EData: PEnumData): bool; stdcall;
var
WinTitle: array[0..255] of char;
Wpid : DWORD;
begin
Result := True; // continue enumeration
GetWindowText(WHdl, WinTitle, 256);
if (Pos(EData.WTitle, StrPas(WinTitle)) <> 0) then // Will also match partial title
begin
EData.WHdl := WHdl;
GetWindowThreadProcessID(WHdl, #Wpid);
EData.WPid := Wpid;
Result := False; // stop enumeration
end;
end;
function GetHandlesFromWinTitle(WinTitle: String; out ProcHdl : HWND): HWND;
var
EnumData: TEnumData;
begin
ZeroMemory(#EnumData, SizeOf(EnumData));
EnumData.WTitle := WinTitle;
EnumWindows(#EnumWindowsProcMatchTitle, LPARAM(#EnumData));
ProcHdl := OpenProcess(PROCESS_ALL_ACCESS,False,EnumData.WPid);
Result := EnumData.WHdl;
end;
And call it (from your main program), like this >>
strWT := ‘MyList.txt – Notepad’; // example of Notepad Title
SlaveWinHdl := GetHandlesFromWinTitle(strWT, SlaveProcHdl);

Resources