CreateProcess using netsh hangs/freezes the application [Delphi]

问题

I'm using the code bellow to run a few "netsh wlan" commands in order to check wifi status, connect to a wifi profile, etc.

The problem that I'm having is that every now and then the app will hang on any of the commands, it's just a random thing, plus, sometimes the output returned get overwritten with "nothing", when I debugged it seemed like a timing issue.

I tried the conventional approach to run a command with Pascal but it didn't work with netsh, the approach is "cmd.exe /C netsh wlan....".

I appreciate any advise on getting this freezing procedure working better or another approach.

I'm running DelphiXE5.

Thanks

Sample commands: netsh wlan show profiles, netsh wlan show interfaces, etc.

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;

After following all the advises I got this portion of code changed and so far the app hasn't hanged anymore. Thanks a lot!

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;

I created this wrapper to simplify the process:

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;

回答1:

If for any reason by the time you call ReadFile, the process have not completed a write operation, or your buffer is not filled, ReadFile will block. Normally it should fail, but it can't since you're holding a handle to the write end. See documentation:

... It is important for the parent process to close its handle to the write end of the pipe before calling ReadFile. If this is not done, the ReadFile operation cannot return zero because the parent process has an open handle to the write end of the pipe.

So close 'hWrite' before reading from the pipe.

Note that, in this case - if the process have not been able to write anything to the pipe yet, instead of blocking, ReadFile will properly fail - and GetLastError will report ERROR_BROKEN_PIPE. Under this condition, you'd probably gracefully fail too. So better check return of ReadFile.

Alternatively, wait until the process terminates. Then you won't risk ReadFile blocking waiting for writing since the handles on child's side will have been closed.

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

If there's a chance that you'll have some sizeable output, read from the pipe when the application is running:

  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;

来源：https://stackoverflow.com/questions/20712386/createprocess-using-netsh-hangs-freezes-the-application-delphi

标签

Delphi

winapi

pascal