How to check app status and kill it?

Hello!

After Your ShellExecute code use the following function:

function HasUserInput(hwnd: THandle);
begin
  if GetForegroundWindow != hwnd then
   PostMessage(hwnd,WM_Quit, 0, 0);
  end;
end;


Here is example how to use it:

iProc := ShellExecute(...);
while OpenProcess(PROCESS_QUERY_INFORMATION, False, iProc) > 0 do begin
Application.ProcessMessages;
HasUserInput(iProc);
end;

Hope This Helps,Good Luck!

graga,

First of all, you might want to change the way you execute the application. For the OpenProcess to work, you need a Process ID value - you can get this using the CreateProcess API call (with a TStartupInfo and TProcessInformation structure), or if memory serves, ShellExecuteEx may return the Process ID as well. To terminate the process, the following snippet can be used (ProcessError is another external method to raise an error)

procedure KillProcess(dwProcessID: DWord);
var
  hKill: THandle;
begin
  hKill := INVALID_HANDLE_VALUE;
  try
    hKill := OpenProcess(PROCESS_TERMINATE, False, dwProcessId);
    if (hKill = INVALID_HANDLE_VALUE) then
      ProcessError('Cannot get handle to kill process');

    if (not TerminateProcess(hKill, 4)) then
      RaiseLastOSError
    else begin
      Sleep(0);     //  Need this, otherwise the process won't be killed before
      end;          //  returning to the app from a WaitFor method
  finally
    if (hKill <> INVALID_HANDLE_VALUE) then
      CloseHandle(hKill);
  end;
end;

As for waiting to see if the program is wanting user input, that would need to know what kind of input and what type of application (DOS, GUI, console app etc).

Regards,
Mark

Hello Again!

Sorry, I made a mistake in the code, here is the new code:

function HasUserInput(hwnd: THandle);
begin
 if GetForegroundWindow != hwnd then
  PostMessage(hwnd,WM_Quit, 0, 0);
 end;
end;

Here is example how to use it:

iProc := ShellExecute(...);
while OpenProcess(PROCESS_QUERY_INFORMATION, False, iProc) > 0 do begin
Application.ProcessMessages;
HasUserInput(iProc);
end;

Hello Again!

Sorry, I made a mistake in the code, here is the new code:

function HasUserInput(hwnd: THandle);
begin
 if GetForegroundWindow = hwnd then
  PostMessage(hwnd,WM_Quit, 0, 0);
 end;
end;

Here is example how to use it:

iProc := ShellExecute(...);
while OpenProcess(PROCESS_QUERY_INFORMATION, False, iProc) > 0 do begin
Application.ProcessMessages;
HasUserInput(iProc);
end;

what is this application ?
can it be any app or is it your app ?
you could also use CreateProcess
and use the apps MainThread as a wait object
you should do this checking in a separate thread
if it's your app you should create some signaling
"best" would be with Events, check out TEvent in SyncObjs
realy can't say more until I know more about what you're doing :)

The second post is wrong becuase I pressed the submit button accidentally without changing the code :(,
So my last post is the right one



 

Hi Experts,
Thanks for your submissions.
I'm now testing the solutions and will get back as soon as I have something.

To answer Lee Nover:
The application is a system tray application that browses directory of documents and prints them to a default printer. The problem is that some Excel spreadsheets or Work documents may contain macros or other embeded objects that may popup a dialog. In this case, my application would hang awaiting user input. I want to skip printing these documents, write to log that the document could not be printed and go to the next one.

The complete function that does the printing is as follows:

procedure subPrintFile(sFileName: string);
var pOperation, lpFile, s1, s2: string;
    iProc: integer;
    iRet: integer;
begin
     lpFile     := sFileName + #0;
     pOperation := 'print' + #0;
     s1         := '' + #0;
     s2         := '' + #0;
     iProc := ShellExecute(Application.Handle, @pOperation[1], @lpFile[1], @s1[1], @s2[1], 0);

     if iProc > 32 then begin
        if mfCreateLogFile then WriteLn(mtfDebugLog, '-- Print File ' + sFileName + ' Printed with status ' + IntToStr(iProc));
        while OpenProcess(PROCESS_QUERY_INFORMATION, False, iProc) > 0 do
              Application.ProcessMessages;
        end
     else begin
          if mfCreateLogFile then WriteLn(mtfDebugLog, 'ERROR Print File ' + sFileName + ' status ' + IntToStr(iProc)  + ' ' + SysErrorMessage(GetLastError));
          end;
end;

Malsoft,

Doesn't ShellExecute return processID? If not, can you show me how to run ShellExecuteEx given requirements in my previous posting. Since there could be more applications open, I believe it is safer to kill application based on process ID rather than current process and your KillProcess does just that. I just need to put it somehow into my my function.

graga

Neither ShellExecute nor ShellExecuteEx return the processID. However, ShellExecuteEx can return the process handle, so you can even drop the OpenProcess call. Just add "NOCLOSEPROCESS" to the flags.

Regards, Madshi.

Madshi,

Please forgive my ignorance resulting directly from me not knowing much of Win API's. Your comments would be of value to an API expert. But I'm not. I need a sample code that I could use. You can see from my code what I'm trying to do. If you know how to do it, please submit a sample code that will achieve what I want.

graga

Well, I was only commenting on your comment, which you posted right before I posted mine. I can show you how to call ShellExecuteEx correctly and kill the started application again. But in the moment I'm not sure how to detect, whether the program is waiting for user input or not. Anyway, here is an example about how to use ShellExecuteEx to print and then kill the process again after 5 seconds:

uses ShellAPI;

procedure PrintAndStop(document: string);
var sei : TShellExecuteInfo;
begin
  ZeroMemory(@sei, sizeOf(TShellExecuteInfo));
  sei.cbSize := sizeOf(TShellExecuteInfo);
  sei.fMask  := SEE_MASK_FLAG_NO_UI or SEE_MASK_NOCLOSEPROCESS;
  sei.lpFile := pchar(document);
  sei.lpVerb := 'print';
  if ShellExecuteEx(@sei) and (sei.hProcess <> 0) then begin
    Sleep(5000);
    TerminateProcess(sei.hProcess, 0);
    CloseHandle(sei.hProcess);
  end;
end;

(not tested)

Regards, Madshi.

Well, perhaps the following one is better. It waits until the document is printed. If the print needs more then 5 seconds, the print is terminated:

 if ShellExecuteEx(@sei) and (sei.hProcess <> 0) then
   if WaitForSingleObject(sei.hProcess, 5000) = WAIT_TIMEOUT then begin
     TerminateProcess(sei.hProcess, 0);
     CloseHandle(sei.hProcess);
   end;

procedure subPrintFile(sFileName: string);
var SEI: ShellExecuteInfo;
    iProc: Integer;
begin
     FillChar(SEI, SizeOf(SEI), 0);
     SEI.cbSize:=SizeOf(SEI);
     SEI.fMask:=SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_NO_UI; // don't display error messages and leave the process running
     SEI.lpVerb:='print';
     SEI.lpFile:=PChar(sFileName);
     SEI.nShow:=SW_HIDE;

    iProc := ShellExecuteEx(SEI);
    if iProc > 32 then
       try
          if mfCreateLogFile then
             WriteLn(mtfDebugLog, '-- Print File ' + sFileName + ' Printed with status' + IntToStr(iProc));
          //while OpenProcess(PROCESS_QUERY_INFORMATION, False, SEI.hProcess) > 0 do
          // the process is running - from help files
          // The CreateProcess or OpenProcess function returns the handle.
          // A process object's state is signaled when the process terminates
          if WaitForSingleObject(SEI.hProcess, 1000) = WAIT_TIMEOUT then
             TerminateProcess(SEI.hProcess, 0);
       finally
          CloseHandle(SEI.hProcess);
       end
    else begin
       if mfCreateLogFile then
          WriteLn(mtfDebugLog, 'ERROR Print File ' + sFileName + ' status ' + IntToStr(iProc)  + ' ' + SysErrorMessage(GetLastError));
    end;
end;

this only waits 1 second and terminates the process

haven't tried coz I don't have a printer but it should work

hehe .. I see madshi beat me to it :)
that's for eating while writing a post :)

:-)

I will be away for most of the day today. I will check all suggestions when I come back. Thanks again for your help.

graga

Madshi,
Will the code time out while I'm printing a long document, say 1000 pages?
graga

hum .. on win2k there's print spooler service which manages printing
it stores data first then prints
it shouldn't terminate the printing though
but I can't say coz I don't have a printer

I just think it would be safer to start the shellexecuteex with mask SEE_MASK_NOCLOSEPROCESS and then loop until process terminates or pops-up a dialog, in which case we'd terminate the application.
I think I've seen an API call somewhere that returns status of a process but I can't find it anywhere.
I'd rather kill the process based on its status rather than after an arbitrary wait time.
graga

it will never popup a messagebox !
that's why there's that SEE_MASK_FLAG_NO_UI flag :)
you may wait infinitelly with WaitForSingleObject(SEI.hProcess, INFINITE);

const
  INFINITE = DWORD($FFFFFFFF);     { Infinite timeout }

But in this case, what if a document printing time exceeds wait timeout? Then the printing will be killed before it finishes. On the other hand, if I'd set wait time for, say 5 minutes, after each ShellExecuteEx the program will wait 5 minutes doing nothing.

>> Will the code time out while I'm printing a long document, say 1000 pages?

Yes. As I said before I'm not sure how to easily detect whether the printing application is waiting for user input or not. That 5 second example was only there to show you the framework. Of course it's not good this way.

>> if I'd set wait time for, say 5 minutes, after each ShellExecuteEx the program will wait 5 minutes doing nothing.

No, as soon as the printing is done, the WaitForSingleObject call returns, and the wait is over.

Regards, Madshi.

Madshi,

Good news, after including SEE_MASK_FLAG_DDEWAIT flag in sei.fMask everything works nicely. As per my earlier comment, the function was still hanging on printing Word document. Strangely, printing Excel or text documents was completing correctly.
Thanks again.

graga