ShellExecuteEx 7z Delphi

Question

So I'm trying to do a archive using delphi and ShellExecuteEx my code is :

 Result := False;
  DecodeDate(now,y,m,d);
  NumeFisier := dir+'\Export_'+IntToStr(y)+'.'+IntToStr(m)+'.'+IntToStr(d)+'.zip';
  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 := nil;
    exInfo.lpFile  := PAnsiChar('C:\Windows\System32\cmd.exe');
   exInfo.lpParameters := PAnsiChar('C:\Program Files\7-Zip\7z.exe ' +'a ' + NumeFisier + ' ' + dir);
    nShow := SW_SHOWNORMAL;
   end;
   if ShellExecuteEx(@exInfo) then
    Ph := exInfo.hProcess
    else
     begin
     ShowMessage(SysErrorMessage(GetLastError));
     Result := true;
     exit;
    end;
   while WaitForSingleObject(exInfo.hProcess, 50) <> WAIT_OBJECT_0 do
     Application.ProcessMessages;
   CloseHandle(Ph);

  Result := true;

For some reason this only opens the Command Prompt and doesn't execute the archiving. How can I make it execute the 7z.exe file.

I tried with ShellExecute and it works great, but I have to check then the process is finished, so I'm stuck with ShellExecuteEx

Answer 1

There's no need to involve cmd.exe. That's the command interpreter. You want to execute a different executable so do that directly.

You don't want to use ShellExecuteEx since that has far more generality than you need. All that ShellExecuteEx is doing here is calling CreateProcess. You should do that directly and avoid the middle man. What's more, calling CreateProcess allows you to hide the console window easily. Pass CREATE_NO_WINDOW to achieve that.

Finally, there are better ways to wait than your code. Using MsgWaitForMultipleObjects allows you to avoid polling. And putting this code into a thread would allow you to avoid calls to Application.ProcessMessages.

procedure WaitUntilSignaled(Handle: THandle; ProcessMessages: Boolean);
var
  retval: DWORD;
begin
  if ProcessMessages then begin
    Application.ProcessMessages;//in case there are messages already in the queue
    while True do begin
      retval := MsgWaitForMultipleObjects(1, Handle, False, INFINITE, QS_ALLEVENTS);
      case retval of
      WAIT_OBJECT_0,WAIT_ABANDONED_0:
        break;
      WAIT_OBJECT_0+1:
        Application.ProcessMessages;
      WAIT_FAILED:
        RaiseLastOSError;
      end;
    end;
  end else begin
    Win32Check(WaitForSingleObject(Handle, INFINITE)<>WAIT_FAILED);
  end;
end;

procedure ExecuteProcess(
  const ExecutablePath: string;
  const Arguments: string;
  const CurrentDirectory: string;
  const Wait: Boolean;
  const CreationFlags: DWORD
);
var
  si: TStartupInfo;
  pi: TProcessInformation;
  MyCurrentDirectory: PChar;
begin
  ZeroMemory(@si, SizeOf(si));
  si.cb := SizeOf(si);

  if CurrentDirectory <> '' then begin
    MyCurrentDirectory := PChar(CurrentDirectory);
  end else begin
    MyCurrentDirectory := nil;
  end;

  Win32Check(CreateProcess(
    nil,
    PChar('"' + ExecutablePath + '" ' + Arguments),
    nil,
    nil,
    False,
    CreationFlags,
    nil,
    MyCurrentDirectory,
    si,
    pi
  ));
  try
    if Wait then begin
      WaitUntilSignaled(pi.hProcess, True);
    end;
  finally
    CloseHandle(pi.hProcess);
    CloseHandle(pi.hThread);
  end;
end;