Related
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;
function GetFileIcon(const filename:string): HICON;
var
shfi: TShFileInfo;
begin
try
FillChar(shfi, SizeOf(TShFileInfo), 0);
ShGetFileInfo(PChar(filename), 0, shfi, SizeOf(TShFileInfo), SHGFI_ICON or SHGFI_LARGEICON);
Result := shfi.hIcon;
except
Result := 0;
end;
end;
Using delphi xe2, on win 7 64bits, this function will often return 0 when called inside a Tthread, but is always working fine when called from main thread. It looks like a shell initialization problem, because after a while it will work in the Thread as well.
I found a similar question in stack overflow (Calling SHGetFileInfo in thread to avoid UI freeze) but it is for c++ language so I did not sort it out.
Update: It seems ShGetFileInfo is not threadsafe. When there are multiple threads calling it simultaneously, it fails. See David
Hefferman's answer below. Also using CoInitializeEx instead of Coinitialize does not help with multiple threads. You have to serilize access using a TCriticalSection.
From the documentation:
You must initialize Component Object Model (COM) with CoInitialize or OleInitialize prior to calling SHGetFileInfo.
In a GUI app, the COM is initialized in the main thread. But from other threads that does not happen automatically. You will need to do it explicitly.
Beyond that you are not handling errors correctly. Remember that Windows API functions do not raise exceptions. So your exception handler is pointless and should be removed. Instead you need to check the return value of your call to SHGetFileInfo, as described in the documentation.
Beyond that your code works, as this program demonstrates:
{$APPTYPE CONSOLE}
uses
Classes, Windows, ActiveX, ShellAPI;
var
hThread: THandle;
ThreadId: Cardinal;
function ThreadFunc(Parameter: Pointer): Integer;
var
shfi: TSHFileInfo;
begin
CoInitialize(nil);
Try
if ShGetFileInfo('C:\windows\explorer.exe', 0, shfi, SizeOf(shfi), SHGFI_ICON or SHGFI_LARGEICON)=0 then
begin
Writeln('ShGetFileInfo Failed');
Result := 1;
exit;
end;
Writeln(shfi.hIcon);
Finally
CoUninitialize;
End;
Result := 0;
end;
begin
hThread := BeginThread(nil, 0, ThreadFunc, nil, 0, ThreadId);
WaitForSingleObject(hThread, INFINITE);
CloseHandle(hThread);
Readln;
end.
I expect that any failure you observe is actually related to the particular file that you are trying to inspect.
Update: It seems ShGetFileInfo is not threadsafe. When there are multiple threads calling it simultaneously, it fails. I believe that you will need to serialize the calls to ShGetFileInfo with a lock. For instance, TCriticalSection.
The following program, based on the SSCCE you provided in the comments, demonstrates this:
{$APPTYPE CONSOLE}
uses
SysUtils,
Classes,
SyncObjs,
Windows,
ActiveX,
ShellAPI;
var
hThreads: TWOHandleArray;
ThreadId: Cardinal;
Lock: TCriticalSection;
function ThreadFunc(Parameter: Pointer): Integer;
var
shfi: TSHFileInfo;
randomnumber: integer;
fname: string;
begin
CoInitialize(nil);
Try
fname := 'c:\desktop\file'+IntToStr(Integer(Parameter))+'.exe';
Lock.Acquire;
try
if ShGetFileInfo(pchar(fname), 0, shfi, SizeOf(shfi), SHGFI_ICON or SHGFI_LARGEICON)=0 then
begin
Writeln('ShGetFileInfo Failed');
Result := 1;
exit;
end;
Writeln(shfi.hIcon);
finally
Lock.Release;
end;
Finally
CoUninitialize;
End;
Result := 0;
end;
var
i: integer;
begin
Lock := TCriticalSection.Create;
for i := 0 to 9 do
hThreads[i] := BeginThread(nil, 0, ThreadFunc, Pointer(i), 0, ThreadId);
WaitForMultipleObjects(10, #hThreads,true, INFINITE);
Readln;
end.
Remove the critical section, and the calls to ShGetFileInfo succeed, but return 0 for the icon handle. With the critical section, valid icon handles are returned.
In order to learn multithreading, I've created a thread inside a COM Thread (TRemoteDataModule).
This is my Component Factory:
TComponentFactory.Create(ComServer, TServerConn2, Class_ServerConn2, ciMultiInstance, tmApartment);
Inside the Thread, I didn't needed to Call CoInitialize to use TADOQuery.Create, .Open... .Exec
I read that I need to initialize the COM library on a thread before you call any of the library functions except CoGetMalloc, to get a pointer to the standard allocator, and the memory allocation functions.
But in this case, the absence of CoInitialize didn't brought me any trouble.
Is this related with Thread Model?
Where can I Find the explanation for this subject?
UPDATE:
When I say INSIDE, it means inside the COM method context:
interface
type
TWorker = class(TThread);
TServerConn2 = class(TRemoteDataModule, IServerConn2)
public
procedure Method(); safecall;
end;
implementation
procedure TServerConn2.Method();
var W: TWorker;
begin
W := TWorkerTread.Create(Self);
end;
UPDATE 2:
The TADOConnection used to connect to database are currently being created in the COM Thread context (TThread.Create constructor). Although, TADOConnection.Open and TADOQuery.Create/.Open are both being performed inside TThread.Execute .
UPDATE 3 - Simulacrum
Interface:
type
TServerConn2 = class;
TWorker = class(TThread)
private
FDB: TADOConnection;
FOwner: TServerConn2;
protected
procedure Execute; override;
public
constructor Create(Owner: TServerConn2);
destructor Destroy; override;
end;
TServerConn2 = class(TRemoteDataModule, IServerConn2)
ADOConnection1: TADOConnection;
procedure RemoteDataModuleCreate(Sender: TObject);
private
{ Private declarations }
protected
class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
procedure CheckException; safecall;
public
User, Pswd, Str: String;
Ok: Boolean;
end;
Implementation:
class procedure TServerConn2.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
begin
if Register then
begin
inherited UpdateRegistry(Register, ClassID, ProgID);
EnableSocketTransport(ClassID);
EnableWebTransport(ClassID);
end else
begin
DisableSocketTransport(ClassID);
DisableWebTransport(ClassID);
inherited UpdateRegistry(Register, ClassID, ProgID);
end;
end;
{ TWorker }
constructor TWorker.Create(Owner: TServerConn2);
begin
inherited Create(False);
FreeOnTerminate := True;
FDB := TADOConnection.Create(nil);
FOwner := Owner;
end;
destructor TWorker.Destroy;
begin
FDB.Free;
FOwner.Ok := True;
inherited;
end;
procedure TWorker.Execute;
var Qry: TADOQuery;
begin
FDB.LoginPrompt := False;
FDB.ConnectionString := FOwner.Str;
FDB.Open(FOwner.User, FOwner.Pswd);
Qry := TADOQuery.Create(nil);
try
Qry.Connection := FDB;
Qry.LockType := ltReadOnly;
Qry.SQL.Text := 'SELECT TOP 1 * FROM MyTable';
Qry.Open;
finally
Qry.Free;
end;
end;
procedure TServerConn2.CheckException;
var W: TWorker;
begin
W := TWorker.Create(Self);
while not Ok do Sleep(100);
end;
procedure TServerConn2.RemoteDataModuleCreate(Sender: TObject);
begin
User := 'user';
Pswd := 'pass';
Str := ADOConnection1.ConnectionString;
end;
initialization
TComponentFactory.Create(ComServer, TServerConn2,
Class_ServerConn2, ciMultiInstance, tmApartment);
end.
UPDATE 4
The error should happen here:
function CreateADOObject(const ClassID: TGUID): IUnknown;
var
Status: HResult;
FPUControlWord: Word;
begin
asm
FNSTCW FPUControlWord
end;
Status := CoCreateInstance(ClassID, nil, CLSCTX_INPROC_SERVER or
CLSCTX_LOCAL_SERVER, IUnknown, Result);
asm
FNCLEX
FLDCW FPUControlWord
end;
if (Status = REGDB_E_CLASSNOTREG) then
raise Exception.CreateRes(#SADOCreateError) else
OleCheck(Status);
end;
By somehow (because of TComponentFactory maybe?) CoCreateInstance identifies that TWorker is in the same context than TServerConn2 and don't raise errors?
Either or both of the following might apply:
On a thread not initialized with COM all existing interface pointers keep working until you make a COM API call or otherwise require COM marshalling which then fails detecting an uninitialized thread. That is, your "didn't brought me any trouble" might actually be too early to say.
If any thread in the process calls CoInitialize[Ex] with the COINIT_MULTITHREADED flag, then that not only initializes the current thread as a member of the multi-threaded apartment, but it also says, "Any thread which has never called CoInitialize[Ex] is also part of the multi-threaded apartment." - so called impicit MTA thing
The TADOConnection used to connect to database are currently being created in the COM Thread context (TThread.Create constructor). Although, TADOConnection.Open and TADOQuery.Create/.Open are both being performed inside TThread.Execute .
That will not work, for 2 reasons:
TWorker.Create() and TWorker.Execute() will run in different thread contexts. Create() will run in the context of the thread that is calling TServerConn2.CheckException() (which will have already called CoInitialize/Ex() on itself beforehand), but Execute() will run in the context of the TThread thread instead. ADO is apartment threaded, which means its COM interfaces cannot be used across thread/apartment boundaries unless you marshal them, either via the IGlobalInterfaceTable interface or the CoMarshalInterThreadInterfaceInStream() and CoGetInterfaceAndReleaseStream() functions.
even if you did marshal the ADO interfaces, TWorker.Execute() must call CoInitialize/Ex() on itself. EVERY individual thread must initialize COM to establish its threading model before then accessing any COM interfaces. The threading model dictates how COM accesses interfaces (direct or through proxies), whether message queues are used, etc.
So the simple solution to your problem is to NOT create and use the ADO components across thread boundaries at all. Move your TADOConnection into Execute() instead:
constructor TWorker.Create(Owner: TServerConn2);
begin
inherited Create(False);
FreeOnTerminate := True;
FOwner := Owner;
end;
destructor TWorker.Destroy;
begin
FOwner.Ok := True;
inherited;
end;
procedure TWorker.Execute;
var
DB: TADOConnection;
Qry: TADOQuery;
begin
CoInitialize;
try
DB := TADOConnection.Create(nil);
try
DB.LoginPrompt := False;
DB.ConnectionString := FOwner.Str;
DB.Open(FOwner.User, FOwner.Pswd);
Qry := TADOQuery.Create(nil);
try
Qry.Connection := DB;
Qry.LockType := ltReadOnly;
Qry.SQL.Text := 'SELECT TOP 1 * FROM MyTable';
Qry.Open;
finally
Qry.Free;
end;
finally
DB.Free;
end;
finally
CoUninitialize;
end;
end;
When you create an apartment thread using TComponentFactory it calls CoInitialize and CoUnInitialize for you - it's right in the VCL source (System.Win.VCLCom.pas):
procedure TApartmentThread.Execute;
var
msg: TMsg;
Unk: IUnknown;
begin
try
CoInitialize(nil); // *** HERE
try
FCreateResult := FFactory.CreateInstanceLic(FUnkOuter, nil, FIID, '', Unk);
FUnkOuter := nil;
FFactory := nil;
if FCreateResult = S_OK then
CoMarshalInterThreadInterfaceInStream(FIID, Unk, IStream(FStream));
ReleaseSemaphore(FSemaphore, 1, nil);
if FCreateResult = S_OK then
while GetMessage(msg, 0, 0, 0) do
begin
DispatchMessage(msg);
Unk._AddRef;
if Unk._Release = 1 then break;
end;
finally
Unk := nil;
CoUninitialize; // ** AND HERE
end;
except
{ No exceptions should go unhandled }
end;
end;
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);
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.