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

s8vozzvw  于 2023-04-29  发布在  其他
关注(0)|答案(1)|浏览(129)

我有一个产生多个CreateProcess线程的应用程序,我成功地将每个线程的stdout和stderr输出重定向到文本文件。
然而,我发现了一个特性,即stdout/strderr句柄可以被所有这样的线程继承,而不仅仅是我希望它们被继承的线程。所以我开始使用InitializeProcThreadAttributeListUpdateProcThreadAttribute函数和EXTENDED_STARTUPINFO_PRESENT以及CreateProcess函数中的STARTUPINFOEX结构来解决这个问题,但我被卡住了。
如果我使用PROC_THREAD_ATTRIBUTE_HANDLE_LIST作为UpdateProcThreadAttribute过程中的Attribute参数,它期望 * lpValue参数是指向子进程要继承的句柄列表的指针 *。
对于列表,我尝试使用

TList<Cardinal>

还创建了一个Cardinals数组,但无法得到任何一种方法来编译!
问:如何创建和填充这样的列表?
其次,in this example使用内核32中的函数和程序。dll,但它们也存在于Windows单元中(我使用的是 Delphi 10。3)虽然定义不同:
例如,InitializeProcThreadAttributeList( nil, 1, 0, vAListSize );由于nil参数而无法使用Windows单元进行编译,因为 * 实际和形式var参数的类型必须相同 *,但我使用kernel 32中的var参数就没有这样的问题
问:我应该使用这些函数/过程的哪个版本?
谢谢。

xe55xuns

xe55xuns1#

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

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;

从你的帖子中似乎有一些InitializeProcThreadAttributeListUpdateProcThreadAttributeDeleteProcThreadAttributeList的声明在最新版本的 Delphi 中的Windows单元中,但你的帖子暗示它们被错误地声明了。上面的代码可以正常工作。

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

我还查看了RTL(版本11)中最新 Delphi Windows单元中InitializeProcThreadAttributeListUpdateProcThreadAttribute的声明。3、我写的,都是假的。

相关问题