Проблема с запуском консольной программы и получением ее вывода

[B0o0M]

Проблема, бьюсь дня 4 итак нам нужно запустить консольное приложение и получить его вывод, перечитал кучю статей, сходил на MSDN фсе бестолку, или то что я беру идет с ошибкой, которую я исправляю но потом делфи CodeGear 2009 вылетает с ошибкой выполнения вот прошу работающий пример а то хоть перенаправляй в файл а потом от туда пастрочно читай, заранее благодарен

[begin_end]

Возможно тебе поможет пример с использованием пайпов из темы https://forum.antichat.ru/showthread.php?t=34115.

[B0o0M]

Возможно тебе поможет пример с использованием пайпов из темы https://forum.antichat.ru/showthread.php?t=34115.
Обсолютно не помогло (((
OemToAnsi(Buffer,Buffer); Ругаеццо на несовместимость типов
поставил PAnsiChar и вуаля ошибка выполнения (((

[miako]

нужно запустить консольное приложение и получить его вывод
Получить вывод куда? В файл? На экран? Непонятица

[B0o0M]

Получить вывод куда? В файл? На экран? Непонятица
Моя прога запускает консольное приложение, затем получет его вывод, и вывод консоли обрабатвает

[B0o0M]

:D вывод консоли в файл start file.exe > file.txt
Не по фэншую это, не пофэншую !!!

[Faost]

http://programmersforum.ru/showthread.php?t=8725
подкорректируй только немного.

[B0o0M]

http://programmersforum.ru/showthread.php?t=8725
подкорректируй только немного.
Спасибо канешно, но я нашол другой выход (через фалы) так как через пайпы прога вешаеццо, на всех примерах которые я юзал вот терь стала другая проблема как переделать кодировку win - dos

[B0o0M]

ВСЕ ВСЕМ СПАСИБО, сам нашол выход через файлы, тему сисег можно закрыть !!!

[dr.Pilulkin]

Всетаки ИМХО нужно было разобраться с пайпами. Пошел по легкому пути, но потерял в производительности. Получается не код а херь. Почитай. (http://wasm.ru/article.php?article=1001021)

[FairHawk]

сам не юзал, но попробуй:

{----------------------------CreateDOSProcessRedirected---------------------------
Description : executes a (DOS!) app defined in the CommandLine parameter redirected
to take input from InputFile and give output to OutputFile
Result : True on success
Parameters :
CommandLine : the command line for the app, including its full path
InputFile : the ascii file where from the app takes input
OutputFile : the ascii file to which the app's output is redirected
ErrMsg : additional error message string. Can be empty
Error checking : YES
Target : Delphi 2, 3, 4
Author : Theodoros Bebekis, email bebekis@otenet.gr
Notes :
Example call : CreateDOSProcessRedirected('C:\MyDOSApp.exe',
'C:\InputPut.txt',
'C:\OutPut.txt',
'Please, record this message')
-----------------------------------------------------------------------------------}

function CreateDOSProcessRedirected(const CommandLine, InputFile, OutputFile,
ErrMsg: string): Boolean;
const
ROUTINE_ID = '[function: CreateDOSProcessRedirected ]';
var
OldCursor: TCursor;
pCommandLine: array[0..MAX_PATH] of Char;
pInputFile, pOutPutFile: array[0..MAX_PATH] of Char;
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
SecAtrrs: TSecurityAttributes;
hAppProcess, hAppThread, hInputFile, hOutputFile: THandle;
begin
Result := False;

{ check for InputFile existence }
if not FileExists(InputFile) then
raise Exception.CreateFmt(ROUTINE_ID + #10 + #10 +
'Input file * %s *' + #10 +
'does not exist' + #10 + #10 +
ErrMsg, [InputFile]);

{ save the cursor }
OldCursor := Screen.Cursor;
Screen.Cursor := crHourglass;

{ copy the parameter Pascal strings to null terminated strings }
StrPCopy(pCommandLine, CommandLine);
StrPCopy(pInputFile, InputFile);
StrPCopy(pOutPutFile, OutputFile);

try

{ prepare SecAtrrs structure for the CreateFile calls
This SecAttrs structure is needed in this case because
we want the returned handle can be inherited by child process
This is true when running under WinNT.
As for Win95 the documentation is quite ambiguous }
FillChar(SecAtrrs, SizeOf(SecAtrrs), #0);
SecAtrrs.nLength := SizeOf(SecAtrrs);
SecAtrrs.lpSecurityDescriptor := nil;
SecAtrrs.bInheritHandle := True;

{ create the appropriate handle for the input file }
hInputFile := CreateFile(pInputFile,
{ pointer to name of the file }
GENERIC_READ or GENERIC_WRITE,
{ access (read-write) mode }
FILE_SHARE_READ or FILE_SHARE_WRITE,
{ share mode } @SecAtrrs, { pointer to security attributes }
OPEN_ALWAYS, { how to create }
FILE_ATTRIBUTE_TEMPORARY, { file attributes }
0); { handle to file with attributes to copy }


{ is hInputFile a valid handle? }
if hInputFile = INVALID_HANDLE_VALUE then
raise Exception.CreateFmt(ROUTINE_ID + #10 + #10 +
'WinApi function CreateFile returned an invalid handle value' +
#10 +
'for the input file * %s *' + #10 + #10 +
ErrMsg, [InputFile]);

{ create the appropriate handle for the output file }
hOutputFile := CreateFile(pOutPutFile,
{ pointer to name of the file }
GENERIC_READ or GENERIC_WRITE,
{ access (read-write) mode }
FILE_SHARE_READ or FILE_SHARE_WRITE,
{ share mode } @SecAtrrs, { pointer to security attributes }
CREATE_ALWAYS, { how to create }
FILE_ATTRIBUTE_TEMPORARY, { file attributes }
0); { handle to file with attributes to copy }

{ is hOutputFile a valid handle? }
if hOutputFile = INVALID_HANDLE_VALUE then
raise Exception.CreateFmt(ROUTINE_ID + #10 + #10 +
'WinApi function CreateFile returned an invalid handle value' +
#10 +
'for the output file * %s *' + #10 + #10 +
ErrMsg, [OutputFile]);

{ prepare StartupInfo structure }
FillChar(StartupInfo, SizeOf(StartupInfo), #0);
StartupInfo.cb := SizeOf(StartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
StartupInfo.wShowWindow := SW_HIDE;
StartupInfo.hStdOutput := hOutputFile;
StartupInfo.hStdInput := hInputFile;

{ create the app }
Result := CreateProcess(nil, { pointer to name of executable module }
pCommandLine,
{ pointer to command line string }
nil, { pointer to process security attributes }
nil, { pointer to thread security attributes }
True, { handle inheritance flag }
CREATE_NEW_CONSOLE or
REALTIME_PRIORITY_CLASS, { creation flags }
nil, { pointer to new environment block }
nil, { pointer to current directory name }
StartupInfo, { pointer to STARTUPINFO }
ProcessInfo); { pointer to PROCESS_INF }

{ wait for the app to finish its job and take the handles to free them later }
if Result then
begin
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
hAppProcess := ProcessInfo.hProcess;
hAppThread := ProcessInfo.hThread;
end
else
raise Exception.Create(ROUTINE_ID + #10 + #10 +
'Function failure' + #10 + #10 +
ErrMsg);

finally
{ close the handles
Kernel objects, like the process and the files we created in this case,
are maintained by a usage count.
So, for cleaning up purposes we have to close the handles
to inform the system that we don't need the objects anymore }
if hOutputFile <> 0 then CloseHandle(hOutputFile);
if hInputFile <> 0 then CloseHandle(hInputFile);
if hAppThread <> 0 then CloseHandle(hAppThread);
if hAppProcess <> 0 then CloseHandle(hAppProcess);
{ restore the old cursor }
Screen.Cursor := OldCursor;
end;
end;

[FairHawk]

CreateProcess, который возвращает консольный вывод

procedure ExecConsoleApp(CommandLine: AnsiString; Output: TStringList; Errors:
TStringList);
var
sa: TSECURITYATTRIBUTES;
si: TSTARTUPINFO;
pi: TPROCESSINFORMATION;
hPipeOutputRead: THANDLE;
hPipeOutputWrite: THANDLE;
hPipeErrorsRead: THANDLE;
hPipeErrorsWrite: THANDLE;
Res, bTest: Boolean;
env: array[0..100] of Char;
szBuffer: array[0..256] of Char;
dwNumberOfBytesRead: DWORD;
Stream: TMemoryStream;
begin
sa.nLength := sizeof(sa);
sa.bInheritHandle := true;
sa.lpSecurityDescriptor := nil;
CreatePipe(hPipeOutputRead, hPipeOutputWrite, @sa, 0);
CreatePipe(hPipeErrorsRead, hPipeErrorsWrite, @sa, 0);
ZeroMemory(@env, SizeOf(env));
ZeroMemory(@si, SizeOf(si));
ZeroMemory(@pi, SizeOf(pi));
si.cb := SizeOf(si);
si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
si.wShowWindow := SW_HIDE;
si.hStdInput := 0;
si.hStdOutput := hPipeOutputWrite;
si.hStdError := hPipeErrorsWrite;

(* Remember that if you want to execute an app with no parameters you nil the
second parameter and use the first, you can also leave it as is with no
problems. *)
Res := CreateProcess(nil, pchar(CommandLine), nil, nil, true,
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, @env, nil, si, pi);

// Procedure will exit if CreateProcess fail
if not Res then
begin
CloseHandle(hPipeOutputRead);
CloseHandle(hPipeOutputWrite);
CloseHandle(hPipeErrorsRead);
CloseHandle(hPipeErrorsWrite);
Exit;
end;
CloseHandle(hPipeOutputWrite);
CloseHandle(hPipeErrorsWrite);

//Read output pipe
Stream := TMemoryStream.Create;
try
while true do
begin
bTest := ReadFile(hPipeOutputRead, szBuffer, 256, dwNumberOfBytesRead,
nil);
if not bTest then
begin
break;
end;
Stream.Write(szBuffer, dwNumberOfBytesRead);
end;
Stream.Position := 0;
Output.LoadFromStream(Stream);
finally
Stream.Free;
end;

//Read error pipe
Stream := TMemoryStream.Create;
try
while true do
begin
bTest := ReadFile(hPipeErrorsRead, szBuffer, 256, dwNumberOfBytesRead,
nil);
if not bTest then
begin
break;
end;
Stream.Write(szBuffer, dwNumberOfBytesRead);
end;
Stream.Position := 0;
Errors.LoadFromStream(Stream);
finally
Stream.Free;
end;

WaitForSingleObject(pi.hProcess, INFINITE);
CloseHandle(pi.hProcess);
CloseHandle(hPipeOutputRead);
CloseHandle(hPipeErrorsRead);
end;

(* got it from yahoo groups, so no copyrights for this piece :p and and example
of how to use it. put a button and a memo to a form. *)

procedure TForm1.Button1Click(Sender: TObject);
var
OutP: TStringList;
ErrorP: TStringList;
begin
OutP := TStringList.Create;
ErrorP := TstringList.Create;

ExecConsoleApp('ping localhost', OutP, ErrorP);
Memo1.Lines.Assign(OutP);

OutP.Free;
ErrorP.Free;
end;

[FairHawk]

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;

[FairHawk]

const
H_IN_READ = 1;
H_IN_WRITE = 2;
H_OUT_READ = 3;
H_OUT_WRITE = 4;
H_ERR_READ = 5;
H_ERR_WRITE = 6;

type
TPipeHandles = array [1..6] of THandle;
var
hPipes: TPipeHandles;
ProcessInfo: TProcessInformation;

(************CREATE HIDDEN CONSOLE PROCESS************)
function CreateHiddenConsoleProcess(szChildName: string;
ProcPriority: DWORD; ThreadPriority: integer): Boolean;
label
error;
var
fCreated: Boolean;
si: TStartupInfo;
sa: TSecurityAttributes;
begin
// Initialize handles
hPipes[ H_IN_READ ] := INVALID_HANDLE_VALUE;
hPipes[ H_IN_WRITE ] := INVALID_HANDLE_VALUE;
hPipes[ H_OUT_READ ] := INVALID_HANDLE_VALUE;
hPipes[ H_OUT_WRITE ] := INVALID_HANDLE_VALUE;
hPipes[ H_ERR_READ ] := INVALID_HANDLE_VALUE;
hPipes[ H_ERR_WRITE ] := INVALID_HANDLE_VALUE;
ProcessInfo.hProcess := INVALID_HANDLE_VALUE;
ProcessInfo.hThread := INVALID_HANDLE_VALUE;
// Create pipes
// initialize security attributes for handle inheritance (for WinNT)
sa.nLength := sizeof(sa);
sa.bInheritHandle := TRUE;
sa.lpSecurityDescriptor := nil;
// create STDIN pipe
if not CreatePipe( hPipes[ H_IN_READ ], hPipes[ H_IN_WRITE ], @sa, 0 ) then
goto error;
// create STDOUT pipe
if not CreatePipe( hPipes[ H_OUT_READ ], hPipes[ H_OUT_WRITE ], @sa, 0 ) then
goto error;
// create STDERR pipe
if not CreatePipe( hPipes[ H_ERR_READ ], hPipes[ H_ERR_WRITE ], @sa, 0 ) then
goto error;
// process startup information
ZeroMemory(Pointer(@si), sizeof(si));
si.cb := sizeof(si);
si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
si.wShowWindow := SW_HIDE;
// assign "other" sides of pipes
si.hStdInput := hPipes[ H_IN_READ ];
si.hStdOutput := hPipes[ H_OUT_WRITE ];
si.hStdError := hPipes[ H_ERR_WRITE ];
// Create a child process
try
fCreated := CreateProcess( nil, PChar(szChildName), nil, nil, True,
ProcPriority, // CREATE_SUSPENDED,
nil, nil, si, ProcessInfo );
except
fCreated := False;
end;

if not fCreated then
goto error;

Result := True;
CloseHandle(hPipes[ H_OUT_WRITE ]);
CloseHandle(hPipes[ H_ERR_WRITE ]);
// ResumeThread( pi.hThread );
SetThreadPriority(ProcessInfo.hThread, ThreadPriority);
CloseHandle( ProcessInfo.hThread );
Exit;
//-----------------------------------------------------
error:
ClosePipes( hPipes );
CloseHandle( ProcessInfo.hProcess );
CloseHandle( ProcessInfo.hThread );
ProcessInfo.hProcess := INVALID_HANDLE_VALUE;
ProcessInfo.hThread := INVALID_HANDLE_VALUE;
Result := False;
end;



Cорри что в несколько постов.. Может поможет что)

[B0o0M]

кароче если чесно нифига не помогло, ошибка при выполнении создания пайпа, хоть убейся не знаю или у меня руки кривые или дефи кривой, кароче вот код который у меня пашет
зы помогло тока 1, но всерамно спасиба чювак
------------------

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Edit1: TEdit;
Memo2: TMemo;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
function RunCaptured(const _dirName, _exeName, _cmdLine: string): Boolean;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}


function StrOemToAnsi(const S: AnsiString): AnsiString;
begin
SetLength(Result, Length(S));
OemToAnsiBuff(@S[1], @Result[1], Length(S));
end;

procedure TForm1.Button2Click(Sender: TObject);
var
i: integer;
begin
for i:=0 to Memo1.Lines.Count do
begin
memo2.Lines.Add(StrOemToAnsi(AnsiString(memo1.Line s[i])));
end;
end;

function TForm1.RunCaptured(const _dirName, _exeName, _cmdLine: string): Boolean;
var
start: TStartupInfo;
procInfo: TProcessInformation;
tmpName: string;
tmp: Windows.THandle;
tmpSec: TSecurityAttributes;
res: TStringList;
return: Cardinal;
begin
Result := False;
try
{ Set a temporary file }
tmpName := 'Test.tmp';
FillChar(tmpSec, SizeOf(tmpSec), #0);
tmpSec.nLength := SizeOf(tmpSec);
tmpSec.bInheritHandle := True;
tmp := Windows.CreateFile(PChar(tmpName),
Generic_Write, File_Share_Write,
@tmpSec, Create_Always, File_Attribute_Normal, 0);
try
FillChar(start, SizeOf(start), #0);
start.cb := SizeOf(start);
start.hStdOutput := tmp;
start.dwFlags := StartF_UseStdHandles or StartF_UseShowWindow;
start.wShowWindow := SW_Minimize;
{ Start the program }
if CreateProcess(nil, PChar(_exeName + ' ' + _cmdLine), nil, nil, True,
0, nil, PChar(_dirName), start, procInfo) then
begin
SetPriorityClass(procInfo.hProcess, Idle_Priority_Class);
WaitForSingleObject(procInfo.hProcess, Infinite);
GetExitCodeProcess(procInfo.hProcess, return);
Result := (return = 0);
CloseHandle(procInfo.hThread);
CloseHandle(procInfo.hProcess);
Windows.CloseHandle(tmp);
{ Add the output }
res := TStringList.Create;
try
res.LoadFromFile(tmpName);
Memo1.Lines.AddStrings(res);
finally
res.Free;
end;
Windows.DeleteFile(PChar(tmpName));
end
else
begin
Application.MessageBox(PChar(SysErrorMessage(GetLa stError())),
'RunCaptured Error', MB_OK);
end;
except
Windows.CloseHandle(tmp);
Windows.DeleteFile(PChar(tmpName));
raise;
end;
finally
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
RunCaptured('E:\', 'cmd.exe', '/c' + edit1.Text);
end;

end.