- Wait before ShellExecute is carried out?
- procedure TUpdateForm.OKBtnClick(Sender: TObject);
- const SHELL = 'ping 127.0.0.1 -n 2';
- begin
- ShellExecute(0,'open',pchar(SHELL+#13+Application.ExeName),nil,nil,SW_SHOWNORMAL);
- Application.Terminate;
- end;
- function TSvUtils.FileExecute(ahWnd: Cardinal; const aFileName, aParams, aStartDir: string; aShowCmd: Integer; aWait: Boolean): Integer;
- var
- Info: TShellExecuteInfo;
- ExitCode: DWORD;
- begin
- Result := -1;
- FillChar(Info, SizeOf(Info), 0);
- Info.cbSize := SizeOf(TShellExecuteInfo);
- with Info do begin
- fMask := SEE_MASK_NOCLOSEPROCESS;
- Wnd := ahWnd;
- lpFile := PChar(aFileName);
- lpParameters := PChar(aParams);
- lpDirectory := PChar(aStartDir);
- nShow := aShowCmd;
- end;
- if ShellExecuteEx(@Info) then
- begin
- if aWait then
- begin
- repeat
- Sleep(1);
- Application.ProcessMessages;
- GetExitCodeProcess(Info.hProcess, ExitCode);
- until (ExitCode <> STILL_ACTIVE) or Application.Terminated;
- Result := ExitCode;
- end;
- end
- end;
- function TSvUtils.ProcessExists(const aExeFileName: string; aBringToForgound: Boolean=False): Boolean;
- var
- ContinueLoop: BOOL;
- FSnapshotHandle: THandle;
- FProcessEntry32: TProcessEntry32;
- begin
- FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
- FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
- ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
- Result := False;
- while Integer(ContinueLoop) <> 0 do
- begin
- if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
- UpperCase(aExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
- UpperCase(aExeFileName))) then
- begin
- if aBringToForgound then
- EnumWindows(@BringToForgroundEnumProcess, FProcessEntry32.th32ProcessID);
- Result := True;
- end;
- ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
- end;
- CloseHandle(FSnapshotHandle);
- end;
- function ExecAndWait(APath: string; var VProcessResult: cardinal): boolean;
- var
- LWaitResult : integer;
- LStartupInfo: TStartupInfo;
- LProcessInfo: TProcessInformation;
- begin
- Result := False;
- FillChar(LStartupInfo, SizeOf(TStartupInfo), 0);
- with LStartupInfo do
- begin
- cb := SizeOf(TStartupInfo);
- dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
- wShowWindow := SW_SHOWDEFAULT;
- end;
- if CreateProcess(nil, PChar(APath), nil, nil,
- False, NORMAL_PRIORITY_CLASS,
- nil, nil, LStartupInfo, LProcessInfo) then
- begin
- repeat
- LWaitResult := WaitForSingleObject(LProcessInfo.hProcess, 500);
- // do something, like update a GUI or call Application.ProcessMessages
- until LWaitResult <> WAIT_TIMEOUT;
- result := LWaitResult = WAIT_OBJECT_0;
- GetExitCodeProcess(LProcessInfo.hProcess, VProcessResult);
- CloseHandle(LProcessInfo.hProcess);
- end;
- end;