Как вывести результат работы консоли в Memo?
Материал из DRKB
Как вывести результат работы консоли в Memo?[править | править код]
Код взят из http://www.torry.net/memos.htm
procedure Dos2Win(CmdLine: string; OutMemo: TMemo);
const
BUFSIZE = 2000;
var
SecAttr: TSecurityAttributes;
hReadPipe, hWritePipe: THandle;
StartupInfo: TStartUpInfo;
ProcessInfo: TProcessInformation;
Buffer: PChar;
WaitReason, BytesRead: DWord;
begin
with SecAttr do
begin
nlength := SizeOf(TSecurityAttributes);
binherithandle := True;
lpsecuritydescriptor := nil;
end;
// Creazione della pipe
if CreatePipe(hReadPipe, hWritePipe, @SecAttr, 0) then
begin
Buffer := AllocMem(BUFSIZE + 1); // Allochiamo un buffer di dimensioni BUFSIZE+1
FillChar(StartupInfo, Sizeof(StartupInfo), #0);
StartupInfo.cb := SizeOf(StartupInfo);
StartupInfo.hStdOutput := hWritePipe;
StartupInfo.hStdInput := hReadPipe;
StartupInfo.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := SW_HIDE;
if CreateProcess(nil, PChar(CmdLine), @SecAttr, @SecAttr, True,
NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then
begin
// Attendiamo la fine dell'esecuzione del processo
repeat
WaitReason := WaitForSingleObject( ProcessInfo.hProcess,100);
Application.ProcessMessages;
until (WaitReason <> WAIT_TIMEOUT);
// Leggiamo la pipe
repeat
BytesRead := 0;
// Leggiamo "BUFSIZE" bytes dalla pipe
ReadFile(hReadPipe, Buffer[0], BUFSIZE, BytesRead, nil);
// Convertiamo in una stringa "\0 terminated"
Buffer[BytesRead]:= #0;
// Convertiamo i caratteri da DOS ad ANSI
OemToAnsi(Buffer,Buffer);
// Scriviamo nell' "OutMemo" l'output ricevuto tramite pipe
OutMemo.Text := OutMemo.text + String(Buffer);
until (BytesRead < BUFSIZE);
end;
FreeMem(Buffer);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(hReadPipe);
CloseHandle(hWritePipe);
end;
end;
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02099
А это исправленный Song'ом вариант для обеспечения вывода текста в real-time:
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;
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02100
Это пример запуска консольных программ с передачей ей консольного ввода (как если бы он был введен с клавиатуры после запуска программы) и чтением консольного вывода. Таким способом можно запускать например стандартный виндовый ftp.exe (в невидимом окне) и тем самым отказаться от использования специализированных, зачастую глючных компонент.
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 BytesRead <> 1024 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 i <> WAIT_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.hProcess <> INVALID_HANDLE_VALUE then
begin
CloseHandle(ProcInf.hThread);
i := WaitForSingleObject(ProcInf.hProcess, 1000);
CloseHandle(ProcInf.hProcess);
if i <> WAIT_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;
Source: Взято из http://forum.sources.ru
ID: 02101