Перехват вывода программы

[Чех]

Пишу прогу на Delphi, и нужно перехватить вывод программы ДОС (прога чужая и исходников нет) в текстовое поле. Помогите, кто чем может, плз!!!

[pluton]

Цитата: Сообщение от Чех нужно перехватить вывод программы ДОС (прога чужая и исходников нет) в текстовое поле

для этого в винде используются пайпы (каналы).
вот два примера проги, которая тебе нужна:
прога 1

unit consoleoutput;

interface

uses
Controls, Windows, SysUtils, Forms;

function GetDosOutput(const CommandLine:string): string;

implementation

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;
// создаём пайп для перенаправления стандартного вывода
CreatePipe(StdOutPipeRead, // дескриптор чтения
StdOutPipeWrite, // дескриптор записи
@SA, // аттрибуты безопасности
0 // количество байт принятых для пайпа - 0 по умолчанию
);
try
// Создаём дочерний процесс, используя StdOutPipeWrite в качестве стандартного вывода,
// а так же проверяем, чтобы он не показывался на экране.
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); // стандартный ввод не перенаправляем
hStdOutput := StdOutPipeWrite;
hStdError := StdOutPipeWrite;
end;

// Запускаем компилятор из командной строки
WorkDir := ExtractFilePath(CommandLine);
WasOK := CreateProcess(nil, PChar(CommandLine), nil, nil, True, 0, nil, PChar(WorkDir), SI, PI);

// Теперь, когда дескриптор получен, для безопасности закрываем запись.
// Нам не нужно, чтобы произошло случайное чтение или запись.
CloseHandle(StdOutPipeWrite);
// если процесс может быть создан, то дескриптор, это его вывод
if not WasOK then
raise Exception.Create('Could not execute command line!')
else
try
// получаем весь вывод до тех пор, пока DOS-приложение не будет завершено
Line := '';
repeat
// читаем блок символов (могут содержать возвраты каретки и переводы строки)
WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);

// есть ли что-нибудь ещё для чтения?
if BytesRead > 0 then
begin
// завершаем буфер PChar-ом
Buffer[BytesRead] := #0;
// добавляем буфер в общий вывод
Line := Line + Buffer;
end;
until not WasOK or (BytesRead = 0);
// ждём, пока завершится консольное приложение
WaitForSingleObject(PI.hProcess, INFINITE);
finally
// Закрываем все оставшиеся дескрипторы
CloseHandle(PI.hThread);
CloseHandle(PI.hProcess);
end;
finally
result:=Line;
CloseHandle(StdOutPipeRead);
end;
end;

end.

прога 2

procedure RunDosInMemo(CmdLine:String;AMemo:TMemo);
const
ReadBuffer = 2400;
var
Security : TSecurityAttributes;
ReadPipe,WritePipe : THandle;
start : TStartUpInfo;
ProcessInfo : TProcessInformation;
Buffer : Pchar;
BytesRead : DWord;
Apprunning : DWord;
begin
Screen.Cursor:=CrHourGlass;
Form1.Button1.Enabled:=False;
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(CmdLine),
@Security,
@Security,
true,
NORMAL_PRIORITY_CLASS,
nil,
nil,
start,
ProcessInfo)
then
begin
repeat
Apprunning := WaitForSingleObject
(ProcessInfo.hProcess,100);
ReadFile(ReadPipe,Buffer[0],
ReadBuffer,BytesRead,nil);
Buffer[BytesRead]:= #0;
OemToAnsi(Buffer,Buffer);
AMemo.Text := AMemo.text + String(Buffer);

Application.ProcessMessages;
until (Apprunning <> WAIT_TIMEOUT);
end;
FreeMem(Buffer);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(ReadPipe);
CloseHandle(WritePipe);
end;
Screen.Cursor:=CrDefault;
Form1.Button1.Enabled:=True;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Clear;
RunDosInMemo('ping -t 192.168.28.200',Memo1);
end;

Можно сделать ещё и с вводом информации с твоей программы в ту консоль:
прога 3

function ExecuteFile(FileName,StdInput: string;
TimeOut: integer;
var StdOutput:string) : boolean;

label Error;

type
TPipeHandles = (IN_WRITE, IN_READ,
OUT_WRITE, OUT_READ,
ERR_WRITE, ERR_READ);

type
TPipeArray = array [TPipeHandles] of THandle;

var
i : integer;
ph : TPipeHandles;
sa : TSecurityAttributes;
Pipes : TPipeArray;
StartInf : TStartupInfo;
ProcInf : TProcessInformation;
Buf : array[0..1024] of byte;
TimeStart : TDateTime;


function ReadOutput : string;
var
i : integer;
s : string;
BytesRead : longint;

begin
Result := '';
repeat

Buf[0]:=26;
WriteFile(Pipes[OUT_WRITE],Buf,1,BytesRead,nil);
if ReadFile(Pipes[OUT_READ],Buf,1024,BytesRead,nil) then
begin
if BytesRead>0 then
begin
buf[BytesRead]:=0;
s := StrPas(@Buf[0]);
i := Pos(#26,s);
if i>0 then s := copy(s,1,i-1);
Result := Result + s;
end;
end;

if BytesRead1024 then break;
until false;
end;


begin
Result := false;
for ph := Low(TPipeHandles) to High(TPipeHandles) do
Pipes[ph] := INVALID_HANDLE_VALUE;


// Создаем пайпы
sa.nLength := sizeof(sa);
sa.bInheritHandle := TRUE;
sa.lpSecurityDescriptor := nil;


if not CreatePipe(Pipes[IN_READ],Pipes[IN_WRITE], @sa, 0 ) then
goto Error;
if not CreatePipe(Pipes[OUT_READ],Pipes[OUT_WRITE], @sa, 0 ) then
goto Error;
if not CreatePipe(Pipes[ERR_READ],Pipes[ERR_WRITE], @sa, 0 ) then
goto Error;



// Пишем StdIn
StrPCopy(@Buf[0],stdInput+^Z);
WriteFile(Pipes[IN_WRITE],Buf,Length(stdInput),i,nil);


// Хендл записи в StdIn надо закрыть - иначе выполняемая программа
// может не прочитать или прочитать не весь StdIn.

CloseHandle(Pipes[IN_WRITE]);

Pipes[IN_WRITE] := INVALID_HANDLE_VALUE;


FillChar(StartInf,sizeof(TStartupInfo),0);
StartInf.cb := sizeof(TStartupInfo);
StartInf.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;


StartInf.wShowWindow := SW_SHOW; // SW_HIDE если надо запустить невидимо


StartInf.hStdInput := Pipes[IN_READ];
StartInf.hStdOutput := Pipes[OUT_WRITE];
StartInf.hStdError := Pipes[ERR_WRITE];


if not CreateProcess(nil, PChar(FileName), nil,
nil, True, NORMAL_PRIORITY_CLASS,
nil, nil, StartInf, ProcInf) then goto Error;

TimeStart := Now;

repeat
Application.ProcessMessages;
i := WaitForSingleObject(ProcInf.hProcess,100);
if i = WAIT_OBJECT_0 then break;
if (Now-TimeStart)*SecsPerDay>TimeOut then break;
until false;


if iWAIT_OBJECT_0 then goto Error;
StdOutput := ReadOutput;

for ph := Low(TPipeHandles) to High(TPipeHandles) do
if Pipes[ph]INVALID_HANDLE_VALUE then
CloseHandle(Pipes[ph]);


CloseHandle(ProcInf.hProcess);
CloseHandle(ProcInf.hThread);
Result := true;
Exit;


Error:

if ProcInf.hProcessINVALID_HANDLE_VALUE then

begin
CloseHandle(ProcInf.hThread);
i := WaitForSingleObject(ProcInf.hProcess, 1000);
CloseHandle(ProcInf.hProcess);
if iWAIT_OBJECT_0 then

begin
ProcInf.hProcess := OpenProcess(PROCESS_TERMINATE,
FALSE,
ProcInf.dwProcessId);

if ProcInf.hProcess 0 then
begin
TerminateProcess(ProcInf.hProcess, 0);
CloseHandle(ProcInf.hProcess);
end;
end;
end;

for ph := Low(TPipeHandles) to High(TPipeHandles) do
if Pipes[ph]INVALID_HANDLE_VALUE then
CloseHandle(Pipes[ph]);

end;