Delphi中WaitForSingleObject/CreateProcess的程序挂起/问题
Delphi中WaitForSingleObject/CreateProcess的程序挂起/问题
提问于 2022-05-03 17:10:00
我正在执行一个用Go from Delphi编写的可执行文件(从URL列表下载文件)，并在德尔福表单上的TMemo中捕获它的控制台输出。
Go主要功能的最后两行是：
fmt.Println(fmt.Sprintf("Requested %d URLs in %f seconds", uc-1, duration))
os.Exit(0)这一行确实出现在Delphi的备忘录中，所以我假设Go可执行文件干净地退出，代码为0。我需要用我的代码解决两个问题：
- 在Go发布了几千个HTTP之后(它将请求的URL逐个输出到控制台)，它必须“等待一些散乱的用户”。在此期间，我的Delphi应用程序在标题栏和任务管理器中显示了臭名昭著的“未响应”。
。
- ，尽管Go可执行文件似乎干净地退出，但我的Done()过程始终没有到达--似乎德尔福从未离开循环。我做错什么了？
一如既往，任何形式的帮助都是非常感谢的！
procedure Tform_Main.CaptureConsoleOutput(const ACommand, AParameters: String; AMemo: TMemo);
const
CReadBuffer = 65536;
var
saSecurity: TSecurityAttributes;
hRead: THandle;
hWrite: THandle;
suiStartup: TStartupInfo;
piProcess: TProcessInformation;
pBuffer: Array[0..CReadBuffer] of AnsiChar;
dRead: DWord;
dRunning: DWord;
begin
(*
ACommand: ex. {GoGetter.exe}
AParameters: ex. {C:\temp\downloads\ c:\temp\urls.txt 1}
*)
saSecurity.nLength := SizeOf(TSecurityAttributes);
saSecurity.bInheritHandle := True;
saSecurity.lpSecurityDescriptor := nil;
try
if CreatePipe(hRead, hWrite, @saSecurity, 0) then
begin
Screen.Cursor := crHourglass;
Application.ProcessMessages;
FillChar(suiStartup, SizeOf(TStartupInfo), #0);
suiStartup.cb := SizeOf(TStartupInfo);
suiStartup.hStdInput := hRead;
suiStartup.hStdOutput := hWrite;
suiStartup.hStdError := hWrite;
suiStartup.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
suiStartup.wShowWindow := SW_HIDE;
//
if CreateProcess(nil, PChar(ACommand + ' ' + AParameters), @saSecurity, @saSecurity, True, NORMAL_PRIORITY_CLASS,
nil, nil, suiStartup, piProcess) then
begin
repeat
dRunning := WaitForSingleObject(piProcess.hProcess, 100);
Application.ProcessMessages();
repeat
dRead := 0;
ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);
pBuffer[dRead] := #0;
OemToAnsi(pBuffer, pBuffer);
AMemo.Lines.Text := AMemo.Lines.Text + String(pBuffer);
SendMessage(AMemo.Handle, WM_VSCROLL, SB_BOTTOM, 0);
until (dRead < CReadBuffer);
until (dRunning <> WAIT_TIMEOUT);
end;
end;
Done(); // writes a 'finished' message to the memo, resets the screen cursor & re-enables the start button
finally
CloseHandle(piProcess.hProcess);
CloseHandle(piProcess.hThread);
CloseHandle(hRead);
CloseHandle(hWrite);
end;
end;回答 1
Stack Overflow用户
发布于 2022-05-03 17:54:57
不要将hRead句柄分配给子进程的hStdInput。您不会向子进程发送任何数据。不要让子进程继承您的hRead句柄。使用SetHandleInformation()从其中移除HANDLE_FLAG_INHERIT标志。
而且，您需要在子进程继承它之后关闭您的hWrite句柄，否则在子进程终止后管道将保持打开。您没有向子进程写入任何东西，因此不需要打开原始的hWrite句柄。当子进程终止时，其继承的hWrite句柄将被关闭，从而中断管道，允许ReadFile()停止等待进一步的数据。
有关I/O重定向期间使用管道句柄的详细信息，请参阅How to read output from cmd.exe using CreateProcess() and CreatePipe()。
然后，您可以完全删除外部repeat循环。只需在ReadFile()上循环，直到它失败，然后在清理之前调用hProcess句柄上的WaitForSingleObject()。
仅仅是一个FYI，使用AMemo.Lines.Text := AMemo.Lines.Text + String(pBuffer);是向TMemo添加字符串的一种效率很低的方法，特别是在很长一段时间内。
尝试更像这样的东西：
procedure Tform_Main.CaptureConsoleOutput(const ACommand, AParameters: String; AMemo: TMemo);
const
CReadBuffer = 65536;
var
saSecurity: TSecurityAttributes;
hRead: THandle;
hWrite: THandle;
suiStartup: TStartupInfo;
piProcess: TProcessInformation;
pBuffer: array[0..CReadBuffer] of AnsiChar;
dRead: DWord;
begin
(*
ACommand: ex. {GoGetter.exe}
AParameters: ex. {C:\temp\downloads\ c:\temp\urls.txt 1}
*)
saSecurity.nLength := SizeOf(TSecurityAttributes);
saSecurity.bInheritHandle := True;
saSecurity.lpSecurityDescriptor := nil;
if CreatePipe(hRead, hWrite, @saSecurity, 0) then
try
SetHandleInformation(hRead, HANDLE_FLAG_INHERIT, 0);
ZeroMemory(@suiStartup, SizeOf(suiStartup));
suiStartup.cb := SizeOf(TStartupInfo);
suiStartup.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
suiStartup.hStdOutput := hWrite;
suiStartup.hStdError := hWrite;
suiStartup.dwFlags := STARTF_USESTDHANDLES;
Screen.Cursor := crHourglass;
Application.ProcessMessages;
try
if CreateProcess(nil, PChar(ACommand + ' ' + AParameters), @saSecurity, @saSecurity, True, CREATE_NO_WINDOW or NORMAL_PRIORITY_CLASS,
nil, nil, suiStartup, piProcess) then
try
CloseHandle(piProcess.hThread);
CloseHandle(hWrite);
hWrite := INVALID_HANDLE_VALUE;
repeat
Application.ProcessMessages();
if (not ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil)) or (dRead = 0) then
Break;
pBuffer[dRead] := #0;
OemToAnsi(pBuffer, pBuffer);
AMemo.SelStart := AMemo.GetTextLen();
AMemo.SelLength := 0;
AMemo.SelText := String(pBuffer);
SendMessage(AMemo.Handle, WM_VSCROLL, SB_BOTTOM, 0);
until False;
WaitForSingleObject(piProcess.hProcess, INFINITE);
finally
CloseHandle(piProcess.hProcess);
end;
finally
Done();
end;
finally
CloseHandle(hRead);
if hWrite <> INVALID_HANDLE_VALUE then
CloseHandle(hWrite);
end;
end;然后，考虑将此代码移动到单独的工作线程中，这样就不再阻塞主UI线程了。那你就不再需要ProcessMessages()了。否则，如果您真的想在循环中调用ProcessMessages()，请使用命名管道而不是匿名管道，那么您可以使用OVERLAPPED I/O异步读取(参见Overlapped I/O on anonymous pipe)。
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/72103031
复制相关文章
相似问题
腾讯云开发者
