100分求解：如何实现cmd命令控制台？ （注意审题）

[sinkiang]

老大们，偶问个题，关于Delphi实现cmd效果的。
假设新建Form1,放置 Edit1,Memo1,Button1
我想实现在Edit1里输入任意DOS命令譬如ping 127.0.0.1，然后按Button1时，执行操作，并将结果显示在Memo1.text里。
winexec('cmd /c "ping 127.0.0.1 > ttt.txt"', SW_HIDE);
ShellExecute(0,'open','cmd',pchar('/c'+ edit1.text+'>>cmd.txt'),0,0);
我不想输出到文本txt中，我想直接输出到Memo1.text里~~
您们在百忙中帮帮偶吧~~

[budi]

对照、学习，标记

[sinkiang]

是将结果显示在控件 Memo1 里！

[TechnoFantasy]

捕捉DOS窗口的输出流:

捕捉DOS窗口的输出流

--------------------------------------------------------------------------------

http://www.pcdog.com 2005-5-26 互联网



一直没有搞定此问题,后大富翁YB_unique大侠给我做了解答.呵呵,多谢YB_unique大侠
------------------------------------
例子:运行 'chkdsk.exe c:\' 并且 显示其输出结果到 Memo 中！
procedure RunDosInMemo(DosApp:String;Amemo:Tmemo);
const ReadBuffer = 2400;
var
Security : TSecurityAttributes;
ReadPipe,WritePipe : Thandle;
start : TStartUpInfo;
ProcessInfo : TProcessInformation;
Buffer : Pchar;
BytesRead : Dword;
Apprunning : Dword;
begin
With Security do
begin
nlength := SizeOf(TSecurityAttributes);
binherithandle := true;
lpsecuritydescriptor := nil;
end;
if Createpipe (ReadPipe, WritePipe, @Security, 0) then
begin
Buffer := AllocMem(ReadBuffer + 1);
FillChar(Start,Sizeof(Start),#0);
start.cb := SizeOf(start);
start.hStdOutput := WritePipe;
start.hStdInput := ReadPipe;
start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
start.wShowWindow := SW_HIDE;
if CreateProcess(nil,Pchar(DosApp),@Security,@Security,true,NORMAL_PRIORITY_CLASS,
nil,nil,start,ProcessInfo) then
begin
repeat
Apprunning := WaitForSingleObject(ProcessInfo.hProcess,100);
Application.ProcessMessages;
until (Apprunning <> WAIT_TIMEOUT);
Repeat
BytesRead := 0;
ReadFile(ReadPipe,Buffer[0],ReadBuffer,BytesRead,nil);
Buffer[BytesRead]:= #0;
OemToAnsi(Buffer,Buffer);
Amemo.Text := Amemo.text + String(Buffer);
until (BytesRead < ReadBuffer);
end;
FreeMem(Buffer);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(ReadPipe);
CloseHandle(WritePipe);
end;
end;

调用实例：RunDosInMemo('chkdsk.exe c:\',Memo1);

[jinjazz]

如果是ping可以用indy的icmp实现
你的要求可以参考
Q:控制台程序如何用delphi接受输出信息

A:
回复人： aiirii(ari-爱的眼睛) ( ) 信誉：372 2004-10-15 10:47:49 得分: 190
這個可以實現你要的, 看下:
http://community.csdn.net/Expert/FAQ/FAQ_Index.asp?id=199752

管道的例子：
unit Unit1;

interface

uses
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.

[TechnoFantasy]

另外一个代码：

如何调用DOS程序，并取得该程序的运行结果输出



编号：QA004722
建立日期: 2003年10月13日 最后修改日期：2003年10月13日
所属类别：

Delphi - Windows API

Ｑ Allen:
操作系统: Windows
编程工具: Delphi7
问题: 请问如何在程序中调用另一个DOS程序，并取得该程序的运行结果输出。我知道可以用WINEXEC（），SHELLEXECUTE等运行一个程序，但如何得到结果，例如，运行CMD.EXE /C DIR，如何得到该程序返回的字符？
水平: 中级

Ａ回答:

可以使用CreatePipe建立管道，然后把DOS程序的输出转向到你建立的管道，这样就可以获得输出结果。下面的例子调用C:\WINDOWS\TRACERT.EXE，并将输出保存在c:\trace.txt中。
unit RoutingThrd;

{Martin Harvey 8/5/98}

interface

uses
Classes,Windows,SysUtils;

const
OutputFile='c:\trace.txt';
ErrorFile='c:\trace.err';

type
TRoutingThread = class(TThread)
private
{ Private declarations }
ToChildReadHandle,ToChildWriteHandle,
FromChildReadHandle,FromChildWriteHandle:THandle;
SavedStdIn,SavedStdOut:THandle;
SecurityAttributes:TSecurityAttributes;
ApplicationName:PChar;
CommandLine:PChar;
StartupInfo:TStartupInfo;
ProcessInformation:TProcessInformation;
ReadBuffer:array[0..15] of Byte;
MonitorChild:boolean;
ErrorCode:longint;
ReadOK:boolean;
PInputHost:Pchar;
protected
procedure Execute; override;
destructor Destroy;override;
public
TraceOutput:TMemoryStream;
InputHost:string;
constructor Create(CreateSuspended:Boolean);
end;

implementation

uses MainForm;

destructor TRoutingThread.Destroy;
begin
TraceOutput.Free;
inherited Destroy;
end;

constructor TRoutingThread.Create(CreateSuspended:boolean);
begin
inherited Create(CreateSuspended);
TraceOutput:=TMemoryStream.Create;
end;

procedure TRoutingThread.Execute;

var
BytesRead:integer;

begin
{We need to:
1. Set up the security attributes structure
2. Create both pipes.
3. Save our standard handles
4. Redirect our standard read handle to "ToChildReadHandle"
5. Redirect our standard write handle to "FromChildWriteHandle"
6. Redirect our standard error handle to
"FromChildErrWriteHandle"
7. Create the child process, ensuring that the handles are
inherited
8. Restore our standard handles
9. Wait for the child to quit.
10. Read from the output and error pipes.
11. Close pipe handles.
}
MonitorChild:=false;
CommandLine:=StrAlloc(256);
PInputHost:=StrAlloc(256);
ApplicationName:=nil;
StrPCopy(CommandLine,'C:\WINDOWS\TRACERT.EXE');
StrPCopy(PInputHost,InputHost);
StrCat(CommandLine,PInputHost);
with SecurityAttributes do
begin
nlength:=SizeOf(TSecurityAttributes);
lpSecurityDescriptor:=nil;
bInheritHandle:=true;
end;
{1}
if
CreatePipe(ToChildReadHandle,ToChildWriteHandle,@SecurityAttributes,4096)
then
begin
if
CreatePipe(FromChildReadHandle,FromChildWriteHandle,@SecurityAttributes,4096)
then
begin
{Cool. The pipes are set up ... do stuff}
{Now save our standard handles}
SavedStdIn:=GetStdHandle(STD_INPUT_HANDLE);
SavedStdOut:=GetStdHandle(STD_OUTPUT_HANDLE);
{Now redirect our standard handles}
SetStdHandle(STD_INPUT_HANDLE,ToChildReadHandle);
SetStdHandle(STD_OUTPUT_HANDLE,FromChildWriteHandle);
{Now create the child process}
with StartupInfo do
begin
cb:=SizeOf(StartupInfo);
lpReserved:=nil;
lpDesktop:=nil;
lpTitle:=nil;
dwX:=0;
dwY:=0;
dwXCountChars:=0;
dwYCountChars:=0;
dwFillAttribute:=0;
dwFlags:=STARTF_USESHOWWINDOW;
cbReserved2:=0;
lpReserved2:=nil;
wShowWindow:=SW_MINIMIZE;
end;
if
CreateProcess(ApplicationName,CommandLine,nil,nil,true,0,nil,nil,StartupInfo,ProcessInformation)
then
MonitorChild:=true
else
ErrorCode:=GetLastError;
{Okay. Now reset our standard handles}
SetStdHandle(STD_INPUT_HANDLE,SavedStdIn);
SetStdHandle(STD_OUTPUT_HANDLE,SavedStdOut);
{Now we can do what we want whilst the child process does it's
stuff}
if MonitorChild then
begin
WaitForSingleObject(ProcessInformation.hProcess,INFINITE);
{Close input handles}
CloseHandle(ToChildWriteHandle);
CloseHandle(ToChildReadHandle);
{At which point we now check that we have read all the data
we can}
{Close the write handle before trying to read.}
CloseHandle(FromChildWriteHandle);
repeat

ReadOK:=ReadFile(FromChildReadHandle,ReadBuffer,16,BytesRead,nil);
ErrorCode:=GetLastError;
if BytesRead>0 then
TraceOutput.WriteBuffer(ReadBuffer,BytesRead);
until (BytesRead=0) or (not(ReadOK)) or
(ErrorCode<>NO_ERROR);
CloseHandle(FromChildReadHandle);
{And similarly, read all the possible error messages}
end
else
begin
CloseHandle(FromChildReadHandle);
CloseHandle(FromChildWriteHandle);
CloseHandle(ToChildReadHandle);
CloseHandle(ToChildWriteHandle);
end;
PostMessage(MainFrm.Handle,WM_FINISHED_ROUTING,0,0);
end;
end;
StrDispose(CommandLine);
StrDispose(PInputHost);
end;

[sinkiang]

感谢 TechnoFantasy(冰儿马甲www.applevb.com) 和 jinjazz(近身剪（充电中...）)热心答题。
TechnoFantasy(冰儿马甲www.applevb.com)第一个回答对我有些启发~~
接受答案了。。。

[lwglucky]

用管道。
或者简单点，使用dos 重定向到一个文件，你再从这个文件去读

[syfly739]

呵呵，错过了