Don't like ads? PRO users don't see any ads ;-)
Guest

Untitled

By: a guest on Jun 17th, 2012  |  syntax: None  |  size: 2.84 KB  |  hits: 25  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. Wait before ShellExecute is carried out?
  2. procedure TUpdateForm.OKBtnClick(Sender: TObject);
  3. const SHELL = 'ping 127.0.0.1 -n 2';
  4. begin
  5.   ShellExecute(0,'open',pchar(SHELL+#13+Application.ExeName),nil,nil,SW_SHOWNORMAL);
  6.   Application.Terminate;
  7. end;
  8.        
  9. function TSvUtils.FileExecute(ahWnd: Cardinal; const aFileName, aParams, aStartDir: string; aShowCmd: Integer; aWait: Boolean): Integer;
  10. var
  11.   Info: TShellExecuteInfo;
  12.   ExitCode: DWORD;
  13. begin
  14.  
  15.   Result := -1;
  16.   FillChar(Info, SizeOf(Info), 0);
  17.   Info.cbSize := SizeOf(TShellExecuteInfo);
  18.   with Info do begin
  19.     fMask := SEE_MASK_NOCLOSEPROCESS;
  20.     Wnd := ahWnd;
  21.     lpFile := PChar(aFileName);
  22.     lpParameters := PChar(aParams);
  23.     lpDirectory := PChar(aStartDir);
  24.     nShow := aShowCmd;
  25.   end;
  26.  
  27.   if ShellExecuteEx(@Info) then
  28.   begin
  29.     if aWait then
  30.     begin
  31.       repeat
  32.         Sleep(1);
  33.         Application.ProcessMessages;
  34.         GetExitCodeProcess(Info.hProcess, ExitCode);
  35.       until (ExitCode <> STILL_ACTIVE) or Application.Terminated;
  36.       Result := ExitCode;
  37.     end;
  38.   end
  39. end;
  40.        
  41. function TSvUtils.ProcessExists(const aExeFileName: string; aBringToForgound: Boolean=False): Boolean;
  42. var
  43.   ContinueLoop: BOOL;
  44.   FSnapshotHandle: THandle;
  45.   FProcessEntry32: TProcessEntry32;
  46. begin
  47.  
  48.   FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  49.   FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
  50.   ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
  51.   Result := False;
  52.   while Integer(ContinueLoop) <> 0 do
  53.   begin
  54.     if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
  55.       UpperCase(aExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
  56.       UpperCase(aExeFileName))) then
  57.     begin
  58.       if aBringToForgound then
  59.         EnumWindows(@BringToForgroundEnumProcess, FProcessEntry32.th32ProcessID);
  60.       Result := True;
  61.     end;
  62.     ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  63.   end;
  64.   CloseHandle(FSnapshotHandle);
  65. end;
  66.        
  67. function ExecAndWait(APath: string; var VProcessResult: cardinal): boolean;
  68. var
  69.   LWaitResult : integer;
  70.   LStartupInfo: TStartupInfo;
  71.   LProcessInfo: TProcessInformation;
  72. begin
  73.   Result := False;
  74.  
  75.   FillChar(LStartupInfo, SizeOf(TStartupInfo), 0);
  76.  
  77.   with LStartupInfo do
  78.   begin
  79.     cb := SizeOf(TStartupInfo);
  80.  
  81.     dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
  82.     wShowWindow := SW_SHOWDEFAULT;
  83.   end;
  84.  
  85.   if CreateProcess(nil, PChar(APath), nil, nil,
  86.                    False, NORMAL_PRIORITY_CLASS,
  87.                    nil, nil, LStartupInfo, LProcessInfo) then
  88.   begin
  89.  
  90.     repeat
  91.       LWaitResult := WaitForSingleObject(LProcessInfo.hProcess, 500);
  92.       // do something, like update a GUI or call Application.ProcessMessages
  93.     until LWaitResult <> WAIT_TIMEOUT;
  94.     result := LWaitResult = WAIT_OBJECT_0;
  95.     GetExitCodeProcess(LProcessInfo.hProcess, VProcessResult);
  96.     CloseHandle(LProcessInfo.hProcess);
  97.   end;
  98. end;