Solved

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

Posted on 2010-09-06
14
325 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
Efficient way to get backups off site to Azure

This user guide provides instructions on how to deploy and configure both a StoneFly Scale Out NAS Enterprise Cloud Drive virtual machine and Veeam Cloud Connect in the Microsoft Azure Cloud.

 
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 37

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
 
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

ScreenConnect 6.0 Free Trial

Check out the updates in one game-changing release, ScreenConnect 6.0, based on partner feedback. New features include a redesigned UI that improves session organization and overall user experience. See the enhancements for yourself!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
In a recent question (https://www.experts-exchange.com/questions/28997919/Pagination-in-Adobe-Acrobat.html) here at Experts Exchange, a member asked how to add page numbers to a PDF file using Adobe Acrobat XI Pro. This short video Micro Tutorial sh…
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …

778 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