[Last Call] Learn about multicloud storage options and how to improve your company's cloud strategy. Register Now

x
?
Solved

Waiting for shellexecute

Posted on 2000-02-14
8
Medium Priority
?
1,633 Views
Last Modified: 2010-04-04
How do I persuade Delphi to wait until the program I have just shellexecuted finishes.

I am currently cheating by shellexecuting a batch file which runs the program, then creates a small text file as a tag to say finished.  Surely there's a better way!
0
Comment
Question by:johnstoned
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
8 Comments
 
LVL 1

Expert Comment

by:Fatman121898
ID: 2518832
Hi John,

I commonly use next function to do things like this:

function ExecApplication(APPName, CmdLine: String; ShowMode: DWord; WaitToExit: Boolean): DWord;
//executes as well WIN and DOS application
  var StartInfo: TStartupInfo;
      ProcInfo: TProcessInformation;
  begin
    StartInfo.cb:=SizeOf(StartInfo);
    FillChar(StartInfo, SizeOf(StartInfo), 0);
    StartInfo.dwFlags:=STARTF_USESHOWWINDOW;
    StartInfo.wShowWindow:=ShowMode;
    if AppName<>''
      then CreateProcess(PChar(APPName), PChar(CmdLine), nil, nil, False, 0,
                         nil, nil, StartInfo, ProcInfo)
      else CreateProcess(nil, PChar(CmdLine), nil, nil, False, 0,
                         nil, nil, StartInfo, ProcInfo);
      if WaitToExit then WaitForSingleObject(ProcInfo.hProcess, INFINITE);
    GetExitCodeProcess(ProcInfo.hProcess, Result);

   
    CloseHandle(ProcInfo.hProcess);
    CloseHandle(ProcInfo.hThread);

  end;


Hope helps.

Jo.
0
 
LVL 5

Expert Comment

by:TheNeil
ID: 2519010
John,

Of course there's a better way. Try this:

FUNCTION WinExecAndWait32(FileName : STRING; Visibility : INTEGER): DWORD;
var
  zAppName    : ARRAY[0..512] OF CHAR;
  zCurDir     : ARRAY[0..255] OF CHAR;
  WorkDir     : STRING;
  StartupInfo : TStartupInfo;
  ProcessInfo : TProcessInformation;
  State       : INTEGER;
begin
  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 := -1                  
  else
  begin

    REPEAT                         { Rather than wait infinitely, wait for 0 time... }
      State := WaitforSingleObject(ProcessInfo.hProcess, 0);
      Application.ProcessMessages; { ...BUT put the call in a loop with this }
    UNTIL State <> WAIT_TIMEOUT;   { Loop until the call returns something other than }
                                   { timeout (i.e. something has happened) }

    GetExitCodeProcess(ProcessInfo.hProcess, Result);
  end;
end;

The Neil
0
 
LVL 3

Expert Comment

by:gandalf_the_white
ID: 2519169
listening...
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 20

Expert Comment

by:Madshi
ID: 2519410
Jo/Fatman's code is alright, but doesn't process any messages. That means that your application will look like being crashed.

TheNeil's solution works okay and processes messages, but chases the CPU usage to 100% and DOESN'T CLOSE THE HANDLES!

So I suggest modifying TheNeil's solution a bit. The following code solves the two issues in TheNeil's code:

  ...
  begin

    REPEAT                         { Rather than wait infinitely, wait for 50 time... }
      State := WaitforSingleObject(ProcessInfo.hProcess, 50);
      Application.ProcessMessages; { ...BUT put the call in a loop with this }
    UNTIL State <> WAIT_TIMEOUT;   { Loop until the call returns something other than }
                                   { timeout (i.e. something has happened) }

    GetExitCodeProcess(ProcessInfo.hProcess, Result);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread );
  end;

Regards, Madshi.
0
 
LVL 5

Expert Comment

by:TheNeil
ID: 2519474
Thanks Madshi,

This was some old code that I used way back on Delphi 2 (at least 3 years). I had no idea how it does what it does but it worked for what I needed at the time so I wasn't going to play around with it. I can see what you've done and it makes sense (oh the pleasures of being able to look back at some old code and cringe)

The Neil
0
 
LVL 20

Expert Comment

by:Madshi
ID: 2519612
(O:=
0
 

Accepted Solution

by:
jwtm earned 200 total points
ID: 2520954
TheNeil's & Madshi's solutions can be slightly improved by
using MsgWaitforMultipleObjects instead of WaitforSingleObject
This returns when the child process exits, on timeout, or
when a message is placed in the application's message queue.
So you don't need to poll for Windows messages.
You can wait for any number of child processes this way.
- see the Windows API.

Sample:
var
  handle_table : array[0..N] of  THandle;
begin
   repeat
      n := 1;
      handle_table[0] := ProcessInfo.hprocess;
      k := MsgWaitForMultipleObjects(
         n,                   // number of handles in handle array
         handle_table,        // address of object-handle array
         false,               // wait for all or wait for one
         timeout,             // time-out interval in milliseconds
         QS_ALLINPUT);        // type of input events to wait for

      if (k = $ffffffff) then begin
         Tell_the_User( 'WaitMultiple Failed, error %d', [getlasterror]);
         exit;
      end;
      if (k = WAIT_TIMEOUT) then continue;
      k := k - WAIT_OBJECT_0;
      if (k = n) then
         Application.processmessages
      else if (k >= 0) and (k < n) then begin
         with process_index[k]^ do begin
            if getexitcodeprocess(proc_processhandle, exitcode) then
               Tell_the_user('%s Ended with exit code %d',
                  [proc_ids, exitcode])
            else
               Tell_the_User('%s Ended with error %d',
                  [proc_ids, getlasterror]);
            closehandle(ProcessInfo.hprocess);
            ProcessInfo.hprocess := INVALID_HANDLE_VALUE;
         end;
      end else
         Tell_the_User( 'Unexpected result: %d from WaitMultiple',
            [k+WAIT_OBJECT_0]);
   until Application.Terminated;
0
 
LVL 20

Expert Comment

by:Madshi
ID: 2521595
Hi jwtm, good suggestion - and welcome to the family...   :-)

Regards, Madshi.
0

Featured Post

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.

Question has a verified solution.

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

Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Sometimes it takes a new vantage point, apart from our everyday security practices, to truly see our Active Directory (AD) vulnerabilities. We get used to implementing the same techniques and checking the same areas for a breach. This pattern can re…
In this video, Percona Solutions Engineer Barrett Chambers discusses some of the basic syntax differences between MySQL and MongoDB. To learn more check out our webinar on MongoDB administration for MySQL DBA: https://www.percona.com/resources/we…
Suggested Courses

650 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