捕获DOS窗口输出信息 ( 积分: 100 )

本人在网上找到这个么一个方法,在这先谢谢该方法的作者：
procedure RunDosInMemo(DosApp:String;var 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_show;
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;

我是这样调用的：
1.RunDosInMemo('ping www.sohu.com',Memo1);
这样调用可以在Memo1中输出信息；

2.RunDosInMemo('telnet',Memo1);
这样就不行了（换其他的命令行也不行，我试了很多），程序可以运行但是Memo1中
看不到输出信息，而我试的几个命令它确实是执行了。每次都运行到ReadFile处就不动了。


请各位大富翁帮忙看看，怎么可以解决，谢谢先了！！！

本人在网上找到这个么一个方法,在这先谢谢该方法的作者：
procedure RunDosInMemo(DosApp:String;var 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_show;
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;

我是这样调用的：
1.RunDosInMemo('ping www.sohu.com',Memo1);
这样调用可以在Memo1中输出信息；

2.RunDosInMemo('telnet',Memo1);
这样就不行了（换其他的命令行也不行，我试了很多），程序可以运行但是Memo1中
看不到输出信息，而我试的几个命令它确实是执行了。每次都运行到ReadFile处就不动了。


请各位大富翁帮忙看看，怎么可以解决，谢谢先了！！！

telnet在等待你输入地址和端口哈！可能是你用法不对。

你要是处理交互功能的话那就复杂了[]

我不需要交互处理
我只是运行一个DOS外部命令，然后能获得这个命令执行结果的输出信息

可你的telnet是个交互dos程序啊！你必须给IP,给端口，然后发送消息，等待回答。调用quit才能退出。这就是个交互dos程序啊。

那个telnet我只是举个例子而已，
并不是真的这么用。
可以像PING一样啊

你用不需要交互的其他命令试试，例如Dir

dir不行，dir是cmd的内部命令，你createprocess是不会成功的。

本人不才，找到了2个办法不知道能不能解决你的问题
1.笨人有苯办法
用winexec运行CMD.exe在后面的参数里填上“你要运行的命令+ > c:/temp.txt”
然后读取c:/temp.txt的内容再把它删掉好了
2.高级一点的
function GetCMD(Command: string): string;
var
hReadPipe : THandle;
hWritePipe : THandle;
SI : TStartUpInfo;
PI : TProcessInformation;
SA : TSecurityAttributes;
BytesRead : DWORD;
Dest : array[0..32767] of char;
CmdLine : array[0..512] of char;
Avail, ExitCode, wrResult : DWORD;
osVer : TOSVERSIONINFO;
tmpstr :AnsiString;
Line: String;
begin
osVer.dwOSVersionInfoSize := Sizeof(TOSVERSIONINFO);
GetVersionEX(osVer);
if osVer.dwPlatformId = VER_PLATFORM_WIN32_NT then
begin
SA.nLength := SizeOf(SA);
SA.lpSecurityDescriptor := nil;
SA.bInheritHandle := True;
CreatePipe(hReadPipe, hWritePipe, @SA, 0);
end
else
CreatePipe(hReadPipe, hWritePipe, nil, 1024);
try
FillChar(SI, SizeOf(SI), 0);
SI.cb := SizeOf(TStartUpInfo);
SI.wShowWindow := SW_HIDE;
SI.dwFlags := STARTF_USESHOWWINDOW;
SI.dwFlags := SI.dwFlags or STARTF_USESTDHANDLES;
SI.hStdOutput := hWritePipe;
SI.hStdError := hWritePipe;
StrPCopy(CmdLine, Command);
if CreateProcess(nil, CmdLine, nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil, SI, PI) then
begin
ExitCode := 0;
while ExitCode = 0 do
begin
wrResult := WaitForSingleObject(PI.hProcess, 1000);
if PeekNamedPipe(hReadPipe, @Dest[0], 32768, @Avail, nil, nil) then
begin
if Avail > 0 then
begin
try
FillChar(Dest, SizeOf(Dest), 0);
ReadFile(hReadPipe, Dest[0], Avail, BytesRead, nil);
TmpStr := Copy(Dest,0 , BytesRead-1);
Line:=Line+TmpStr;
Except
end;
end;
end;
if wrResult <> WAIT_TIMEOUT then ExitCode := 1;
end;
GetExitCodeProcess(PI.hProcess, ExitCode);
CloseHandle(PI.hProcess);
CloseHandle(PI.hThread);
end;
finally
if line='' then line:='这个命令没有输出哎~~';
result:=Line;
CloseHandle(hReadPipe);
CloseHandle(hWritePipe);
end;
end;

上面那个GETCMD中的参数是命令返回就是一个string包含输出

参考一下：
http://www.delphibbs.com/delphibbs/dispq.asp?lid=2910313

谢谢楼上两位
我看看先

to 绝对新手

非常感谢！！！
问题已解决，你的方法很管用，谢谢你的帮助