Solved

Execute another application, then monitor whether it's running, and terminate it if I want

Posted on 2010-09-06
14
323 Views
Last Modified: 2012-05-10
How would I go about this:
I want to have a 'monitoring' application with these 3 methods:
1. Run another application, for example let's say C:\Windows\system32\calc.exe
2. With a timer, every 500ms I need to check if it's still running, if not, execute it again.
3. Using a button, I want to terminate it
0
Comment
Question by:rfwoolf
  • 5
  • 5
  • 2
  • +2
14 Comments
 
LVL 25

Expert Comment

by:epasquier
ID: 33613941
ProcessHnd:=CreateExternalProcess('C:\Windows\System32\cmd.exe', '');

if ProcessRunning(ProcessHnd) Then Caption:='Running' Else Caption:='Closed';

TerminateProcess(ProcessHnd, 0);
function CreateExternalProcess(const AppPath, AppParams: String; Visibility: integer=-1): THandle;

var

   SI: TStartupInfo;

   PI: TProcessInformation;

   ErrCode:Integer;

   P1,P2,P3:PChar;

   Dir:String;

begin

 FillChar(SI, SizeOf(SI), 0);

 SI.cb := SizeOf(SI);

 if Visibility>=0 Then SI.dwFlags:=STARTF_USESHOWWINDOW;

 SI.wShowWindow := Visibility;

 // Must send NULL for the first Param if DOS app

 if AppPath='' Then P1:=nil else P1:=PChar(AppPath);

 if AppParams='' Then

  begin

   P2:=nil;

   Dir:='';

  end else

  begin

   P2:=PChar(AppParams);

   Dir:=ExtractFilePath(AppParams);

  end;

 if DirectoryExists(Dir) Then P3:=PChar(Dir) Else P3:=nil;



 if (not CreateProcess(P1, P2, nil, nil, FALSE, NORMAL_PRIORITY_CLASS, nil, P3, SI, PI) ) then

  begin

   ErrCode:=GetLastError;

   raise Exception.CreateFmt('Failed to execute program.  Error Code %d - %s', [ErrCode,SysErrorMessage(ErrCode)]);

  end;

 Result:= PI.hProcess;

 CloseHandle(PI.hThread);

end;



function ProcessRunning(Process:THandle):Boolean;

begin

 Result:=WaitForSingleObject(Process, 1) = WAIT_TIMEOUT;

end;

Open in new window

0
 
LVL 14

Assisted Solution

by:systan
systan earned 125 total points
ID: 33614126
There's no need for a  timer,  calc.exe always load when you closed, until you stop it.
unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;



type

  TForm1 = class(TForm)

    Button1: TButton;

    Button2: TButton;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;



var

  Form1: TForm1;

  Stop:Boolean;



implementation

uses ShellApi;



{$R *.dfm}



procedure alwaysrun(ExecuteFile: string);

var

    SEInfo: TShellExecuteInfo;

    ExitCode: DWORD;

 begin

 repeat

    FillChar(SEInfo, SizeOf(SEInfo), 0) ;

    SEInfo.cbSize := SizeOf(TShellExecuteInfo) ;

    with SEInfo do begin

      fMask := SEE_MASK_NOCLOSEPROCESS;

      Wnd := Application.Handle;

      lpFile := PChar(ExecuteFile) ;

      nShow := SW_SHOWNORMAL;

    end;

    if ShellExecuteEx(@SEInfo) then begin

      repeat

        Application.ProcessMessages;

        GetExitCodeProcess(SEInfo.hProcess, ExitCode) ;

      until (ExitCode <> STILL_ACTIVE);

    end;

    until stop=true;

 end;





procedure TForm1.Button1Click(Sender: TObject);

begin

stop:=false;

alwaysrun('c:\Windows\system32\Calc.exe');

end;



procedure TForm1.Button2Click(Sender: TObject);

begin

stop:=true;

application.Terminate;

end;



end.

Open in new window

0
 
LVL 25

Expert Comment

by:epasquier
ID: 33615298
systan, with a code like that you are killing your CPU for nothing.

At least use Application.HandleMessage instead of ProcessMessages, so that the loop might go idle once in a while

anyway, the real solution would be a thread using my functions
0
 
LVL 14

Expert Comment

by:systan
ID: 33615734
You  are right epasqueir;  I guess you can see bad codes without testing it.
Ok; below is the usage of the code snippet given by epasqueir.  Nice code.
But is there a nicer code than that?  I hope there is from epasquier also.
Anyway, I think this code uses in the windows service? to monitor app if it is killed.
unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, ExtCtrls, StdCtrls;



type

  TForm1 = class(TForm)

    Timer1: TTimer;

    Button1: TButton;

    procedure Timer1Timer(Sender: TObject);

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;



var

  Form1: TForm1;

  ProcessHnd: THandle;





implementation



{$R *.dfm}





function CreateExternalProcess(const AppPath, AppParams: String; Visibility: integer=-1): THandle;

var

   SI: TStartupInfo;

   PI: TProcessInformation;

   ErrCode:Integer;

   P1,P2,P3:PChar;

   Dir:String;

begin

 FillChar(SI, SizeOf(SI), 0);

 SI.cb := SizeOf(SI);

 if Visibility>=0 Then SI.dwFlags:=STARTF_USESHOWWINDOW;

 SI.wShowWindow := Visibility;

 // Must send NULL for the first Param if DOS app

 if AppPath='' Then P1:=nil else P1:=PChar(AppPath);

 if AppParams='' Then

  begin

   P2:=nil;

   Dir:='';

  end else

  begin

   P2:=PChar(AppParams);

   Dir:=ExtractFilePath(AppParams);

  end;

 if DirectoryExists(Dir) Then P3:=PChar(Dir) Else P3:=nil;



 if (not CreateProcess(P1, P2, nil, nil, FALSE, NORMAL_PRIORITY_CLASS, nil, P3, SI, PI) ) then

  begin

   ErrCode:=GetLastError;

   raise Exception.CreateFmt('Failed to execute program.  Error Code %d - %s', [ErrCode,SysErrorMessage(ErrCode)]);

  end;

 Result:= PI.hProcess;

 CloseHandle(PI.hThread);

end;



function ProcessRunning(Process:THandle):Boolean;

begin

 Result:=WaitForSingleObject(Process, 1) = WAIT_TIMEOUT;

end;





procedure TForm1.Timer1Timer(Sender: TObject);

begin

if ProcessRunning(ProcessHnd) Then Caption:='Running' Else

ProcessHnd:=CreateExternalProcess('C:\Windows\System32\calc.exe', '');

end;



procedure TForm1.Button1Click(Sender: TObject);

begin

TerminateProcess(ProcessHnd, 0);

Application.Terminate;

end;



end.

Open in new window

0
 
LVL 36

Assisted Solution

by:Geert Gruwez
Geert Gruwez earned 50 total points
ID: 33615898
simple solution is to use WAIT_INFINITE inside thread
0
 
LVL 25

Accepted Solution

by:
epasquier earned 275 total points
ID: 33616073
Oups, I'm seeing an error in my code !!
line 22 in the first post :
 Dir:=ExtractFilePath(AppParams);
replace with
 Dir:=ExtractFilePath(AppPath);

Systan, yes that is how it must be used. Except maybe the Application.Terminate in button1Click - maybe we just want to "pause" the constant execution of this app (server ?). Of course, doing so will require also that the timer be disabled otherwise the process would be restarted.
And we could add the termination of the process if the application is closed
unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, ExtCtrls, StdCtrls;



type

  TForm1 = class(TForm)

    btnStartStop: TButton;

    CheckTimer: TTimer;

    edtAppName: TEdit;

    lblStatus: TLabel;

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure btnStartStopClick(Sender: TObject);

    procedure CheckTimerTimer(Sender: TObject);

  private

    { Private declarations }

    ProcessHnd:THandle;

    ProcessId:Cardinal;



    procedure StartProcess;

    procedure StopProcess;

  public

    { Public declarations }

  end;



var

  Form1: TForm1;



implementation



{$R *.dfm}



// Generic functions



function CreateExternalProcess(const AppPath, AppParams: String; Visibility: integer=-1; pProcessId:pCardinal=nil): THandle;

var

   SI: TStartupInfo;

   PI: TProcessInformation;

   ErrCode:Integer;

   P1,P2,P3:PChar;

   Dir:String;

begin

 FillChar(SI, SizeOf(SI), 0);

 SI.cb := SizeOf(SI);

 if Visibility>=0 Then SI.dwFlags:=STARTF_USESHOWWINDOW;

 SI.wShowWindow := Visibility;

 // Must send NULL for the first Param if DOS app

 if AppPath='' Then P1:=nil else P1:=PChar(AppPath);

 if AppParams='' Then

  begin

   P2:=nil;

   Dir:='';

  end else

  begin

   P2:=PChar(AppParams);

   Dir:=ExtractFilePath(AppPath);

  end;

 if DirectoryExists(Dir) Then P3:=PChar(Dir) Else P3:=nil;



 if (not CreateProcess(P1, P2, nil, nil, FALSE, NORMAL_PRIORITY_CLASS, nil, P3, SI, PI) ) then

  begin

   ErrCode:=GetLastError;

   raise Exception.CreateFmt('Failed to execute program.  Error Code %d - %s', [ErrCode,SysErrorMessage(ErrCode)]);

  end;

 Result:= PI.hProcess;

 if Assigned(pProcessId) Then pProcessId^:=PI.dwProcessId;

 CloseHandle(PI.hThread);

end;



function ProcessRunning(Process:THandle):Boolean;

begin

 Result:=WaitForSingleObject(Process, 1) = WAIT_TIMEOUT;

end;



// Form private



procedure TForm1.StartProcess;

begin

 try

  ProcessHnd:=CreateExternalProcess(Trim(edtAppName.Text), '', -1, @ProcessId);

  btnStartStop.Caption:='Stop';

  lblStatus.Caption:=FormatDateTime('hh:nn:ss ',Now)+

    Format('(Re)Started, Hnd=%d PID=%d',[ProcessHnd,ProcessId]);

 Except

  on E:Exception do

   begin

    lblStatus.Caption:=FormatDateTime('hh:nn:ss ',Now)+E.Message;

    ProcessHnd:=0;

    StopProcess;

   end;

 end;

end;



procedure TForm1.StopProcess;

begin

 if ProcessHnd>0 Then

  begin

   TerminateProcess(ProcessHnd, 0);

   ProcessHnd:=0;

  end; 

 CheckTimer.Enabled:=False;

 btnStartStop.Caption:='Start';

end;



// Form events



procedure TForm1.btnStartStopClick(Sender: TObject);

begin

 if ProcessHnd=0 Then

  begin

   CheckTimer.Enabled:=True

   CheckTimerTimer(CheckTimer); // don't wait first Interval

  end Else StopProcess;

end;



procedure TForm1.CheckTimerTimer(Sender: TObject);



begin

 if (ProcessHnd=0) Or Not ProcessRunning(ProcessHnd) Then StartProcess;

end;



procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

 StopProcess;

end;



end.



//========= DFM



object Form1: TForm1

  Left = 278

  Top = 374

  Width = 403

  Height = 96

  Caption = 'Form1'

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'MS Sans Serif'

  Font.Style = []

  OldCreateOrder = False

  OnClose = FormClose

  PixelsPerInch = 96

  TextHeight = 13

  object lblStatus: TLabel

    Left = 8

    Top = 40

    Width = 3

    Height = 13

  end

  object btnStartStop: TButton

    Left = 8

    Top = 8

    Width = 75

    Height = 25

    Caption = 'Start'

    TabOrder = 0

    OnClick = btnStartStopClick

  end

  object edtAppName: TEdit

    Left = 88

    Top = 8

    Width = 297

    Height = 24

    Font.Charset = DEFAULT_CHARSET

    Font.Color = clWindowText

    Font.Height = -13

    Font.Name = 'MS Sans Serif'

    Font.Style = []

    ParentFont = False

    TabOrder = 1

    Text = 'C:\Windows\System32\calc.exe'

  end

  object CheckTimer: TTimer

    Enabled = False

    OnTimer = CheckTimerTimer

    Left = 8

    Top = 8

  end

end

Open in new window

0
 
LVL 13

Author Comment

by:rfwoolf
ID: 33616086
Thanks for the posts.. just FYI, in this app I am going to use a timer, but it's good to know that there's a way to do it without 'polling' using a timer.
0
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 
LVL 25

Expert Comment

by:epasquier
ID: 33616088
> simple solution is to use WAIT_INFINITE inside thread
yes Geert, a thread would be a good solution, a bit more reactive. But a bit less easy to implement.
I personally like "timer-based" solutions as this one - for simple tools at least. That does not consume much resources and can be implemented in no time
0
 
LVL 14

Expert Comment

by:systan
ID: 33616655
epasquier;
YOur code does greate, but how about without using a timer? A timer consumes memory log, just a little but it does.  Isn't it?
0
 
LVL 25

Expert Comment

by:epasquier
ID: 33616998
> A timer consumes memory log, just a little but it does.  Isn't it?
Yes, everything does. A Thread even more so ! The only thing a thread will consume less is CPU, and also bring more reactivity especially on multi-core systems.
But if you can live with a one-second delay between checks the overhead is really acceptable. I mean it was even with last millenium computers (1999 :o). Don't go below 100ms, it's useless and CPU intensive - even if I don't think you will see much activity on a brand new computer.
One drawback you will have to live with as well : the possibility that some heavy tasks in your application suspend the messaging system long enough for the timer messages to be treated with even longer delay

If the application does not do much hard work itself, then timer-based solutions are good enough

0
 
LVL 14

Expert Comment

by:systan
ID: 33617616
Yes, I believed in you epasquier, you rock delphi.  Listening....
0
 
LVL 14

Expert Comment

by:systan
ID: 33623882
Geert;
>>simple solution is to use WAIT_INFINITE inside thread

Show it Geert, please.
0
 
LVL 6

Assisted Solution

by:saravananvg
saravananvg earned 50 total points
ID: 33624474
Hi,
   Please check the following if it is helpful to you in any way

http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_21990345.html

regards,
Padmaja
0
 
LVL 13

Author Closing Comment

by:rfwoolf
ID: 33779143
Thanks - I think I ended up implementing epasquier's solution :p
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now