改进的“捕获dos命令的标准输出”

针对C:\Documents and Settings\Owner\My Documents\My Pictures\201.html

重点是改进代码的可读性。

function CaptureStdout(FileName: string):String;
  function Helper_CreatePipe(var hReadPipe:THandle; var hWritePipe :THandle):Boolean;
  var   lsa: SECURITY_ATTRIBUTES;
  begin
    lsa.nLength := sizeof(SECURITY_ATTRIBUTES);
    lsa.lpSecurityDescriptor := nil;
    lsa.bInheritHandle := True;
    Result :=  CreatePipe(hReadPipe, hWritePipe, @lsa, 0) ;
  end;
  function Helper_CreateProcess(filename:string; hWritePipe:THandle ;var pi: PROCESS_INFORMATION):Boolean;
  var
    si: STARTUPINFO;
    fname: PChar;
  begin
      fname := allocmem(1024);
      fillchar(si, sizeof(STARTUPINFO), 0);
      si.cb := sizeof(STARTUPINFO);
      si.dwFlags := (STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW);
      si.wShowWindow := SW_HIDE;
      si.hStdOutput := hWritePipe;
      si.hStdError := hWritePipe;
      StrPCopy(fname, FileName);
      Result :=  CreateProcess(nil, fname, nil, nil, true, 0, nil, nil, si, pi);
  end;
  procedure Helper_ReadToStrings(hReadPipe:THandle; var line : String;pi:PROCESS_INFORMATION);
  var   cchReadBuffer: DWORD;
  ph: PChar;
  begin
    ph := AllocMem(1024);
    while (true) do
    begin
      if not PeekNamedPipe(hReadPipe, ph, 1, @cchReadBuffer, nil, nil) then break;
      if cchReadBuffer <> 0 then
      begin
        if ReadFile(hReadPipe, ph^, 512, cchReadBuffer, nil) = false then break;
        ph[cchReadbuffer] := chr(0);
        line := line + ph ;
      end
      else if (WaitForSingleObject(pi.hProcess, 0) = WAIT_OBJECT_0) then break;
      Application.ProcessMessages;
      Sleep(200);
    end;
    ph[cchReadBuffer] := chr(0);
    line := line + ph ;
    FreeMem(ph);
  end;
var
  line: String;
  hReadPipe, hWritePipe: THandle;
  pi: PROCESS_INFORMATION;
begin
  try
    if not Helper_CreatePipe(hReadPipe, hWritePipe)  then
      Exit;
    if not Helper_CreateProcess(Filename,hWritePipe, pi) then
      Exit;
    Helper_ReadToStrings(hReadPipe, line ,pi);
    Result := line ;
  finally
    CloseHandle(hWritePipe);
    CloseHandle(hReadPipe);
    CloseHandle(pi.hThread);
    CloseHandle(pi.hProcess); 
  end;
end;
procedure TestCaptureStdout ;
const
  filename = 'c:\test.bat';
begin
  with TStringList.Create do
  try
    Add('@echo off');
    Add('Echo abc');
    Add('Echo def');
    savetofile(filename);
    if 'abc'#13#10'def'#13#10 = CaptureStdout(filename) then
      ShowMessage('OK')
    else
      ShowMessage('Not OK');
  finally
    Free;
    DeleteFile(filename) ;
  end;  
end;