获取DOS命令的返回值.

procedure CheckResult(b: Boolean);
begin
  if not b then
    raise Exception.Create(SysErrorMessage(GetLastError));
end;

function RunDOS(const Prog, CommandLine, Dir: string; var ExitCode: DWORD): string;
var
  HRead, HWrite: THandle;
  StartInfo: TStartupInfo;
  ProceInfo: TProcessInformation;
  b: Boolean;
  sa: TSecurityAttributes;
  inS: THandleStream;
  sRet: TStrings;
begin
  Result := '';
  FillChar(sa, sizeof(sa), 0);
      //设置允许继承,否则在NT和2000下无法取得输出结果
  sa.nLength := sizeof(sa);
  sa.bInheritHandle := True;
  sa.lpSecurityDescriptor := nil;
  b := CreatePipe(HRead, HWrite, @sa, 0);
  CheckResult(b);

  FillChar(StartInfo, SizeOf(StartInfo), 0);
  StartInfo.cb := SizeOf(StartInfo);
  StartInfo.wShowWindow := SW_HIDE;
      //使用指定的句柄作为标准输入输出的文件句柄,使用指定的显示方式
  StartInfo.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
  StartInfo.hStdError := HWrite;
  StartInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE); //HRead;
  StartInfo.hStdOutput := HWrite;

  b := CreateProcess(PChar(Prog), //lpApplicationName:   PChar
    PChar(CommandLine), //lpCommandLine:   PChar
    nil, //lpProcessAttributes:   PSecurityAttributes
    nil, //lpThreadAttributes:   PSecurityAttributes
    True, //bInheritHandles:   BOOL
    CREATE_NEW_CONSOLE,
    nil,
    PChar(Dir),
    StartInfo,
    ProceInfo);

  CheckResult(b);
  WaitForSingleObject(ProceInfo.hProcess, INFINITE);
  GetExitCodeProcess(ProceInfo.hProcess, ExitCode);

  inS := THandleStream.Create(HRead);
  if inS.Size > 0 then
  begin
    sRet := TStringList.Create;
    sRet.LoadFromStream(inS);
    Result := sRet.Text;
    sRet.Free;
  end;
  inS.Free;

  CloseHandle(HRead);
  CloseHandle(HWrite);
end;

function GetDosOutput(const CommandLine: string): string;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of Char;
  BytesRead: Cardinal;
  WorkDir, Line: string;
begin
  Application.ProcessMessages;
  with SA do
  begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
          //   create   pipe   for   standard   output   redirection
  CreatePipe(StdOutPipeRead, //   read   handle
    StdOutPipeWrite, //   write   handle
    @SA, //   security   attributes
//   number   of   bytes   reserved   for   pipe   -   0   default
    );
  try
              //   Make   child   process   use   StdOutPipeWrite   as   standard   out,
              //   and   make   sure   it   does   not   show   on   screen.
    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(STD_INPUT_HANDLE); //   don't   redirect   stdinput
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;

              //   launch   the   command   line   compiler
    WorkDir := ExtractFilePath(CommandLine);
    WasOK := CreateProcess(nil, PChar(CommandLine), nil, nil, True, 0, nil,
      PChar(WorkDir), SI, PI);

              //   Now   that   the   handle   has   been   inherited,   close   write   to   be   safe.
              //   We   don't   want   to   read   or   write   to   it   accidentally.
    CloseHandle(StdOutPipeWrite);
              //   if   process   could   be   created   then   handle   its   output
    if not WasOK then
      raise Exception.Create('Could   not   execute   command   line!')
    else
    try
                      //   get   all   output   until   dos   app   finishes
      Line := '';
      repeat
                          //   read   block   of   characters   (might   contain   carriage   returns   and   line   feeds)
        WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);

                          //   has   anything   been   read?
        if BytesRead > 0 then
        begin
                              //   finish   buffer   to   PChar
          Buffer[BytesRead] := #0;
                              //   combine   the   buffer   with   the   rest   of   the   last   run
          Line := Line + Buffer;
        end;
      until not WasOK or (BytesRead = 0);
                      //   wait   for   console   app   to   finish   (should   be   already   at   this   point)
      WaitForSingleObject(PI.hProcess, INFINITE);
    finally
                      //   Close   all   remaining   handles
      CloseHandle(PI.hThread);
      CloseHandle(PI.hProcess);
    end;
  finally
    result := Line;
    CloseHandle(StdOutPipeRead);
  end;
end;


procedure TForm1.btn1Click(Sender: TObject);
var
  hReadPipe, hWritePipe: THandle;
  si: STARTUPINFO;
  lsa: SECURITY_ATTRIBUTES;
  pi: PROCESS_INFORMATION;
  cchReadBuffer: DWORD;
  ph: PChar;
  fname: PChar;
begin
  fname := allocmem(255);
  ph := AllocMem(5000);
  lsa.nLength := sizeof(SECURITY_ATTRIBUTES);
  lsa.lpSecurityDescriptor := nil;
  lsa.bInheritHandle := True;

  if CreatePipe(hReadPipe, hWritePipe, @lsa, 0) = false then
  begin
    ShowMessage('Can   not   create   pipe!');
    exit;
  end;
  fillchar(si, sizeof(STARTUPINFO), 0);
  si.cb := sizeof(STARTUPINFO);
  si.dwFlags := (STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW);
  si.wShowWindow := SW_SHOW;
  si.hStdOutput := hWritePipe;
  StrPCopy(fname, EdtFilename.text);
  if CreateProcess(nil, fname, nil, nil, true, 0, nil, nil, si, pi) = False then
  begin
    ShowMessage('can   not   create   process');
    FreeMem(ph);
    FreeMem(fname);
    Exit;
  end;

  while (true) do
  begin
    if not PeekNamedPipe(hReadPipe, ph, 1, @cchReadBuffer, nil, nil) then break;
    if cchReadBuffer <> 0 then
    begin
      if ReadFile(hReadPipe, ph^, 4096, cchReadBuffer, nil) = false then break;
      ph[cchReadbuffer] := chr(0);
      Mmo1.Lines.Add(ph);
    end
    else if (WaitForSingleObject(pi.hProcess, 0) = WAIT_OBJECT_0) then break;
    Sleep(100);
  end;

  ph[cchReadBuffer] := chr(0);
  Mmo1.Lines.Add(ph);
  CloseHandle(hReadPipe);
  CloseHandle(pi.hThread);
  CloseHandle(pi.hProcess);
  CloseHandle(hWritePipe);
  FreeMem(ph);
  FreeMem(fname);
end;

 

posted @ 2013-10-29 21:10  无悔的勇气  阅读(3130)  评论(1编辑  收藏  举报