ShellExecuteAndWait não está funcionando?

Delphi

23/01/2025

A um tempo achei esse função "ShellExecuteAndWait" ela funciona bem no meu exe antigo mais no meu novo projeto não está funcioando não sei porque...
uses
  Winapi.ShellApi
...

///  ****** Parameters ******
///  Operation:
///
///  edit       : Inicia um editor e abre o documento para edição.
///  explore    : Explora a pasta especificada por lpFile.
///  find       : Inicia uma pesquisa a partir do diretório especificado.
///  open       : Abre o arquivo ou pasta especificado pelo parâmetro lpFile.
///  print      : Imprime o arquivo do documento especificado por lpFile.
///  properties : Exibe as propriedades do arquivo ou pasta.
///
///  FileName:
///
///  Especifica o nome do arquivo ou objeto no qual ShellExecuteEx executará a
///  ação especificada pelo parâmetro lpVerb.
///
///  Parameter:
///
///  String que contém os parâmetros do aplicativo.
///  Os parâmetros devem ser separados por espaços.
///
///  Directory:
///
///  Especifica o nome do diretório de trabalho.
///  Se este membro não for especificado, o diretório atual será usado como o
///  diretório de trabalho.
///
///  Show:
///
///  Flags que especificam como um aplicativo deve ser exibido quando aberto.
///  Pode ser um dos valores SW_
///
///  bWait:
///
///  Se true, a função aguarda o término do processo
Function ShellExecuteAndWait(Operation, FileName, Parameter, Directory: String; Show: Word; bWait: Boolean): Longint;
var
  bOK: Boolean;
  Info: TShellExecuteInfo;
begin
  FillChar(Info, SizeOf(Info), Chr(0));
  Info.cbSize       := SizeOf(Info);
  Info.fMask        := SEE_MASK_NOCLOSEPROCESS;
  Info.lpVerb       := PChar(Operation);
  Info.lpFile       := PChar(FileName);
  Info.lpParameters := PChar(Parameter);
  Info.lpDirectory  := PChar(Directory);
  Info.nShow        := Show;
  bOK               := Boolean(ShellExecuteEx(@Info));

  if bOK then
  begin
    if bWait then
    begin
      while WaitForSingleObject(Info.hProcess, 100) = WAIT_TIMEOUT do
        Application.ProcessMessages;
      bOK := GetExitCodeProcess(Info.hProcess, DWORD(Result));
    end else
      Result := 0;
  end;
  if not bOK then
    Result := -1;
end;

// Uso ela assim..
CommandRAR    := 'a -r -y -ibck -v15m -df  '+NomeRAR+'  "C:\TSD\TMP\XML_NFe" "C:\TSD\TMP\XML_NFCe"';
I := ShellExecuteAndWait('open', 'C:\Program Files\Winrar\Winrar.exe', PChar(CommandRAR), '', SW_HIDE, True);


Se alguem tiver ideia do que está faltando posta ai por favor...
Eduardo Silva

Eduardo Silva

Curtidas 0

Respostas

Eduardo Silva

Eduardo Silva

23/01/2025

Simplesmente quando executado não acontece nada...
GOSTEI 0
Arthur Heinrich

Arthur Heinrich

23/01/2025

Não sei explicar o por quê da sua rotina não estar funcionando. Pode ser permissão ou coisa do tipo.

Eu tenho uma rotina semelhante, mas que utiliza outra API.

function ExecProcess(ProgramName : String; WaitTimeout : DWord = Infinite):Boolean;
begin
{ fill with known state }
FillChar(StartInfo,SizeOf(TStartupInfo),#0);
FillChar(ProcInfo,SizeOf(TProcessInformation),#0);
StartInfo.cb := SizeOf(TStartupInfo);

Result := CreateProcess(nil, PChar(ProgramName), nil, nil,False,
CREATE_NEW_PROCESS_GROUP+NORMAL_PRIORITY_CLASS,
nil, nil, StartInfo, ProcInfo);
{ check to see if successful }
if Result
then
begin
WaitForSingleObject(ProcInfo.hProcess, WaitTimeout);
GetExitCodeProcess(ProcInfo.hProcess, ExitCode);
if (ExitCode <> Still_Active)
then
begin
CloseHandle(ProcInfo.hProcess);
CloseHandle(ProcInfo.hThread);
end;
end;
end;

function KillProcess(ProcInfo : TProcessInformation; ExitCode : Cardinal = 0):Boolean;
var
ECode : Cardinal;
begin
Result:=False;
if (ProcInfo.hProcess<>0)
then
begin
GetExitCodeProcess(ProcInfo.hProcess, ECode);
if (ECode = Still_Active)
then
begin
TerminateProcess(ProcInfo.hProcess, ExitCode);
CloseHandle(ProcInfo.hProcess);
CloseHandle(ProcInfo.hThread);
Result:=True;
end;
end;
end;
GOSTEI 0
POSTAR