1,183
社区成员
发帖
与我相关
我的任务
分享DELPHI中如何用管道实时捕获控制台输出
我让DOS执行实时的一行一行显示出来，从网上找了段代码，无奈还是不能实时显示，请教大家了！帮我看看这段代码哪里出错了，先谢谢！
procedure TForm1.RunDosInMemo(const DosApp:string;Amemo:TMemo);
const
ReadBuffer=2400; //设置ReadBuffer的大小
var
Security:TSecurityAttributes;
ReadPipe,WritePipe:THandle;
start:TStartUpInfo;
ProcessInfo:TProcessInformation;
Buffer:PChar;
BytesRead:DWord;
Buf:string;
begin
with Security do
begin
nlength:=sizeof(TSecurityAttributes);
binherithandle:=true;
lpsecuritydescriptor:=nil;
end;
{创建一个命名管道来捕获Console的输出}
if CreatePipe(ReadPipe,WritePipe,@Security,0) then
begin
Buffer:=AllocMem(ReadBuffer+1);
FillChar(Start,Sizeof(Start),#0);
{设置Console程序的启动属性}
with Start do
begin
cb:=sizeof(start);
start.lpReserved:=nil;
lpDesktop:=nil;
lpTitle:=nil;
dwX:=0;
dwY:=0;
dwXSize:=0;
dwYSize:=0;
dwXCountChars:=0;
dwYCountChars:=0;
dwFillAttribute:=0;
hStdOutput:=WritePipe; //将输出定向到建立的WritePipe上
hStdInput:=ReadPipe; //将输入定向到建立的ReadPipe上
hStdError:=WritePipe; //将错误输出定向到建立的WritePipe上
dwFlags:=STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
wshowwindow:=SW_HIDE; //设置窗口为hide
end;
try
{创建一个子进程，运行Console}
if CreateProcess(nil,PChar(DosApp),@Security,@Security,true,
NORMAL_PRIORITY_CLASS,
nil,nil,start,ProcessInfo)then
begin
Application.ProcessMessages;
{等待进程运行结束}
WaitForSingleObject(ProcessInfo.hProcess,INFINITE);
{关闭程序...开始没有关掉它，如果没有输出的话，程序死掉了。}
closeHandle(WritePipe);
buf:='';
{读取Console的输出}
repeat
bytesRead:=0;
ReadFile(ReadPipe,Buffer[0],ReadBuffer,BytesRead,nil);
Buffer[BytesRead]:=#0;
OemToAnsi(Buffer,Buffer);
Buf:=Buf+String(Buffer);
Application.ProcessMessages;
until(bytesRead<ReadBuffer);
//sendDebug(Buf);
{按照换行符进行切割，并在Memo中显示出来}
while pos(#10,buf)>0 do
begin
AMemo.Lines.Add(Copy(Buf,1,Pos(#10,buf)-1));
Delete(Buf,1,Pos(#10,buf));
Application.ProcessMessages;
end;
end;
finally
FreeMem(Buffer);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(ReadPipe);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
RunDosInMemo('ping 192.168.1.1 -t',Amemo);
end;
...全文
请发表友善的回复…
发表回复
ahjoe 2008-09-26
- 打赏
- 举报
有写好的控件，StdIORedirect
柯本 2008-09-24
- 打赏
- 举报
用线程吧,我以前用BCB写过一个,可最近没时间改成D的,程序不多,思路与上面类似.有人改一下或等我有空改.
主程序:
线程:
按button1初始化,按button2执行edit1中的dos命令,在Memo1中显示
只是还没有编写停止和退出,供参考吧
主程序:
//---------------------------------------------------------------------------
#include <vcl.h>
#pragma hdrstop
#include "proc1.h"
#include "proct.h"
//---------------------------------------------------------------------------
#pragma package(smart_init)
#pragma resource "*.dfm"
#define DisplayError ShowMessage
TForm1 *Form1;
//---------------------------------------------------------------------------
__fastcall TForm1::TForm1(TComponent* Owner)
: TForm(Owner)
{
}
//---------------------------------------------------------------------------
HANDLE hd,hi;
bool run =true;
void __fastcall TForm1::Button1Click(TObject *Sender)
{
SECURITY_ATTRIBUTES sa;
HANDLE hOutputReadTmp,hOutputRead,hOutputWrite;
HANDLE hInputWriteTmp,hInputRead,hInputWrite;
HANDLE hErrorWrite;
sa.nLength= sizeof(SECURITY_ATTRIBUTES);
sa.lpSecurityDescriptor = NULL;
sa.bInheritHandle = TRUE;
// Create the child output pipe.
if (!CreatePipe(&hOutputReadTmp,&hOutputWrite,&sa,0))
DisplayError("CreatePipe");
// Create a duplicate of the output write handle for the std error
// write handle. This is necessary in case the child application
// closes one of its std output handles.
if (!DuplicateHandle(GetCurrentProcess(),hOutputWrite,
GetCurrentProcess(),&hErrorWrite,0,
TRUE,DUPLICATE_SAME_ACCESS))
DisplayError("DuplicateHandle");
// Create the child input pipe.
if (!CreatePipe(&hInputRead,&hInputWriteTmp,&sa,0))
DisplayError("CreatePipe");
// Create new output read handle and the input write handles. Set
// the Properties to FALSE. Otherwise, the child inherits the
// properties and, as a result, non-closeable handles to the pipes
// are created.
if (!DuplicateHandle(GetCurrentProcess(),hOutputReadTmp,
GetCurrentProcess(),
&hOutputRead, // Address of new handle.
0,FALSE, // Make it uninheritable.
DUPLICATE_SAME_ACCESS))
DisplayError("DupliateHandle");
if (!DuplicateHandle(GetCurrentProcess(),hInputWriteTmp,
GetCurrentProcess(),
&hInputWrite, // Address of new handle.
0,FALSE, // Make it uninheritable.
DUPLICATE_SAME_ACCESS))
DisplayError("DupliateHandle");
// Close inheritable copies of the handles you do not want to be
// inherited.
if (!CloseHandle(hOutputReadTmp)) DisplayError("CloseHandle");
if (!CloseHandle(hInputWriteTmp)) DisplayError("CloseHandle");
PROCESS_INFORMATION pi;
STARTUPINFO si;
ZeroMemory(&si,sizeof(STARTUPINFO));
si.cb = sizeof(STARTUPINFO);
si.dwFlags = STARTF_USESTDHANDLES | STARTF_USESHOWWINDOW;
si.hStdOutput = hOutputWrite;
si.hStdInput = hInputRead;
si.hStdError = hErrorWrite;
si.wShowWindow = SW_HIDE;
if (!CreateProcess(NULL,"cmd.exe",NULL,NULL,TRUE,
CREATE_NEW_CONSOLE,NULL,NULL,&si,&pi))
DisplayError("CreateProcess");
if (!CloseHandle(pi.hThread)) DisplayError("CloseHandle");
if (!CloseHandle(hOutputWrite)) DisplayError("CloseHandle");
if (!CloseHandle(hInputRead )) DisplayError("CloseHandle");
if (!CloseHandle(hErrorWrite)) DisplayError("CloseHandle");
hi=hInputWrite;
hd=hOutputRead;
proct *p;
p=new proct(false);
while(run)
Application->ProcessMessages();
TerminateProcess(pi.hProcess,0);
delete p;
if (!CloseHandle(hOutputRead)) DisplayError("CloseHandle");
if (!CloseHandle(hInputWrite)) DisplayError("CloseHandle");
CloseHandle(pi.hProcess);
}
//---------------------------------------------------------------------------
void __fastcall TForm1::Button2Click(TObject *Sender)
{
DWORD nn=0;
String m=Edit1->Text;
m+="\n";
if(!WriteFile(hi,m.c_str(),m.Length(),&nn,NULL))
ShowMessage("Write Error"+String(nn));
}
//---------------------------------------------------------------------------
线程:
//---------------------------------------------------------------------------
#include <vcl.h>
#pragma hdrstop
#include "proct.h"
#include "proc1.h"
#pragma package(smart_init)
//---------------------------------------------------------------------------
// Important: Methods and properties of objects in VCL can only be
// used in a method called using Synchronize, for example:
//
// Synchronize(UpdateCaption);
//
// where UpdateCaption could look like:
//
// void __fastcall proct::UpdateCaption()
// {
// Form1->Caption = "Updated in a thread";
// }
//---------------------------------------------------------------------------
__fastcall proct::proct(bool CreateSuspended)
: TThread(CreateSuspended)
{
}
//---------------------------------------------------------------------------
extern HANDLE hd;
extern bool run;
void __fastcall proct::Execute()
{
//---- Place thread code here ----
CHAR lpBuffer[1];
DWORD nBytesRead;
char c;
String x="";
while(TRUE)
{
nBytesRead=0;
if (!ReadFile(hd,lpBuffer,sizeof(lpBuffer),
&nBytesRead,NULL) || !nBytesRead)
{
if (GetLastError() == ERROR_BROKEN_PIPE)
break; // pipe done - normal exit path.
else
ShowMessage("ReadFile"); // Something bad happened.
}
c=lpBuffer[0];
if (c=='\n')
{
Form1->Memo1->Lines->Add(x);
x="";
}
else
{
x+=c;
Form1->Memo1->Lines->Strings[Form1->Memo1->Lines->Count-1]=x;
}
}
run=false;
}
//---------------------------------------------------------------------------
按button1初始化,按button2执行edit1中的dos命令,在Memo1中显示
只是还没有编写停止和退出,供参考吧
SonicX 2008-09-24
- 打赏
- 举报
procedure RunDosInMemo(Que:String;EnMemo:TMemo);
const
CUANTOBUFFER = 2000;
var
Seguridades : TSecurityAttributes;
PaLeer,PaEscribir : THandle;
start : TStartUpInfo;
ProcessInfo : TProcessInformation;
Buffer : Pchar;
BytesRead : DWord;
CuandoSale : DWord;
begin
//安全描述 可以省略
with Seguridades do
begin
nlength := SizeOf(TSecurityAttributes);
binherithandle := true;
lpsecuritydescriptor := nil;
end;
{Creamos el pipe...}
if Createpipe (PaLeer, PaEscribir, @Seguridades, 0) then
begin
//申请缓冲
Buffer := AllocMem(CUANTOBUFFER + 1);
//创建STARTUPINFO
FillChar(Start,Sizeof(Start),#0);
start.cb := SizeOf(start);
start.hStdOutput := PaEscribir;
start.hStdInput := PaLeer;
start.dwFlags := STARTF_USESTDHANDLES +
STARTF_USESHOWWINDOW;
start.wShowWindow := SW_HIDE;
//执行子进程
if CreateProcess(nil,
PChar(Que),
@Seguridades,
@Seguridades,
true,
NORMAL_PRIORITY_CLASS,
nil,
nil,
start,
ProcessInfo)
then
begin
{Espera a que termine la ejecucion}
repeat
//使用信号量技术来避免CPU时间片被抢占
CuandoSale := WaitForSingleObject( ProcessInfo.hProcess,100);
Application.ProcessMessages;
//until (CuandoSale <> WAIT_TIMEOUT);
{Leemos la Pipe}
//repeat
BytesRead := 0;
{Llenamos un troncho de la pipe, igual a nuestro buffer}
//执行标准输出
ReadFile(PaLeer,Buffer[0],CUANTOBUFFER,BytesRead,nil);
{La convertimos en una string terminada en cero}
Buffer[BytesRead]:= #0;
{Convertimos caracteres DOS a ANSI}
OemToAnsi(Buffer,Buffer);
EnMemo.Lines.Add(String(Buffer));
until (CuandoSale <> WAIT_TIMEOUT);//(BytesRead < CUANTOBUFFER);
end;
FreeMem(Buffer);
//释放资源
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(PaLeer);
CloseHandle(PaEscribir);
end;
end;
const
CUANTOBUFFER = 2000;
var
Seguridades : TSecurityAttributes;
PaLeer,PaEscribir : THandle;
start : TStartUpInfo;
ProcessInfo : TProcessInformation;
Buffer : Pchar;
BytesRead : DWord;
CuandoSale : DWord;
begin
//安全描述 可以省略
with Seguridades do
begin
nlength := SizeOf(TSecurityAttributes);
binherithandle := true;
lpsecuritydescriptor := nil;
end;
{Creamos el pipe...}
if Createpipe (PaLeer, PaEscribir, @Seguridades, 0) then
begin
//申请缓冲
Buffer := AllocMem(CUANTOBUFFER + 1);
//创建STARTUPINFO
FillChar(Start,Sizeof(Start),#0);
start.cb := SizeOf(start);
start.hStdOutput := PaEscribir;
start.hStdInput := PaLeer;
start.dwFlags := STARTF_USESTDHANDLES +
STARTF_USESHOWWINDOW;
start.wShowWindow := SW_HIDE;
//执行子进程
if CreateProcess(nil,
PChar(Que),
@Seguridades,
@Seguridades,
true,
NORMAL_PRIORITY_CLASS,
nil,
nil,
start,
ProcessInfo)
then
begin
{Espera a que termine la ejecucion}
repeat
//使用信号量技术来避免CPU时间片被抢占
CuandoSale := WaitForSingleObject( ProcessInfo.hProcess,100);
Application.ProcessMessages;
//until (CuandoSale <> WAIT_TIMEOUT);
{Leemos la Pipe}
//repeat
BytesRead := 0;
{Llenamos un troncho de la pipe, igual a nuestro buffer}
//执行标准输出
ReadFile(PaLeer,Buffer[0],CUANTOBUFFER,BytesRead,nil);
{La convertimos en una string terminada en cero}
Buffer[BytesRead]:= #0;
{Convertimos caracteres DOS a ANSI}
OemToAnsi(Buffer,Buffer);
EnMemo.Lines.Add(String(Buffer));
until (CuandoSale <> WAIT_TIMEOUT);//(BytesRead < CUANTOBUFFER);
end;
FreeMem(Buffer);
//释放资源
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(PaLeer);
CloseHandle(PaEscribir);
end;
end;
zbdenghu 2008-08-05
- 打赏
- 举报
好象不对呢，哪位能自己如果有能运行的代码能否发一份到我的邮箱，先谢谢了，我的邮箱是：zbdenghu@163.com
oosmile 2008-08-04
- 打赏
- 举报
首先,利用WIN API函数 Createpipe 建立两个管道(Pipe),然后建立利用CreateProcess函数创建一个控制台程序的进程（这里使用的是Win2000的Dos控制台 cmd.exe）,并且在StartUpInfo参数中指定用刚才建立的三个管道替换标准的输入hStdOutput、输出hStdInput以及错误输出设备hStdError。
代码如下：
procedure TForm1.InitConsole;
var
Security: TSecurityAttributes;
start: TStartUpInfo;
begin
with Security do begin
nlength := SizeOf(TSecurityAttributes);
binherithandle := true;
lpsecuritydescriptor := nil;
end;
Createpipe(ReadOut, WriteOut, @Security, 0);
Createpipe(ReadIn, WriteIn, @Security, 0);
with Security do begin
nlength := SizeOf(TSecurityAttributes);
binherithandle := true;
lpsecuritydescriptor := nil;
end;
FillChar(Start, Sizeof(Start), #0);
start.cb := SizeOf(start);
start.hStdOutput := WriteOut;
start.hStdInput := ReadIn;
start.hStdError := WriteOut;
start.dwFlags := STARTF_USESTDHANDLES +
STARTF_USESHOWWINDOW;
start.wShowWindow := SW_HIDE;
CreateProcess(nil,
PChar('cmd'),
@Security,
@Security,
true,
NORMAL_PRIORITY_CLASS,
nil,
nil,
start,
ProcessInfo)
end;
然后利用一个定时器，从对应输出设备的管道中读取控制台返回的信息，并显示。
代码如下：
function TForm1.ReadFromPipe(Pipe: THandle): string;
var
Buffer: PChar;
BytesRead: DWord;
begin
Result := '';
if GetFileSize(Pipe, nil) = 0 then Exit;
Buffer := AllocMem(ReadBuffer + 1);
repeat
BytesRead := 0;
ReadFile(Pipe, Buffer[0],
ReadBuffer, BytesRead, nil);
if BytesRead > 0 then begin
Buffer[BytesRead] := #0;
OemToAnsi(Buffer, Buffer);
Result := string(Buffer);
end;
until (BytesRead < ReadBuffer);
FreeMem(Buffer);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
s: string;
begin
s := ReadFromPipe(ReadOut);
if s <> '' then begin
Memo1.Lines.Text := Memo1.Lines.Text + s;
Memo1.SelStart := Length(Memo1.Lines.Text);
Memo1.SelLength := 0;
end;
end;
在下方的输入框内输入命令之后，则通过向输入设备对应的管道发送命令来实现命令行的输入，代码如下：
procedure TForm1.WriteToPipe(Pipe: THandle; Value: string);
var
len: integer;
BytesWrite: DWord;
Buffer: PChar;
begin
len := Length(Value) + 1;
Buffer := PChar(Value + #10);
WriteFile(Pipe, Buffer[0], len, BytesWrite, nil);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if Trim(cbCmd.Text) <> '' then begin
WriteToPipe(WriteIn, cbCmd.Text);
if cbCMD.ItemIndex > -1 then
cbCMD.Items.Delete(cbCMD.ItemIndex);
cbcmd.Items.Insert(0, cbCmd.Text);
cbCmd.Text:='';
end;
end;
这里要注意的是发送命令行的时候必须添加换行字符#10，才能被Dos控制台接受并执行
代码如下：
procedure TForm1.InitConsole;
var
Security: TSecurityAttributes;
start: TStartUpInfo;
begin
with Security do begin
nlength := SizeOf(TSecurityAttributes);
binherithandle := true;
lpsecuritydescriptor := nil;
end;
Createpipe(ReadOut, WriteOut, @Security, 0);
Createpipe(ReadIn, WriteIn, @Security, 0);
with Security do begin
nlength := SizeOf(TSecurityAttributes);
binherithandle := true;
lpsecuritydescriptor := nil;
end;
FillChar(Start, Sizeof(Start), #0);
start.cb := SizeOf(start);
start.hStdOutput := WriteOut;
start.hStdInput := ReadIn;
start.hStdError := WriteOut;
start.dwFlags := STARTF_USESTDHANDLES +
STARTF_USESHOWWINDOW;
start.wShowWindow := SW_HIDE;
CreateProcess(nil,
PChar('cmd'),
@Security,
@Security,
true,
NORMAL_PRIORITY_CLASS,
nil,
nil,
start,
ProcessInfo)
end;
然后利用一个定时器，从对应输出设备的管道中读取控制台返回的信息，并显示。
代码如下：
function TForm1.ReadFromPipe(Pipe: THandle): string;
var
Buffer: PChar;
BytesRead: DWord;
begin
Result := '';
if GetFileSize(Pipe, nil) = 0 then Exit;
Buffer := AllocMem(ReadBuffer + 1);
repeat
BytesRead := 0;
ReadFile(Pipe, Buffer[0],
ReadBuffer, BytesRead, nil);
if BytesRead > 0 then begin
Buffer[BytesRead] := #0;
OemToAnsi(Buffer, Buffer);
Result := string(Buffer);
end;
until (BytesRead < ReadBuffer);
FreeMem(Buffer);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
s: string;
begin
s := ReadFromPipe(ReadOut);
if s <> '' then begin
Memo1.Lines.Text := Memo1.Lines.Text + s;
Memo1.SelStart := Length(Memo1.Lines.Text);
Memo1.SelLength := 0;
end;
end;
在下方的输入框内输入命令之后，则通过向输入设备对应的管道发送命令来实现命令行的输入，代码如下：
procedure TForm1.WriteToPipe(Pipe: THandle; Value: string);
var
len: integer;
BytesWrite: DWord;
Buffer: PChar;
begin
len := Length(Value) + 1;
Buffer := PChar(Value + #10);
WriteFile(Pipe, Buffer[0], len, BytesWrite, nil);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if Trim(cbCmd.Text) <> '' then begin
WriteToPipe(WriteIn, cbCmd.Text);
if cbCMD.ItemIndex > -1 then
cbCMD.Items.Delete(cbCMD.ItemIndex);
cbcmd.Items.Insert(0, cbCmd.Text);
cbCmd.Text:='';
end;
end;
这里要注意的是发送命令行的时候必须添加换行字符#10，才能被Dos控制台接受并执行
