在执行 ShellExecute 之前等待?

发布于 2024-11-07 08:37:11 字数 863 浏览 5 评论 0原文

我有一个希望很快的问题:是否可以稍微延迟 ShellExecute 的执行?

我有一个带有自动更新程序的应用程序。下载所有必需的文件等后,它将当前文件重命名为 *.OLD,并将新文件重命名为以前的文件。够简单的。但随后我需要删除那些 .OLD 文件。这个“清理”过程在 MainForm.OnActivate 上执行(检查它是否是第一个激活过程)。但这显然发生得太快了(我从DeleteFile中得到False)。这是过程:

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;

此过程应该重新启动应用程序。我确信删除问题是由第二个应用程序的快速启动引起的,因为如果我自己重新启动它,给它一点时间,文件就会正常删除。

tl;dr 版本:我需要调用 ShellExecute(),它会等待一段时间(0.1 秒左右),然后执行命令。

注意

我尝试使用 -ping 命令来尝试延迟它,但没有成功。

提前非常感谢您

编辑:重新措辞

我需要做到这一点|| 第一个应用程序关闭;等待100毫秒;第二个应用程序打开 ||。我需要先调用 ShellExecute,然后等到调用应用程序完全关闭自身,然后执行 shell(即打开第二个应用程序)

I have a hopefully quick question: Is it possible to delay execution of ShellExecute a little bit?

I have an application with autoupdater. After it downloads all necessary files etc, it renames current files to *.OLD and the new as the previous. Simple enough. But then I need to delete those .OLD files. This 'cleanup' procedure is executed on MainForm.OnActivate (with a check if it is the first activate proc). But this apparently happens too fast (I get False from DeleteFile). This is the procedure:

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;

This procedure is supposed to restart the application. I am certain that the deleting problem is caused by the quick start of the second application, because if I restart it myself, giving it a little time, the files get deleted normally.

tl;dr version: I need to call ShellExecute() which waits a bit (0.1 sec or so) and THEN executes the command.

Note

I tried using the -ping command to try to delay it, but it didn't work.

Thank you very much in advance

Edit: Rephrased

I need this to happen || First app closes; Wait 100 ms; second app opens ||. I need to call ShellExecute first, then wait until the calling application closes itself completely, then execute the shell (i.e. open second application)

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(3

天邊彩虹 2024-11-14 08:37:11

你正在做自动修补程序,对吗?

我遇到了同样的问题,这就是我绕过它的方法:

您使用参数“--delay”或类似的东西运行第二个应用程序。
第二个应用程序处理参数“--delay”并休眠 100 毫秒,然后继续正常运行。

You're doing an autopatcher right ?

I've had the same problem and this is how I bypassed it :

You run second app with argument "--delay" or something like that.
Second app handles argument "--delay" and sleeps for 100 ms, then continues running normally.

走过海棠暮 2024-11-14 08:37:11

这个例程是我们游戏引擎中的一些实用程序代码。它可以运行可执行文件并可选择等待其退出。它将返回其退出代码:

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;
      CloseHandle(Info.hProcess);
      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;

This routine is some utils code in our game engine. It can run an executable and optionally wait for it to exit. It will return its exit code:

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;
      CloseHandle(Info.hProcess);
      Result := ExitCode;
    end;
  end
end;

Here is some code that can check to see if a process exists. So... current app calls the updater and terminates. The updater can check to see if old app has terminated and do it's thing (rename, update, delete, etc):

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;
仅此而已 2024-11-14 08:37:11

如果您可以使用 CreateProcess 而不是 ShellExecute,则可以等待进程句柄。当应用程序退出时,进程句柄会收到信号。例如:

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);
    CloseHandle(LProcessInfo.hThread);
  end;
end;

ExecAndWait返回后,如果需要,可以休眠100ms。

氮@

If you can use CreateProcess instead of ShellExecute, you can wait on the process handle. The process handle is signalled when the application exits. For example:

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);
    CloseHandle(LProcessInfo.hThread);
  end;
end;

After ExecAndWait returns, then you can sleep for 100ms if you need to.

N@

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文