Delphi 2010 - Verify if exist process and kill it whenever run

Question

How to verify if a process name (partial name e.g: notep* for notepad.exe) exist and create a loop to kill this process whenever run? In batch it's simple:

:a
taskkill -f -im notep*
goto a

Any help?

Answer 1

You can use a asynchronous WMI event (like __InstanceCreationEvent) to detect when the a process is launched and the using the Win32_Process WMI Class and the Terminate method to kill the process.

You can wrote a WQL sentence like this to detect the launch of any process strating with the "notep" string.

Select * From __InstanceCreationEvent Within 1 Where TargetInstance ISA "Win32_Process" And TargetInstance.Name like "notep%"

Try this sample

{$APPTYPE CONSOLE}

uses
  Windows,
  {$IF CompilerVersion > 18.5}
  Forms,
  {$IFEND}
  OleServer,
  SysUtils,
  ActiveX,
  ComObj,
  Variants;

type
  TSWbemSinkOnObjectReady = procedure(ASender: TObject; const objWbemObject: OleVariant;
                                                        const objWbemAsyncContext: OleVariant) of object;
  TSWbemSinkOnCompleted = procedure(ASender: TObject; iHResult: TOleEnum;
                                                      const objWbemErrorObject: OleVariant;
                                                      const objWbemAsyncContext: OleVariant) of object;
  TSWbemSinkOnProgress = procedure(ASender: TObject; iUpperBound: Integer; iCurrent: Integer;
                                                     const strMessage: WideString;
                                                     const objWbemAsyncContext: OleVariant) of object;
  TSWbemSinkOnObjectPut = procedure(ASender: TObject; const objWbemObjectPath: OleVariant;
                                                      const objWbemAsyncContext: OleVariant) of object;

  ISWbemSink = interface(IDispatch)
    ['{75718C9F-F029-11D1-A1AC-00C04FB6C223}']
    procedure Cancel; safecall;
  end;

  TSWbemSink = class(TOleServer)
  private
    FOnObjectReady: TSWbemSinkOnObjectReady;
    FOnCompleted: TSWbemSinkOnCompleted;
    FOnProgress: TSWbemSinkOnProgress;
    FOnObjectPut: TSWbemSinkOnObjectPut;
    FIntf: ISWbemSink;
    function GetDefaultInterface: ISWbemSink;
  protected
    procedure InitServerData; override;
    procedure InvokeEvent(DispID: TDispID; var Params: TVariantArray); override;
  public
    procedure Connect; override;
    procedure ConnectTo(svrIntf: ISWbemSink);
    procedure Disconnect; override;
    procedure Cancel;
    property DefaultInterface: ISWbemSink read GetDefaultInterface;
  published
    property OnObjectReady: TSWbemSinkOnObjectReady read FOnObjectReady write FOnObjectReady;
    property OnCompleted: TSWbemSinkOnCompleted read FOnCompleted write FOnCompleted;
    property OnProgress: TSWbemSinkOnProgress read FOnProgress write FOnProgress;
    property OnObjectPut: TSWbemSinkOnObjectPut read FOnObjectPut write FOnObjectPut;
  end;


  TWmiAsyncEvent = class
  private
    FWQL      : string;
    FSink     : TSWbemSink;
    FLocator  : OleVariant;
    FServices : OleVariant;
    procedure EventReceived(ASender: TObject; const objWbemObject: OleVariant; const objWbemAsyncContext: OleVariant);
  public
    procedure  Start;
    constructor Create;
    Destructor Destroy;override;
  end;

{ TSWbemSink }

procedure TSWbemSink.Cancel;
begin
 DefaultInterface.Cancel;
end;

procedure TSWbemSink.Connect;
var
  punk: IUnknown;
begin
  if FIntf = nil then
  begin
    punk := GetServer;
    ConnectEvents(punk);
    Fintf:= punk as ISWbemSink;
  end;
end;

procedure TSWbemSink.ConnectTo(svrIntf: ISWbemSink);
begin
  Disconnect;
  FIntf := svrIntf;
  ConnectEvents(FIntf);
end;

procedure TSWbemSink.Disconnect;
begin
  if Fintf <> nil then
  begin
    DisconnectEvents(FIntf);
    FIntf := nil;
  end;
end;

function TSWbemSink.GetDefaultInterface: ISWbemSink;
begin
  if FIntf = nil then
    Connect;
  Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call "Connect" or "ConnectTo" before this operation');
  Result := FIntf;
end;

procedure TSWbemSink.InitServerData;
const
  CServerData: TServerData = (
    ClassID:   '{75718C9A-F029-11D1-A1AC-00C04FB6C223}';
    IntfIID:   '{75718C9F-F029-11D1-A1AC-00C04FB6C223}';
    EventIID:  '{75718CA0-F029-11D1-A1AC-00C04FB6C223}';
    LicenseKey: nil;
    Version: 500);
begin
  ServerData := @CServerData;
end;


procedure TSWbemSink.InvokeEvent(DispID: TDispID; var Params: TVariantArray);
begin
  case DispID of
    -1: Exit;  // DISPID_UNKNOWN
    1: if Assigned(FOnObjectReady) then
         FOnObjectReady(Self,
                        Params[0] {const ISWbemObject},
                        Params[1] {const ISWbemNamedValueSet});
    2: if Assigned(FOnCompleted) then
         FOnCompleted(Self,
                      Params[0] {WbemErrorEnum},
                      Params[1] {const ISWbemObject},
                      Params[2] {const ISWbemNamedValueSet});
    3: if Assigned(FOnProgress) then
         FOnProgress(Self,
                     Params[0] {Integer},
                     Params[1] {Integer},
                     Params[2] {const WideString},
                     Params[3] {const ISWbemNamedValueSet});
    4: if Assigned(FOnObjectPut) then
         FOnObjectPut(Self,
                      Params[0] {const ISWbemObjectPath},
                      Params[1] {const ISWbemNamedValueSet});
  end; {case DispID}

end;


//Detect when a key was pressed in the console window
function KeyPressed:Boolean;
var
  lpNumberOfEvents     : DWORD;
  lpBuffer             : TInputRecord;
  lpNumberOfEventsRead : DWORD;
  nStdHandle           : THandle;
begin
  Result:=false;
  nStdHandle := GetStdHandle(STD_INPUT_HANDLE);
  lpNumberOfEvents:=0;
  GetNumberOfConsoleInputEvents(nStdHandle,lpNumberOfEvents);
  if lpNumberOfEvents<> 0 then
  begin
    PeekConsoleInput(nStdHandle,lpBuffer,1,lpNumberOfEventsRead);
    if lpNumberOfEventsRead <> 0 then
    begin
      if lpBuffer.EventType = KEY_EVENT then
      begin
        if lpBuffer.Event.KeyEvent.bKeyDown then
          Result:=true
        else
          FlushConsoleInputBuffer(nStdHandle);
      end
      else
      FlushConsoleInputBuffer(nStdHandle);
    end;
  end;
end;

{ TWmiAsyncEvent }

constructor TWmiAsyncEvent.Create;
const
  strServer    ='localhost';
  strNamespace ='root\CIMV2';
  strUser      ='';
  strPassword  ='';
begin
  inherited Create;
  CoInitializeEx(nil, COINIT_MULTITHREADED);
  FLocator  := CreateOleObject('WbemScripting.SWbemLocator');
  FServices := FLocator.ConnectServer(strServer, strNamespace, strUser, strPassword);
  FSink     := TSWbemSink.Create(nil);
  FSink.OnObjectReady := EventReceived;
  FWQL:='Select * From __InstanceCreationEvent Within 1 '+
        'Where TargetInstance ISA "Win32_Process" And TargetInstance.Name like "notep%"';

end;

destructor TWmiAsyncEvent.Destroy;
begin
  if FSink<>nil then
    FSink.Cancel;
  FLocator  :=Unassigned;
  FServices :=Unassigned;
  FSink.Free;
  CoUninitialize;
  inherited;
end;

procedure TWmiAsyncEvent.EventReceived(ASender: TObject;
  const objWbemObject: OleVariant;
  const objWbemAsyncContext: OleVariant);
var
  PropVal: OLEVariant;
  FOutParams : OLEVariant;
begin
  PropVal := objWbemObject;
  Writeln(Format('Detected Process  %s  Pid %d',[String(PropVal.TargetInstance.Name), Integer(PropVal.TargetInstance.ProcessId)]));
  Writeln('Killing');
  FOutParams:=PropVal.TargetInstance.Terminate(VarEmpty);
  Writeln(Format('ReturnValue %s',[FOutParams]));
end;

procedure TWmiAsyncEvent.Start;
begin
  Writeln('Listening events...Press Any key to exit');
  FServices.ExecNotificationQueryAsync(FSink.DefaultInterface,FWQL,'WQL', 0);
end;

var
   AsyncEvent : TWmiAsyncEvent;
begin
 try
    AsyncEvent:=TWmiAsyncEvent.Create;
    try
      AsyncEvent.Start;
      //The next loop is only necessary in this sample console sample app
      //In VCL forms Apps you don't need use a loop
      while not KeyPressed do
      begin
          {$IF CompilerVersion > 18.5}
          Sleep(100);
          Application.ProcessMessages;
          {$IFEND}
      end;
    finally
      AsyncEvent.Free;
    end;
 except
    on E:EOleException do
        Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
end.

Answer 2

Enumerating running processes in Delphi will help with enumerating processes.

When you find the one you're looking for, post a WM_QUIT message using SendMessageTimeout to give it a chance to close nicely, and if it doesn't use TerminateProcess to close it forcefully.

If I was going to do something like this, I'd put the whole thing in a TThread so that it could do the scanning for processes in the background without interfering with the user interface of my application.

Answer 3

This is not exact answer for you narrow question. If for windows platform, why do you need to do such a week check. Use Group Policy and under Windows Settings\Security Settings\Software Restriction Policiies\Additional Rules and create file or path rule to block a program to be executed

Cheer Pham

Answer 4

This code exactly does, what you have asked for. Put it in a timer.

function GetText(Wnd: HWND): string;
var
  textlength: Integer;
  Text: PChar;
begin
  textlength := SendMessage(Wnd, WM_GETTEXTLENGTH, 0, 0);
  if textlength = 0 then
    Result := ''
  else
  begin
    GetMem(Text, textlength + 1);
    SendMessage(Wnd, WM_GETTEXT, textlength + 1, Integer(Text));
    Result := Text;
    FreeMem(Text);
  end;
end;

function EnumWindowsProc(Wnd: HWND; lParam: lParam): BOOL; stdcall;
begin
  Result := True;
  if (IsWindowVisible(Wnd) or IsIconic(Wnd)) and
    ((GetWindowLong(Wnd, GWL_HWNDPARENT) = 0) or (GetWindowLong(Wnd, GWL_HWNDPARENT)
    = GetDesktopWindow)) and (GetWindowLong(Wnd, GWL_EXSTYLE) and WS_EX_TOOLWINDOW = 0)
  then
    Form1.ListBox1.Items.Add('Handle: ' + IntToStr(Wnd) + ',Text:  ' + GetText(Wnd));

  if (GetText(Wnd) = 'Untitled - Notepad') then
  begin
    SendMessage(Wnd, WM_SYSCOMMAND, SC_CLOSE, 0);
  end;

end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Param: Longint;
begin
  EnumWindows(@EnumWindowsProc, Param);

end;