Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 406
  • Last Modified:

HOW WE STOPE CODE UNTIL THE EXTENAL EXE FINISH

WHEN CALLING EXE TO RUN HOW WE STOPE CODE UNTIL THE EXE FINISH?
I MAKING A PRG. WITH DELPHI TO CALE EN EXTRENAL EXE FILE AND I WANT TO STOE THE CODE RUNING UNTIL THE EXTERNAL EXE FILE FINISH RUNNING. AND THEN THE CODE CONTENUE RENNING.
IF WE CAN USE API. FUNCTION TELL ME.
THENKS
AHMED RAGAB
0
RAGAB2000
Asked:
RAGAB2000
  • 2
1 Solution
 
alanwhincupCommented:
You could do it like this:

Make sure you add ShellAPI to the uses clause of the unit.

procedure TForm1.Button1Click(Sender: TObject);
var
  ExInfo : TShellExecuteInfo;
  ExitCode : DWORD;
begin
  FillChar(ExInfo, SizeOf(ExInfo), 0);
  with ExInfo do
  begin
    cbSize := SizeOf(ExInfo);
    fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
    Wnd := Handle;
    lpVerb := 'Open';
    lpFile := Pchar('notepad');
    nShow := SW_SHOWNORMAL
  end;
  if ShellExecuteEx(@ExInfo) then
  begin
    while GetExitCodeProcess(ExInfo.hProcess, ExitCode) and
          (ExitCode = STILL_ACTIVE) do
      Application.ProcessMessages;
    CloseHandle(ExInfo.hProcess);
  end
  else
    ShowMessage(SysErrorMessage(GetLastError));
  ShowMessage('Program Ended.');
end;

Cheers,

Alan
0
 
intheCommented:
hi,
(caps-lock stuck on? ;-)


two methods:

var
Form1: TForm1;
ProcessHandle: Thandle = 0;

implementation

{$R *.DFM}

uses shellapi;

procedure TForm1.Button1Click(Sender: TObject);
Var
exInfo: TShellExecuteInfo;
Begin
FillChar( exInfo, Sizeof(exInfo), 0 );
With exInfo Do Begin
cbSize:= Sizeof( exInfo );
fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
Wnd := GetActiveWindow();
ExInfo.lpVerb := 'open';
lpFile:= 'D:\hello.rtf'; //your exe here
nShow := SW_SHOWNORMAL;
End;
If ShellExecuteEx( @exInfo ) Then Begin
ProcessHandle := exInfo.HProcess;
End
Else
ShowMessage(SysErrorMessage( GetLastError ));
while WaitForSingleObject(ExInfo.hProcess, 50) <> WAIT_OBJECT_0 do
 Application.ProcessMessages;
CloseHandle(ProcessHandle);
showmessage('process finished');
end;








or:

runthread example using notepad:


unit Unit1;

interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
  ExtCtrls, ComCtrls;
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

const unitName = 'runThread_.';

type TRunThread = class(TThread)
  private
    processHandle : cardinal;
    processReady  : boolean;
    waitingThread : cardinal;
    procedure Execute; override;
  end;

procedure TRunThread.Execute;
begin
  WaitForSingleObject(processHandle,INFINITE);
  processReady:=true;
  PostThreadMessage(waitingThread,WM_NULL,0,0);
end;

procedure TForm1.Button1Click(Sender: TObject);
var si  : TStartupInfo;
    pi  : TProcessInformation;
    dw1 : dword;
begin
  enabled:=false;
  caption:='start copy...';
  ZeroMemory(@si,sizeOf(si)); si.cb:=sizeOf(si);
  si.dwFlags:=STARTF_USESHOWWINDOW; si.wShowWindow:=SW_NORMAL;
  if CreateProcess(nil,'c:\windows\notepad.exe',nil,nil,false,0,nil,nil,si,pi) then begin
    caption:='copy started...';
    with TRunThread.Create(true) do
      try
        processHandle:=pi.hProcess;
        processReady:=false;
        waitingThread:=GetCurrentThreadID;
        caption:='wait for copy...';
        Resume;
        repeat
          Application.HandleMessage;
        until Application.Terminated or processReady;
        caption:='notepad closed...';
      finally Free end;
    GetExitCodeProcess(pi.hProcess,dw1);
    CloseHandle(pi.hThread);
    CloseHandle(pi.hProcess);
    caption:='ready... (exitCode='+IntToStr(dw1)+')';
  end else caption:='could not start notepad...';
  enabled:=true;
end;

end.



Regards Barry
0
 
alanwhincupCommented:
You could also do it by using the CreateProcess function if you dont want to add ShellAPI to the uses clause of the unit:

function ExecFileAndWait(const aCmdLine: string; Hidden, doWait: Boolean): Boolean;
var
  StartupInfo : TStartupInfo;
  ProcessInfo : TProcessInformation;
begin
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  with StartupInfo do
  begin
    cb := SizeOf(TStartupInfo);
    dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
    if Hidden then
      wShowWindow := SW_HIDE
    else
      wShowWindow := SW_SHOWNORMAL;
  end;
  Result := CreateProcess(nil, PChar(aCmdLine), nil, nil, False,
                          NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo,
                          ProcessInfo);
  if doWait then
  begin
    if Result then
    begin
      WaitForInputIdle(ProcessInfo.hProcess, INFINITE);
      WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ExecFileAndWait('notepad.exe', False, True);
  ShowMessage('Program Ended.');
end;
0
 
RAGAB2000Author Commented:
thanks to u all.
Ahmed Ragab
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

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