执行控制台程序并且获得它的输出结果

执行控制台程序并且获得它的输出结果             
  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 
   
  0  //  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; 
-------------------------------------------------------------------------------------
unit  Unit1; 
   
  interface 
   
  uses 
   
  Windows,  Messages,  SysUtils,  Classes,  Graphics,  Controls,  Forms,  Dialogs, 
   
  StdCtrls; 
   
  type 
   
  TForm1  =  class(TForm) 
   
  Memo1:  TMemo; 
   
  OpenDialog1:  TOpenDialog; 
   
  btnRUn:  TButton; 
   
  btnOpenFIle:  TButton; 
   
  btnEditFile:  TButton; 
   
  editfilename:  TEdit; 
   
  procedure  btnOpenfileClick(Sender:  TObject); 
   
  procedure  btnRunClick(Sender:  TObject); 
   
  private 
   
  {  Private  declarations  } 
   
  public 
   
  {  Public  declarations  } 
   
  end; 
   
  var 
   
  Form1:  TForm1; 
   
  implementation 
   
  {$R  *.DFM} 
   
  procedure  TForm1.btnOpenfileClick(Sender:  TObject); 
   
  begin 
   
  if  opendialog1.Execute  then  editfilename.Text  :=  opendialog1.FileName; 
   
  end; 
   
  procedure  TForm1.btnRunClick(Sender:  TObject); 
   
  var 
   
  hReadPipe,  hWritePipe:  THandle; 
   
  si:  STARTUPINFO; 
   
  lsa:  SECURITY_ATTRIBUTES; 
   
  pi:  PROCESS_INFORMATION; 
   
  mDosScreen:  string; 
   
  cchReadBuffer:  DWORD; 
   
  ph:  PChar; 
   
  fname:  PChar; 
   
  i,  j:  integer; 
   
  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,  EditFilename.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); 
   
  Memo1.Lines.Add(ph); 
   
  end 
   
  else  if  (WaitForSingleObject(pi.hProcess,  0)  =  WAIT_OBJECT_0)  then  break; 
   
  Sleep(100); 
   
  end; 
   
  ph[cchReadBuffer]  :=  chr(0); 
   
  Memo1.Lines.Add(ph); 
   
  CloseHandle(hReadPipe); 
   
  CloseHandle(pi.hThread); 
   
  CloseHandle(pi.hProcess); 
   
  CloseHandle(hWritePipe); 
   
  FreeMem(ph); 
   
  FreeMem(fname); 
   
  end; 
   
  end. 
     
     
  ---------------------------------------------------------------
shellexecute('dir  *  >>a.txt');