delphi中调用其它程序，被调用的Exe文件结束后才能获取焦点，类似showmod效果

Question

delphi中调用其它exe程序，被调用的Exe文件结束后才能获取焦点，类似showmod效果

Answer 1

waitForSingleObject不能滿足你的需求嗎？

Answer 2

procedure ExecuteandWaitforProgTerminated(FileName: string; TimeOut: integer);
var
  CmdLine     : array[0..512] of char;
  zCurDir     : array[0..255] of char;
  WorkDir     : string;  StartupInfo : TStartupInfo;
  ProcessInfo : TProcessInformation;
begin
  StrPCopy(CmdLine, FileName);
  WorkDir := ExtractFilePath(FileName);
  StrPCopy(zCurDir, WorkDir);
  FillChar(StartupInfo, Sizeof(StartupInfo),#0);
  StartupInfo.cb          := Sizeof(StartupInfo);
  StartupInfo.dwFlags     := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := SW_SHOWNORMAL;
  if CreateProcess(nil,
                   CmdLine,
                   nil,
                   nil,
                   false,
                   CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,
                   nil,
                   zCurDir,
                   StartupInfo,
                   ProcessInfo) then
  begin
    WaitForSingleObject(ProcessInfo.hProcess, TimeOut);
  end;
end;

Answer 3

看看ShowModal的实现，或有启发

Answer 4

不行吧，父窗口的指定，在createWIndow時，透過參數給定的。你會如何給呢？

Answer 5

父窗口的指定可以通过Windows.SetParent，也可以把本程序窗口置为不可用状态，等程序结束了再置为可用，启动外部程序并等待结束的代码：//FileName为命令行；Visibility：是否可见；TimeOut：运行超时
function WinExecAndWait32(FileName: string; Visibility: integer; TimeOut: DWORD): integer;
{ returns -1 if the Exec failed, otherwise returns the process' }
{ exit code when the process terminates.                        }
var
  zAppName: array[0..512] of char;
  zCurDir: array[0..255] of char;
  WorkDir: string;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin
  StrPCopy(zAppName, FileName);
  GetDir(0, WorkDir);
  StrPCopy(zCurDir, WorkDir);
  FillChar(StartupInfo, Sizeof(StartupInfo), #0);
  StartupInfo.cb := Sizeof(StartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := Visibility;
  if not CreateProcess(nil,
    zAppName, { pointer to command line string }
    nil, { pointer to process security attributes }
    nil, { pointer to thread security attributes }
    false, { handle inheritance flag }
    CREATE_NEW_CONSOLE or { creation flags }
    NORMAL_PRIORITY_CLASS,
    nil, { pointer to new environment block }
    nil, { pointer to current directory name }
    StartupInfo, { pointer to STARTUPINFO }
    ProcessInfo) then { pointer to PROCESS_INF }
    Result := -1
  else
  begin
    case WaitforSingleObject(ProcessInfo.hProcess, TimeOut) of
      WAIT_TIMEOUT: TerminateProcess(ProcessInfo.hProcess, Cardinal(Result));
    else
      GetExitCodeProcess(ProcessInfo.hProcess, Cardinal(Result));
    end;
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
  end;
end;

Answer 6

1、要達到showmodal的效果，使用waitforsingleobject之類的函數是比較合適的，以達到掛起本線程的目的。在這個前提下，那么，to 6#： 你如何使用setparent？2、若是按三樓cnzdgs的說法，
  首先，等待其他程序加載完畢并顯示完窗體，這個等待時間是一個問題；
  其他尚未考慮到 ^_^
           

Answer 7

调用exe后马上form1.Enabled:=false
等exe退出后马上form1.Enabled:=true于是就实现了你所要的功能。

Answer 8

有两种情况需要注意：1.调用单进程程序并等待其结束：
{----|
 名称: CreateProcessAndWait
 功能: 创建进程并等待其结束
 参数: CommandLine: string - 进程命令行
       Timeout: Cardinal - 等待超时(毫秒), 默认(INFINITE)为一直等待至结束.
       ShowStyle: Integer - 程序窗口显示方式, 默认(SW_SHOWNORMAL)为常规显示.
       lpProcessId: PCardinal - 输出进程 ID (进程创建后立即输出)
 返回: Cardinal - 返回 Win32 错误代码, 成功时返回 ERROR_SUCCESS(0), 否则返回一个非 0 的 Win32 错误代码.
-----}
function CreateProcessAndWait(const CommandLine: string; Timeout: Cardinal = INFINITE; ShowStyle: Integer = SW_SHOWNORMAL; lpProcessId: PCardinal = nil): Cardinal;
var
  si: STARTUPINFO;
  pi: PROCESS_INFORMATION;
  nWait: Cardinal;
begin
  Result := ERROR_SUCCESS;  ZeroMemory(@si, SizeOf(STARTUPINFO));
  ZeroMemory(@pi, SizeOf(PROCESS_INFORMATION));  si.cb := SizeOf(STARTUPINFO);
  si.dwFlags := STARTF_USESHOWWINDOW;
  si.wShowWindow := SW_SHOWNORMAL;  try
    try
      // 创建进程
      if not CreateProcess(nil, PChar(CommandLine), nil, nil, False, 0, nil, nil, si, pi) then Exit;      // 输出进程 ID
      if lpProcessId <> nil then
      begin
        lpProcessId^ := pi.dwProcessId;
      end;      // 等待结束
      nWait := WaitForSingleObject(pi.hProcess, Timeout);
      if (nWait = WAIT_FAILED{失败}) or (nWait = WAIT_TIMEOUT{超时}) then Exit;
    except
      Result := GetLastError;
      Exit;
    end;
  finally
    if pi.hProcess <> 0 then CloseHandle(pi.hProcess);
    if pi.hThread <> 0 then CloseHandle(pi.hThread);
    Result := GetLastError;
  end;
end;2.调用的程序还会创建其它子进程，并且需要等待这些所有的进程都结束。这时需要管理整个“作业”对象（可参考Windows核心编程）：
{----|
 名称: CreateJobAndWait
 功能: 创建作业并等待其结束
 参数: CommandLine: string - 主进程命令行
       Timeout: Cardinal - 等待超时(毫秒), 默认(INFINITE)为一直等待至结束.
       ShowStyle: Integer - 程序窗口显示方式, 默认(SW_SHOWNORMAL)为常规显示.
       lphJob: PHandle - 输出作业句柄(作业创建后立即输出)(该句柄使用完后应调用 CloseHandle 进行销毁)
 返回: THandle - 返回 Win32 错误代码, 成功时返回 ERROR_SUCCESS(0), 否则返回一个非 0 的 Win32 错误代码.
-----}
function CreateJobAndWait(const CommandLine: string; Timeout: Cardinal = INFINITE; ShowStyle: Integer = SW_SHOWNORMAL; lphJob: PHandle = nil): Cardinal;
var
  si: STARTUPINFO;
  pi: PROCESS_INFORMATION;
  hJob: THandle;
  JobBaseInfo: JOBOBJECT_BASIC_ACCOUNTING_INFORMATION;
  nStartTime: Cardinal;
begin
  Result := ERROR_SUCCESS;  ZeroMemory(@si, SizeOf(STARTUPINFO));
  ZeroMemory(@pi, SizeOf(PROCESS_INFORMATION));  si.cb := SizeOf(STARTUPINFO);
  si.dwFlags := STARTF_USESHOWWINDOW;
  si.wShowWindow := SW_SHOWNORMAL;  hJob := 0;  try
    try
      // 创建作业
      hJob := VeeWinApiEx.CreateJobObject(nil, nil);
      if hJob = 0 then Exit;      // 输出作业句柄
      if lphJob <> nil then
      begin
        lphJob^ := hJob;
      end;      // 创建主进程
      if not CreateProcess(
        nil,
        PChar(CommandLine),
        nil,
        nil,
        False,
        CREATE_SUSPENDED, // 在将进程放入作业之前, 先挂起!
        nil,
        nil,
        si,
        pi
      ) then Exit;      // 将进程放入作业中
      if not VeeWinApiEx.AssignProcessToJobObject(hJob, pi.hProcess) then Exit;      // 现在启动进程
      if ResumeThread(pi.hThread) = Cardinal(-1) then Exit;      // 等待
      nStartTime := GetTickCount;
      repeat
        // 检查超时
        if Timeout <> INFINITE then
        begin
          if GetTickCount - nStartTime >= Timeout then
          begin
            Result := ERROR_TIMEOUT;
            Exit;
          end;
        end;        // 查询作业信息
        if not QueryInformationJobObject(
          hJob,
          JobObjectBasicAccountingInformation,
          @JobBaseInfo,
          SizeOf(JOBOBJECT_BASIC_ACCOUNTING_INFORMATION),
          nil
        ) then Exit;        // 休息, 休息一会儿.
        Sleep(100);
      until JobBaseInfo.ActiveProcesses = 0;
    except
      Result := GetLastError;
      Exit;
    end;
  finally
    if pi.hProcess <> 0 then CloseHandle(pi.hProcess);
    if pi.hThread <> 0 then CloseHandle(pi.hThread);
    if (hJob <> 0) and (lphJob = nil) then CloseHandle(hJob);
    Result := GetLastError;
  end;
end;