delphi - 如何将指向句柄列表的指针传递给 UpdateProcThreadAttribute 函数

Question

我有一个生成多个 CreateProcess 线程的应用程序，并且我成功地将每个线程的 stdout 和 stderr 输出重定向到文本文件。

但是，我发现了一个功能，即 stdout/strderr 句柄由所有此类线程继承，而不仅仅是我希望它们继承的线程。因此，我开始在CreateProcess 函数来解决这个问题，但我被困住了。

如果我使用 PROC_THREAD_ATTRIBUTE_HANDLE_LIST 作为 UpdateProcThreadAttribute 过程中的 Attribute 参数，它期望 lpValue 参数是指向列表的指针子进程继承的句柄数。

对于我尝试使用的列表

TList<Cardinal>

还创建了一个枢机主教数组，但无法获得任何一种编译方法!

问题:如何创建并填充这样的列表？

其次，in this example它使用 kernel32.dll 中的函数和过程，但它们也存在于 Windows 单元中(我使用的是 Delphi 10.3)，尽管定义不同:

例如，InitializeProcThreadAttributeList( nil, 1, 0, vAListSize ); 由于 nil 参数而无法使用 Windows 单元进行编译，因为实际和形式 var 参数的类型必须是相同，但我使用 kernel32 中的没有这样的问题

问题:我应该使用这些函数/过程的哪个版本？

谢谢。

Answer 1

如果它有用，这是我实现所有这些的代码:

function InitializeProcThreadAttributeList(
  lpAttributeList: Pointer;
  dwAttributeCount: DWORD;
  dwFlags: DWORD;
  var lpSize: SIZE_T
): BOOL; stdcall; external kernel32;

function UpdateProcThreadAttribute(
  lpAttributeList: Pointer;
  dwFlags: DWORD;
  Attribute: DWORD_PTR;
  lpValue: Pointer;
  cbSize: SIZE_T;
  lpPreviousValue: PPointer;
  lpReturnSize: PSIZE_T
): BOOL; stdcall; external kernel32;

function DeleteProcThreadAttributeList(
  lpAttributeList: Pointer
): BOOL; stdcall; external kernel32;

// see https://devblogs.microsoft.com/oldnewthing/20111216-00/?p=8873
function CreateProcessWithInheritedHandles(
  lpApplicationName: LPCWSTR;
  lpCommandLine: LPWSTR;
  lpProcessAttributes,
  lpThreadAttributes: PSecurityAttributes;
  const Handles: array of THandle;
  dwCreationFlags: DWORD;
  lpEnvironment: Pointer;
  lpCurrentDirectory: LPCWSTR;
  const lpStartupInfo: TStartupInfo;
  var lpProcessInformation: TProcessInformation
): Boolean;

const
  PROC_THREAD_ATTRIBUTE_HANDLE_LIST = $00020002;

  // this flag is ignored these days, and struct size is used, but we may as well follow the letter of the docs
  EXTENDED_STARTUPINFO_PRESENT = $00080000;

type
  TStartupInfoEx = record
    StartupInfo: TStartupInfo;
    lpAttributeList: Pointer;
  end;

var
  Handle: THandle;
  StartupInfoEx: TStartupInfoEx;
  size: SIZE_T;

begin
  Assert(Length(Handles)>0);

  StartupInfoEx.StartupInfo := lpStartupInfo;
  StartupInfoEx.StartupInfo.cb := SizeOf(StartupInfoEx);
  StartupInfoEx.lpAttributeList := nil;

  Win32Check(not InitializeProcThreadAttributeList(nil, 1, 0, size) and (GetLastError=ERROR_INSUFFICIENT_BUFFER));
  GetMem(StartupInfoEx.lpAttributeList, size);
  try
    Win32Check(InitializeProcThreadAttributeList(StartupInfoEx.lpAttributeList, 1, 0, size));
    try
      Win32Check(UpdateProcThreadAttribute(
        StartupInfoEx.lpAttributeList,
        0,
        PROC_THREAD_ATTRIBUTE_HANDLE_LIST,
        @Handles[0],
        Length(Handles) * SizeOf(Handles[0]),
        nil,
        nil
      ));

      for Handle in Handles do begin
        Win32Check(SetHandleInformation(Handle, HANDLE_FLAG_INHERIT, HANDLE_FLAG_INHERIT));
      end;

      Result := CreateProcess(
        lpApplicationName,
        lpCommandLine,
        lpProcessAttributes,
        lpThreadAttributes,
        True,
        dwCreationFlags or EXTENDED_STARTUPINFO_PRESENT,
        lpEnvironment,
        lpCurrentDirectory,
        StartupInfoEx.StartupInfo,
        lpProcessInformation
      );
    finally
      DeleteProcThreadAttributeList(StartupInfoEx.lpAttributeList);
    end;
  finally
    FreeMem(StartupInfoEx.lpAttributeList);
  end;
end;

从您的帖子来看，Windows 中似乎有一些 InitializeProcThreadAttributeList、UpdateProcThreadAttribute 和 DeleteProcThreadAttributeList 声明> 最新版本的 Delphi 中的单元，但您的帖子暗示它们的声明不正确。已知上述代码可以正常工作。

更新:我已更新代码以包含 @blerontin 建议的 EXTENDED_STARTUPINFO_PRESENT 进程创建标志。我不认为这是必要的，因为启动信息结构的大小是系统用来做出该决定的。然而，文档说应该使用它，并且包含它是无害的。

我还查看了 RTL 中最新的 Delphi Windows 单元中的 InitializeProcThreadAttributeList 和 UpdateProcThreadAttribute 的声明(我的版本是 11.3)写)，它们确实是假的。