Question

我正在使用下面的代码运行一些“netsh wlan”命令来检查wifi状态，连接到wifi配置文件等。

我遇到的问题是，应用程序会不时地挂起任何命令，这只是一个随机的事情，而且，有时返回的输出会被“无”覆盖，当我调试它时似乎就像一个计时问题。

我尝试了使用Pascal运行命令的传统方法，但它不适用于netsh，方法是“cmd.exe / C netsh wlan ....”。

我很欣赏任何关于让这个冻结程序更好地工作或其他方法的建议。

我正在运行DelphiXE5。

由于

示例命令：netsh wlan show profiles，netsh wlan show interfaces等。

procedure GetDosOutput(const ACommand, AParameters: String; CallBack: TArg<PAnsiChar>);
const
CReadBuffer = 2400;
var
saSecurity: TSecurityAttributes;
hRead: THandle;
hWrite: THandle;
suiStartup: TStartupInfo;
piProcess: TProcessInformation;
pBuffer: array [0 .. CReadBuffer] of AnsiChar;
dBuffer: array [0 .. CReadBuffer] of AnsiChar;
dRead: DWord;
dRunning: DWord;
begin
saSecurity.nLength := SizeOf(TSecurityAttributes);
saSecurity.bInheritHandle := True;
saSecurity.lpSecurityDescriptor := nil;

if CreatePipe(hRead, hWrite, @saSecurity, 0) then
begin
    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);
                //Unicode support by Lars Fosdal
                OemToCharA(pBuffer, dBuffer);
                CallBack(dBuffer);
            until (dRead < CReadBuffer);
        until (dRunning <> WAIT_TIMEOUT);
        CloseHandle(piProcess.hProcess);
        CloseHandle(piProcess.hThread);
    end;
    CloseHandle(hRead);
    CloseHandle(hWrite);
end;
end;

在完成所有建议之后，我更改了这部分代码，到目前为止应用程序还没有挂起。非常感谢！

procedure GetDosOutput(const ACommand, AParameters: String; CallBack: TArg<PAnsiChar>);
const
CReadBuffer = 2400;
var
saSecurity: TSecurityAttributes;
hRead: THandle;
hWrite: THandle;
suiStartup: TStartupInfo;
piProcess: TProcessInformation;
pBuffer: array [0 .. CReadBuffer] of AnsiChar;
dBuffer: array [0 .. CReadBuffer] of AnsiChar;
dRead: DWord;
dRunning: DWord;
begin
saSecurity.nLength := SizeOf(TSecurityAttributes);
saSecurity.bInheritHandle := True;
saSecurity.lpSecurityDescriptor := nil;

if CreatePipe(hRead, hWrite, @saSecurity, 0) then
begin
    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
        Application.ProcessMessages();
        repeat
            dRunning := WaitForSingleObject(piProcess.hProcess, 100);

            repeat
                dRead := 0;

                try
                  ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);
                except on E: Exception do
                  Exit;
                end;

                pBuffer[dRead] := #0;

                //OemToAnsi(pBuffer, pBuffer);
                //Unicode support by Lars Fosdal
                OemToCharA(pBuffer, dBuffer);
                CallBack(dBuffer);
            until (dRead < CReadBuffer);

        until (dRunning <> WAIT_TIMEOUT);
        CloseHandle(piProcess.hProcess);
        CloseHandle(piProcess.hThread);
    end;
    CloseHandle(hRead);
    CloseHandle(hWrite);
end;
end;

我创建了这个包装器来简化流程：

function GetDosOutputSimple(const ACommand, AParameters: String) : String;
var
  Tmp, S : String;
begin
  GetDosOutput(ACommand, AParameters, procedure (const Line: PAnsiChar)
  begin
    Tmp := Line;
    S := S + Tmp;
  end);

  GetDosOutputSimple := S;
end;

Answer 1

如果您在调用ReadFile时出于任何原因，该进程尚未完成写入操作，或者您的缓冲区未填充，ReadFile将阻止。通常它应该失败，但它不能，因为你持有写端的句柄。见documentation：

...父进程关闭其句柄非常重要在调用 ReadFile 之前写下管道的末尾。如果没有这样做，由于父进程， ReadFile 操作不能返回零具有打开管道写入端的句柄。

在从管道读取之前接近'hWrite'。

请注意，在这种情况下 - 如果进程尚未向管道写入任何内容，而不是阻止，则ReadFile将正确失败 - GetLastError将报告ERROR_BROKEN_PIPE }。在这种情况下，你可能也会优雅地失败。因此，最好检查ReadFile的返回值。

或者，等到该过程终止。然后你不会冒ReadFile阻止等待写作的风险，因为孩子一侧的句柄将被关闭。

    ...
repeat
    dRunning := WaitForSingleObject(piProcess.hProcess, 100);
    Application.ProcessMessages();
until (dRunning <> WAIT_TIMEOUT);
repeat
    dRead := 0;
    ...

如果您有可能有一些相当大的输出，请在应用程序运行时从管道中读取：

  saSecurity.nLength := SizeOf(TSecurityAttributes);
  saSecurity.bInheritHandle := True;
  saSecurity.lpSecurityDescriptor := nil;

  if CreatePipe(hRead, hWrite, @saSecurity, 0) then begin
    try
      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
        CloseHandle(hWrite);
        try
          repeat
            dRunning := WaitForSingleObject(piProcess.hProcess, 100);
            Application.ProcessMessages();

            repeat
              dRead := 0;
              if ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil) then begin
                pBuffer[dRead] := #0;
                OemToCharA(pBuffer, dBuffer);
                CallBack(dBuffer);
              end;
            until (dRead < CReadBuffer);

          until (dRunning <> WAIT_TIMEOUT);
        finally
          CloseHandle(piProcess.hProcess);
          CloseHandle(piProcess.hThread);
        end;

      end;
    finally
      CloseHandle(hRead);
      if GetHandleInformation(hWrite, flags) then
        CloseHandle(hWrite);
    end;
  end;

使用netsh的CreateProcess挂起/冻结应用程序[Delphi]

1 个答案: