将dos内部命令结果输出到Console Window

编程小战 2002-11-21 08:45:32
unit Console;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,ShellAPI;

type
TConsoleForm = class(TForm)
btOpen: TButton;
btClose: TButton;
btRun: TButton;
btOutput: TButton;
procedure btOpenClick(Sender: TObject);
procedure btCloseClick(Sender: TObject);
procedure btOutputClick(Sender: TObject);
procedure btRunClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
ConsoleForm: TConsoleForm;

implementation

{$R *.dfm}

procedure TConsoleForm.btOpenClick(Sender: TObject);
begin
if not AllocConsole then Application.MessageBox('Can''t allocate console!','Console',MB_OK OR MB_ICONINFORMATION)
else SetConsoleTitle('Console Demo');
end;

procedure TConsoleForm.btCloseClick(Sender: TObject);
begin
if not FreeConsole then Application.MessageBox('Can''t free console!','Console',MB_OK OR MB_ICONINFORMATION);
end;

procedure TConsoleForm.btOutputClick(Sender: TObject);
var OutText:PChar;nWrite:Cardinal;sHandle:Cardinal;
begin
OutText:='Hello,console!'#$A#$D;
sHandle:=GetStdHandle(STD_OUTPUT_HANDLE);
if (sHandle<>0) then
begin
WriteConsole(sHandle,OutText,StrLen(OutText),nWrite,nil);
end;
end;

procedure TConsoleForm.btRunClick(Sender: TObject);
begin
//这里要运行dos的dir命令,并将结果输出到"Open"按钮打开的Console
//Window,怎么写
end;

end.
...全文
13 点赞 收藏 6
写回复
6 条回复
切换为时间正序
请发表友善的回复…
发表回复
RamjetZhang 2002-11-22
in msdn
HOWTO: Spawn Console Processes with Redirected Standard Handles
Q190351
回复
debussy 2002-11-22
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.
回复
debussy 2002-11-22
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;
**************
回复
debussy 2002-11-22
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 );

回复
zuoyexingchen 2002-11-22
unit U_pipe;

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
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.
回复
xuyfufeng 2002-11-22
你的程序可以给我看看吗?也许我可以帮你这个忙,E-Mail:xu_yufeng@msn.com,告诉我你是做什么用的。
回复
发动态
发帖子
Windows SDK/API
创建于2007-08-02

1145

社区成员

Delphi Windows SDK/API
申请成为版主
社区公告
暂无公告