如何让程序运行DOS命令

来自：
comerliang(天地良心)
如何隐藏执行一个控制台程序（命令行）并得到它的屏幕输出内容，以便显示在一个Memo中？
主要解答者: aiirii 提交人: aiirii
感谢: aiirii
审核者: ihihonline 社区对应贴子: 查看
     A :  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_HIDE;
           si.hStdOutput  :=hWritePipe;
           StrPCopy(fname,EditFilename.text);
                                       //edit  中输入你的命令,  如CMD.EXE  /c  dir/w

           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);    //memo接收返回
           CloseHandle(hReadPipe);
           CloseHandle(pi.hThread);
           CloseHandle(pi.hProcess);
           CloseHandle(hWritePipe);
           FreeMem(ph);
           FreeMem(fname);
end;
来自
kiboisme(还是铁棒.....针)
winexec('CMD.exe /c DIR c:\ > c:\dd.txt',SW_Hide);
这样就自动结束，并且不显示
如果要取结果，用comerliang(天地良心) 的办法。

或者参照
http://community.csdn.net/Expert/topic/3288/3288368.xml?temp=.8459894

http://borland.mblogger.cn/lw549/posts/5220.aspx

用匿名管道！！下面的例子已调试通过！！d6+win2K
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;type
  TPipeForm = class(TForm)
    Editor: TMemo;
    procedure EditorKeyPress(Sender: TObject; var Key: Char);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure EditorKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure EditorMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    CreateOk: Boolean;
WPos: TPoint;
    hReadPipe, hWritePipe, hWriteFile, hReadFile: THandle;
    processinfo: PROCESS_INFORMATION;
    procedure SendCmdToShell(Const CmdStr: String);
    function GetCmdStr: string;
  public
    { Public declarations }
  end;var
  PipeForm: TPipeForm;implementation{$R *.dfm}procedure TPipeForm.EditorKeyPress(Sender: TObject; var Key: Char);
var
  ECharPos: TPoint;
begin
if Key = Chr(VK_RETURN) then
  begin
//    ShowMessage(GetCmdStr);
SendCmdToShell(GetCmdStr);
  end else if Key = Chr(VK_BACK) then
  begin
   ECharPos := Editor.CaretPos;
   if ECharPos.X = WPos.X + 1 then
     Key := #0;
  end;
end;procedure TPipeForm.SendCmdToShell(Const CmdStr: String);
var
ShellCmdStr: array[0..256] of char;
  RBuffer: array[0..25000] of char;
  nByteToWrite: DWORD;
  nByteWritten: DWORD;
  nByteReaden: DWORD;
begin
if CreateOK then
  begin
    StrPCopy(ShellCmdStr, CmdStr);
    nByteToWrite := StrLen(ShellCmdStr);
    ShellCmdStr[nByteToWrite] := #13;
    ShellCmdStr[nByteToWrite+1] := #10;
ShellCmdStr[nByteToWrite+2] := #0;
    Inc(nByteToWrite, 2);
    WriteFile(hWriteFile, ShellCmdStr, nByteToWrite, nByteWritten, nil);
    Sleep(400);
    Editor.Lines.Clear;
    FillChar(RBuffer, Sizeof(RBuffer), #0);
    ReadFile(hReadFile, RBuffer, 25000, nByteReaden, nil);
    Editor.Lines.Add(StrPas(RBuffer));
    WPos.Y := Editor.Lines.Count-1;
    WPos.X := Length(Editor.Lines[WPos.Y])-1;
  end;
end;procedure TPipeForm.FormDestroy(Sender: TObject);
var
shellexitcode: Cardinal;
begin
if GetExitCodeProcess(processinfo.hProcess, shellexitcode) then
  begin
   if shellexitcode = STILL_ACTIVE then
TerminateProcess(processinfo.hProcess, 0);
  end;
  if hWriteFile <> 0 then
   CloseHandle(hWriteFile);
  if hReadFile <> 0 then
   CloseHandle(hReadFile);
end;procedure TPipeForm.FormCreate(Sender: TObject);
var
Pipeattr: SECURITY_ATTRIBUTES;
  ShellStartInfo: STARTUPINFO;
  shellstr: array [0..256] of char;
  RBuffer: array[0..25000] of char;
  I: Integer;
  nByteReaden: DWORD;
begin
CreateOK := False;
  I := 0;
  Editor.ReadOnly := False;
  Wpos.X := 0;
  WPos.Y := 0;
  with Pipeattr do
  begin
nLength := Sizeof(SECURITY_ATTRIBUTES);
lpSecurityDescriptor := nil;
bInheritHandle := true;
  end; if CreatePipe(hReadPipe, hWriteFile, @Pipeattr, 0) then
   Inc(i);
if CreatePipe(hReadFile, hWritePipe, @pipeattr, 0) then
   Inc(i);  GetStartupInfo(ShellStartInfo);
  with ShellStartInfo do
  begin
    dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
    hStdInput := hReadPipe;
    hStdError := hWritePipe;
    hStdOutput := hWritePipe;
    wShowWindow := SW_HIDE;
  end;
GetSystemDirectory(@Shellstr, MAX_PATH+1);
  StrCat(@ShellStr, Pchar('\\cmd.exe'));
  if CreateProcess(Shellstr, nil, nil, nil, True, 0,
nil, nil, ShellStartInfo, processinfo) then
begin
    Inc(i);
  end else begin
   MessageBox(Handle, Pchar('调用Shell错误！'), Pchar('错误'), (MB_OK or MB_ICONERROR));
end;
  if i = 3 then
  begin
   CreateOK := True;
    Editor.Lines.Clear;
    sleep(250);
ReadFile(hReadFile, RBuffer, 25000, nByteReaden, nil);
   Editor.Lines.Add(StrPas(RBuffer));
WPos.Y := Editor.Lines.Count-1;
    WPos.X := Length(Editor.Lines[WPos.Y])-1;
  end;
end;procedure TPipeForm.EditorKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  ECharPos: TPoint;
begin
  ECharPos := Editor.CaretPos;
  if ECharPos.Y > WPos.Y then
   Editor.ReadOnly := False
  else if (ECharPos.Y = WPos.Y) and (ECharPos.X > WPos.X) then
  begin
   Editor.ReadOnly := False;
  end else
   Editor.ReadOnly := True;
end;function TPipeForm.GetCmdStr: string;
var
LastLine: Integer;
begin
LastLine := Editor.Lines.Count - 1;
  if LastLine > WPos.Y then
  begin
result := Editor.Lines[LastLine];
  end else if LastLine = WPos.Y then
  begin
   result := Editor.Lines[LastLine];
    result := Copy(result, WPos.X+2, Length(result));
  end else
  begin
   result := ' ';
  end;
end;procedure TPipeForm.EditorMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  ECharPos: TPoint;
begin
  ECharPos := Editor.CaretPos;
  if ECharPos.Y > WPos.Y then
   Editor.ReadOnly := False
  else if (ECharPos.Y = WPos.Y) and (ECharPos.X > WPos.X) then
   Editor.ReadOnly := False
  else
   Editor.ReadOnly := True;
end;end.

调试易

如何让程序运行DOS命令

解决方案 »