• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 329
  • Last Modified:

Cancel Created Process

I'm using Delphi to start another process, and that's working well (see code below). Now I want to add a button that cancels the started process if it runs too long.

What's the easiest/safest way to kill this process?

Thanks!
if not CreateProcess(nil,
                        pchar(sBatch + ' ' + sParams),
                        nil,
                        nil,
                        FALSE,
                        CREATE_DEFAULT_ERROR_MODE,
                        nil,
                        nil,
                        StartUpInfo,
                        ProcessInfo) then
    begin
      Form1.StatusBar1.Panels[0].Text :=
       ' Could not run program.';
      Form1.StatusBar1.Refresh;
      Exit;
    end
   else
    begin
      repeat
         iResult := WaitForSingleObject(ProcessInfo.hProcess, 100);
         Application.ProcessMessages;
      until (iResult <> WAIT_TIMEOUT);
      CloseHandle(ProcessInfo.hProcess);
      CloseHandle(ProcessInfo.hThread);
   end;

Open in new window

0
surfbored
Asked:
surfbored
  • 5
  • 3
  • 2
  • +1
1 Solution
 
JohnjcesCommented:
If you know what is in the other application's caption name,  you can use:

function CloseApp(const sCapt: PChar) : boolean;
  var AppHandle:THandle;
begin
  AppHandle:=FindWindow(Nil, sCapt) ;
  Result:=PostMessage(AppHandle, WM_QUIT, 0, 0) ;
end;

John
0
 
surfboredAuthor Commented:
Johnjces,

I'm not sure this would work since the started process is a CONSOLE app. I don't think CONSOLE apps have caption names? I was kinda hoping to use something a little more unique (I won't know if more than one app of the same name will be running).

Thanks!
0
 
JohnjcesCommented:
I did not realize that it was a console application. The window then would have the same caption, i.e. c:\Windows\system32\cmd.exe or command.com.

I do not know!

John

0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
JohnjcesCommented:
It looks like you can get the ProcessID from the PROCESS_INFORMATION structure.

You might try this from Delphi3000.com:

http://www.delphi3000.com/articles/article_857.asp?SK=

John

0
 
surfboredAuthor Commented:
Johnjces,

Thanks again for the idea, but this link gives instructions specifically for Windows NT. I should have specified that I need it for Windows XP (and Vista too, preferably).

Sorry for the confusion.

I've bumped up the point value as well!
0
 
JohnjcesCommented:
Win2K, XP and even Vista are built on NT technology.

"Generally", what works for NT works for 2K, and XP.

Vista is whole different animal.

You should try it in any event! Might just work!

John

0
 
imitchieCommented:
This is a modification of what I use. NT and above (yes, Vista)
var
  Sei: TShellExecuteInfo;
  WaitHandles: array[0..1] of THandle;
 
// PUT THIS SOMEWHERE, MAYBE IN FORM CREATE
  WaitHandles[0] := CreateEvent(nil,TRUE,False,nil); // Signal Event;
 
// PUT THIS SOMEWHERE, MAYBE IN FORM DESTROY
  CloseHandle(WaitHandles[0]);
 
function TForm1.BtnAbortClick(Sender: TObject);
begin
  SetEvent(WaitHandles[0]); // signal abort
end;
 
function ShellExec(const FileName, Parameters, Directory: string;
  iWaitTime: integer;
  const Verb: string = 'OPEN';
  CmdShow: Integer = SW_SHOWNORMAL): integer;
var
  SeiResult: integer;
begin
  FillChar(Sei, SizeOf(Sei), #0);
  Sei.cbSize := SizeOf(Sei);
  Sei.fMask := SEE_MASK_DOENVSUBST  or SEE_MASK_FLAG_NO_UI  or
      SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
  Sei.lpFile := PChar(FileName);
  Sei.lpParameters := PCharOrNil(Parameters);
  Sei.lpDirectory := PCharOrNil(Directory);
  Sei.lpVerb := PCharOrNil(Verb);
  Sei.nShow := CmdShow;
  // try to execute
 
  if ShellExecuteEx(@Sei) then
  begin
    // now wait for it to finish
    WaitHandles[1] := Sei.hProcess;
    ResetEvent(WaitHandles[0]);
    SeiResult := WaitForMultipleObjects(2, @WaitHandles, False, iWaitTime);
    if (SeiResult = WAIT_TIMEOUT) or // timeout-kill
       (SeiResult = WAIT_OBJECT_0) then begin // user abort-kill
      TerminateProcess(Sei.hProcess, 0);
      CloseHandle(Sei.hProcess);
    end;
    Result := 0;
  end
  else
    Result := GetLastError;
end;

Open in new window

0
 
diniludCommented:
private
     ProcessInfo: TProcessInformation;


function ExecuteProcess(FileName: string; Visibility: Integer; BitMask: Integer; Synch: Boolean): Longword;
var
  zAppName: array[0..512] of Char;
  zCurDir: array[0..255] of Char;
  WorkDir: string;
  StartupInfo: TStartupInfo;
  Closed: Boolean;
begin
  Closed := True;
  StrPCopy(zAppName, FileName);
  GetDir(0, WorkDir);
  StrPCopy(zCurDir, WorkDir);
  FillChar(StartupInfo, SizeOf(StartupInfo), #0);
  StartupInfo.cb := SizeOf(StartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := Visibility;
  if not CreateProcess(nil,
    zAppName, // 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) // pointer to PROCESS_INF
    then Result := WAIT_FAILED
  else
  begin
    //running the process on the set of CPUs specified by BitMask
    SetProcessAffinityMask(ProcessInfo.hProcess, BitMask);
    /////
    if (Synch = True) then //if I want a Synchronous execution (I cannot close my
    // application before this process is terminated)
      begin
        Closed:= False;
        repeat
          case WaitForSingleObject(
            ProcessInfo.hProcess, 100) of
              WAIT_OBJECT_0 : Closed:= True;
              WAIT_FAILED : RaiseLastWin32Error;
          end;
          Application.ProcessMessages;
        until (Closed);
        GetExitCodeProcess(ProcessInfo.hProcess, Result);
        //exit code of the launched process (0 if the process returned no error  )
        CloseHandle(ProcessInfo.hProcess);
        CloseHandle(ProcessInfo.hThread);
      end
    else
      begin
        Result := 0;
      end;
  end;
end;

procedure KillProcess;
begin
   CloseHandle(ProcessInfo.hProcess);
   CloseHandle(ProcessInfo.hThread);
end;

    ......
    ......


   ExecuteProcess(FileName,1,0,False);

   procedure Button1Click(Sender:TObject);
   begin
      KillProcess;
   end;
0
 
JohnjcesCommented:
I ran across this which may help. Kill an application by name, i.e. mytask.exe.

Might help...

http://www.torry.net/samples/samples/soft/KillEXE.zip

John
0
 
surfboredAuthor Commented:
None of the solutions offered were exactly what I asked for, but imitchie gave the most direct and simple response. With a little tweaking, it's what I ended up using. Thanks to everyone for taking the time and effort.
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

  • 5
  • 3
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now