Проблема, бьюсь дня 4 итак нам нужно запустить консольное приложение и получить его вывод, перечитал кучю статей, сходил на MSDN фсе бестолку, или то что я беру идет с ошибкой, которую я исправляю но потом делфи CodeGear 2009 вылетает с ошибкой выполнения вот прошу работающий пример а то хоть перенаправляй в файл а потом от туда пастрочно читай, заранее благодарен
Возможно тебе поможет пример с использованием пайпов из темы https://forum.antichat.ru/showthread.php?t=34115.
Обсолютно не помогло ((( OemToAnsi(Buffer,Buffer); Ругаеццо на несовместимость типов поставил PAnsiChar и вуаля ошибка выполнения (((
Спасибо канешно, но я нашол другой выход (через фалы) так как через пайпы прога вешаеццо, на всех примерах которые я юзал вот терь стала другая проблема как переделать кодировку win - dos
Всетаки ИМХО нужно было разобраться с пайпами. Пошел по легкому пути, но потерял в производительности. Получается не код а херь. Почитай.
сам не юзал, но попробуй: Code: {----------------------------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 [email protected] 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;
CreateProcess, который возвращает консольный вывод Code: 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;
Code: 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;
Code: 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орри что в несколько постов.. Может поможет что)
кароче если чесно нифига не помогло, ошибка при выполнении создания пайпа, хоть убейся не знаю или у меня руки кривые или дефи кривой, кароче вот код который у меня пашет зы помогло тока 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.Lines))); 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(GetLastError())), '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.