Notification when a program is loaded [duplicate] - shell

I need to recognize and fire an event when a file is going to be executed or run by an application. I know I can do it by hooking windows procedures, but I don't know what procedure or event of windows fires.
For example, when an autorun file going to execute, my application should recognize it, Like an antivirus application.
I'm not sure that hooking is useful for my purpose, if solution isn't hooking, please give me a true solution.

try using the PsSetCreateProcessNotifyRoutine, this function adds a driver-supplied callback routine to, or removes it from, a list of routines to be called whenever a process is created or deleted.
you can find a very nice sample int this link written in c++
Detecting Windows NT/2K process execution
UPDATE
Another option is use the WMI events, check the Win32_Process class, the ExecNotificationQuery method and the SWbemEventSource.NextEvent function.
Check this sample tested in delphi 7 and Windows 7, you must run this application from outside of the Delphi IDE or disable the exception notification for the EOleException exception (check this link), to avoid the EOleException wich is intercepted by the IDE.
program GetWMI_InstanceCreationEvent;
{$APPTYPE CONSOLE}
uses
SysUtils
,Windows
,ComObj
,ActiveX
,Variants;
Function KeyPressed:boolean; //detect if an key is pressed
var
NumEvents : DWORD;
ir : _INPUT_RECORD;
bufcount : DWORD;
StdIn : THandle;
begin
Result:=false;
StdIn := GetStdHandle(STD_INPUT_HANDLE);
NumEvents:=0;
GetNumberOfConsoleInputEvents(StdIn,NumEvents);
if NumEvents<> 0 then
begin
PeekConsoleInput(StdIn,ir,1,bufcount);
if bufcount <> 0 then
begin
if ir.EventType = KEY_EVENT then
begin
if ir.Event.KeyEvent.bKeyDown then
result:=true
else
FlushConsoleInputBuffer(StdIn);
end
else
FlushConsoleInputBuffer(StdIn);
end;
end;
end;
function VarStrNUll(VarStr:OleVariant):string;//dummy function to handle null variants
begin
Result:='';
if not VarIsNull(VarStr) then
Result:=VarToStr(VarStr);
end;
function GetWMIObject(const objectName: String): IDispatch; //create a wmi object instance
var
chEaten: Integer;
BindCtx: IBindCtx;
Moniker: IMoniker;
begin
OleCheck(CreateBindCtx(0, bindCtx));
OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), chEaten, Moniker));
OleCheck(Moniker.BindToObject(BindCtx, nil, IDispatch, Result));
end;
Procedure GetWin32_InstanceCreationEvent;
var
objWMIService : OLEVariant;
colMonitoredProcesses : OLEVariant;
objLatestProcess : OLEVariant;
begin
objWMIService := GetWMIObject('winmgmts:\\localhost\root\cimv2');
colMonitoredProcesses := objWMIService.ExecNotificationQuery('Select * From __InstanceCreationEvent Within 1 Where TargetInstance ISA ''Win32_Process'''); //Get the event listener
while not KeyPressed do
begin
try
objLatestProcess := colMonitoredProcesses.NextEvent(100);//set the max time to wait (ms)
except
on E:EOleException do
if EOleException(E).ErrorCode=HRESULT($80043001) then //Check for the timeout error wbemErrTimedOut 0x80043001
objLatestProcess:=Null
else
raise;
end;
if not VarIsNull(objLatestProcess) then
begin
Writeln('Process Started '+VarStrNUll(objLatestProcess.TargetInstance.Name));
Writeln('CommandLine '+VarStrNUll(objLatestProcess.TargetInstance.CommandLine));
Writeln('PID '+VarStrNUll(objLatestProcess.TargetInstance.ProcessID));
end;
end;
end;
begin
try
CoInitialize(nil);
try
Writeln('Press Any key to exit');
GetWin32_InstanceCreationEvent;
finally
CoUninitialize;
end;
except
on E:Exception do
Begin
Writeln(E.Classname, ': ', E.Message);
Readln;
End;
end;
end.

Related

Delphi calling shgetfileinfo from a thread fails

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.

Why I don't need call CoInitialize in a thread created inside a COM Thread?

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 Co­Initialize­[Ex] with the COINIT_MULTI­THREADED 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 Co­Initialize­[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;

Delphi, Windows: Best way to find whether web-browser is running?

What is the best way to find whether a web-browser is running?
Using Delphi XE2 and on Windows, I need to find whether the following web-browsers are currently running:
A) Mozilla Firefox
B) Apple Safari
C) Google Chrome
If found, the process will be terminated because the home page of the web-browser needs to be changed programmatically by modifying the web-browser configuration files (which is either not possible or could result in unpredictable results if done when the web-browser is running).
Does the output from the EnumWindows API function contain sufficient information needed to handle the above task? If yes, then are the window class names for each of the above web-browsers documented anywhere? If no, then which method is most reliable?
TIA.
Terminate a process without the user permission is not good practice, instead you must ask to the user if he wants terminate the app (in this case the web browser).
Now back to your question, you can detect if a app(webbroser) is running checking for the process name (firefox.exe, chrome.exe , safari.exe) using the CreateToolhelp32Snapshot method.
uses
Windows,
tlhelp32,
SysUtils;
function IsProcessRunning(const ListProcess: Array of string): boolean;
var
hSnapshot : THandle;
lppe : TProcessEntry32;
I : Integer;
begin
result:=false;
hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if hSnapshot <> INVALID_HANDLE_VALUE then
try
lppe.dwSize := SizeOf(lppe);
if Process32First(hSnapshot, lppe) then
repeat
for I := Low(ListProcess) to High(ListProcess) do
if SameText(lppe.szExeFile, ListProcess[i]) then
Exit(True);
until not Process32Next(hSnapshot, lppe);
finally
CloseHandle(hSnapshot);
end;
end;
and use like so
IsProcessRunning(['firefox.exe','chrome.exe','safari.exe'])
Now if you want a more reliable way you can search for the class name of the Window (using the FindWindowEx method) and then the PID of the process owner of the handle (using GetWindowThreadProcessId), from here you can use the PID of the process to resolve the name of exe.
{$APPTYPE CONSOLE}
uses
Windows,
tlhelp32,
SysUtils;
function GetProcessName(const th32ProcessID: DWORD): string;
var
hSnapshot : THandle;
lppe : TProcessEntry32;
begin
result:='';
hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if hSnapshot <> INVALID_HANDLE_VALUE then
try
lppe.dwSize := SizeOf(lppe);
if Process32First(hSnapshot, lppe) then
repeat
if lppe.th32ProcessID=th32ProcessID then
Exit(lppe.szExeFile);
until not Process32Next(hSnapshot, lppe);
finally
CloseHandle(hSnapshot);
end;
end;
function IsWebBrowserRunning(const ClassName, ExeName :string) : Boolean;
var
hWindow : THandle;
dwProcessId: DWORD;
begin
result:=False;
hWindow:= FindWindowEx(0, 0, PChar(ClassName), nil);
if hWindow<>0 then
begin
dwProcessId:=0;
GetWindowThreadProcessId(hWindow, dwProcessId);
if dwProcessId>0 then
exit(Sametext(GetProcessName(dwProcessId),ExeName));
end;
end;
begin
try
if IsWebBrowserRunning('MozillaWindowClass','firefox.exe') then
Writeln('Firefox is Running');
if IsWebBrowserRunning('{1C03B488-D53B-4a81-97F8-754559640193}','safari.exe') then
Writeln('Safari is Running');
if IsWebBrowserRunning('Chrome_WidgetWin_1','chrome.exe') then
Writeln('Chrome is Running');
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
readln;
end.

Windows Last Boot Date & Time using Delphi

How to get the date & time of the last boot / reboot / restart on Windows 2008/2003 machine?
I know from command prompt we can use "net statistics", but how to do it via Delphi?
Thanks.
You can use the LastBootUpTime property of the Win32_OperatingSystem WMI Class, which return the Date and time the operating system was last restarted (Note : the returned value of this property is in UTC format).
Check this sample app
{$APPTYPE CONSOLE}
uses
SysUtils,
ActiveX,
Variants,
ComObj;
//Universal Time (UTC) format of YYYYMMDDHHMMSS.MMMMMM(+-)OOO.
//20091231000000.000000+000
function UtcToDateTime(const V : OleVariant): TDateTime;
var
Dt : OleVariant;
begin
Result:=0;
if VarIsNull(V) then exit;
Dt:=CreateOleObject('WbemScripting.SWbemDateTime');
Dt.Value := V;
Result:=Dt.GetVarDate;
end;
procedure GetWin32_OperatingSystemInfo;
const
WbemUser ='';
WbemPassword ='';
WbemComputer ='localhost';
wbemFlagForwardOnly = $00000020;
var
FSWbemLocator : OLEVariant;
FWMIService : OLEVariant;
FWbemObjectSet: OLEVariant;
FWbemObject : OLEVariant;
oEnum : IEnumvariant;
iValue : LongWord;
begin;
FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
FWMIService := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM Win32_OperatingSystem','WQL',wbemFlagForwardOnly);
oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
if oEnum.Next(1, FWbemObject, iValue) = 0 then
begin
Writeln(Format('Last BootUp Time %s',[FWbemObject.LastBootUpTime]));// In utc format
Writeln(Format('Last BootUp Time %s',[formatDateTime('dd-mm-yyyy hh:nn:ss',UtcToDateTime(FWbemObject.LastBootUpTime))]));// Datetime
end;
end;
begin
try
CoInitialize(nil);
try
GetWin32_OperatingSystemInfo;
finally
CoUninitialize;
end;
except
on E:Exception do
Writeln(E.Classname, ':', E.Message);
end;
Writeln('Press Enter to exit');
Readln;
end.
Here is a complete command line application that does what you are talking about.
I've modified this to avoid the GetTickCount overflow issues without relying on external function calls.
Example output:
Windows was last rebooted at: 06/29/2011 9:22:47 AM
Have fun!
program lastboottime;
{$APPTYPE CONSOLE}
uses
SysUtils,
Windows;
function UptimeInDays: double;
const
c_SecondsInADay = 86400;
var
cnt, freq: Int64;
begin
QueryPerformanceCounter(cnt);
QueryPerformanceFrequency(freq);
Result := (cnt / freq) / c_SecondsInADay;
end;
function LastBootTime: TDateTime;
begin
Result := Now() - UptimeInDays;
end;
begin
try
WriteLn('Windows was last rebooted at: ' + DateTimeToStr(LastBootTime));
ReadLn;
except on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
Here's a bit of code that uses GetTickCount64 if available and falls back to GetTickCount if unavailable to compute the date and time of system startup. This is not a perfect solution because GetTickCount64 is only supported on Vista+ : if you're on older Windows, the counter goes back to 0 every 49 days.
program Project29;
{$APPTYPE CONSOLE}
uses
SysUtils, Windows;
type
TGetTickCount64 = function : Int64; stdcall;
var
H_K32: HMODULE;
Tick64Proc: TGetTickCount64;
function BootTime: TDateTime;
var UpTime: Int64;
Seconds, Minutes, Hours: Int64;
begin
if H_K32 = 0 then
begin
H_K32 := LoadLibrary(kernel32);
if H_K32 = 0 then
RaiseLastOSError
else
begin
Tick64Proc := GetProcAddress(H_K32, 'GetTickCount64');
end;
end;
if Assigned(Tick64Proc) then
UpTime := Tick64Proc
else
UpTime := GetTickCount;
Result := Now - EncodeTime(0, 0, 0, 1) * UpTime;
end;
begin
WriteLn(DateTimeToStr(BootTime));
ReadLn;
end.
The GetTickCount function (see MSDN) returns the number of milliseconds that have elapsed since the system was started, so divide it with 1000 to get seconds, with 60 000 to get minutes etc.
The topic I linked also contains this bit:
To obtain the time elapsed since the computer was started, retrieve the System Up Time counter in the performance data in the registry key HKEY_PERFORMANCE_DATA. The value returned is an 8-byte value. For more information, see Performance Counters.

How to Recognize that an Application Intends to Execute \ Run a File?

I need to recognize and fire an event when a file is going to be executed or run by an application. I know I can do it by hooking windows procedures, but I don't know what procedure or event of windows fires.
For example, when an autorun file going to execute, my application should recognize it, Like an antivirus application.
I'm not sure that hooking is useful for my purpose, if solution isn't hooking, please give me a true solution.
try using the PsSetCreateProcessNotifyRoutine, this function adds a driver-supplied callback routine to, or removes it from, a list of routines to be called whenever a process is created or deleted.
you can find a very nice sample int this link written in c++
Detecting Windows NT/2K process execution
UPDATE
Another option is use the WMI events, check the Win32_Process class, the ExecNotificationQuery method and the SWbemEventSource.NextEvent function.
Check this sample tested in delphi 7 and Windows 7, you must run this application from outside of the Delphi IDE or disable the exception notification for the EOleException exception (check this link), to avoid the EOleException wich is intercepted by the IDE.
program GetWMI_InstanceCreationEvent;
{$APPTYPE CONSOLE}
uses
SysUtils
,Windows
,ComObj
,ActiveX
,Variants;
Function KeyPressed:boolean; //detect if an key is pressed
var
NumEvents : DWORD;
ir : _INPUT_RECORD;
bufcount : DWORD;
StdIn : THandle;
begin
Result:=false;
StdIn := GetStdHandle(STD_INPUT_HANDLE);
NumEvents:=0;
GetNumberOfConsoleInputEvents(StdIn,NumEvents);
if NumEvents<> 0 then
begin
PeekConsoleInput(StdIn,ir,1,bufcount);
if bufcount <> 0 then
begin
if ir.EventType = KEY_EVENT then
begin
if ir.Event.KeyEvent.bKeyDown then
result:=true
else
FlushConsoleInputBuffer(StdIn);
end
else
FlushConsoleInputBuffer(StdIn);
end;
end;
end;
function VarStrNUll(VarStr:OleVariant):string;//dummy function to handle null variants
begin
Result:='';
if not VarIsNull(VarStr) then
Result:=VarToStr(VarStr);
end;
function GetWMIObject(const objectName: String): IDispatch; //create a wmi object instance
var
chEaten: Integer;
BindCtx: IBindCtx;
Moniker: IMoniker;
begin
OleCheck(CreateBindCtx(0, bindCtx));
OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), chEaten, Moniker));
OleCheck(Moniker.BindToObject(BindCtx, nil, IDispatch, Result));
end;
Procedure GetWin32_InstanceCreationEvent;
var
objWMIService : OLEVariant;
colMonitoredProcesses : OLEVariant;
objLatestProcess : OLEVariant;
begin
objWMIService := GetWMIObject('winmgmts:\\localhost\root\cimv2');
colMonitoredProcesses := objWMIService.ExecNotificationQuery('Select * From __InstanceCreationEvent Within 1 Where TargetInstance ISA ''Win32_Process'''); //Get the event listener
while not KeyPressed do
begin
try
objLatestProcess := colMonitoredProcesses.NextEvent(100);//set the max time to wait (ms)
except
on E:EOleException do
if EOleException(E).ErrorCode=HRESULT($80043001) then //Check for the timeout error wbemErrTimedOut 0x80043001
objLatestProcess:=Null
else
raise;
end;
if not VarIsNull(objLatestProcess) then
begin
Writeln('Process Started '+VarStrNUll(objLatestProcess.TargetInstance.Name));
Writeln('CommandLine '+VarStrNUll(objLatestProcess.TargetInstance.CommandLine));
Writeln('PID '+VarStrNUll(objLatestProcess.TargetInstance.ProcessID));
end;
end;
end;
begin
try
CoInitialize(nil);
try
Writeln('Press Any key to exit');
GetWin32_InstanceCreationEvent;
finally
CoUninitialize;
end;
except
on E:Exception do
Begin
Writeln(E.Classname, ': ', E.Message);
Readln;
End;
end;
end.

Resources