ShellExecuteAndWait não está funcionando?
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...
Se alguem tiver ideia do que está faltando posta ai por favor...
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
Curtidas 0
Respostas
Eduardo Silva
23/01/2025
Simplesmente quando executado não acontece nada...
GOSTEI 0
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;
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