گرفتن خروجی یک برنامه کنسول در Memo در دلفی 2009 [بایگانی]

Delphi Skyline

دوشنبه 16 شهریور 1388, 16:01 عصر

با سلام .
دیدم توی سایت های مختلف این تیپ رو همه برای دلفی 2007 به پایین نوشتن . چون دلفی 2009 و 2010 یونیکده با این کد مشکل داشت . یه دو سه تا تغییر کوچیک می خواست از جمله UniqueString کردن لازم بود برای Createprocess یونیکد . گفتم کد رو بزارم شاید بدرد دوستان بخوره :

procedure RunDosInMemo1(DosApp:String;AMemo:TMemo) ;
const
ReadBuffer = 2400;
var
Security : TSecurityAttributes;
ReadPipe,
WritePipe : THandle;
start : TStartUpInfo;
ProcessInfo : TProcessInformation;
Buffer : Pansichar;
BytesRead : DWord;
Apprunning : DWord;

begin
Security.nlength := SizeOf(TSecurityAttributes) ;
Security.binherithandle := true;
Security.lpsecuritydescriptor := nil;
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;
UniqueString(DosApp);
if CreateProcess(nil,
PChar(DosApp),
@Security,
@Security,
true,
NORMAL_PRIORITY_CLASS,
nil,
nil,
start,
ProcessInfo) then
begin
repeat
Apprunning := WaitForSingleObject(ProcessInfo.hProcess,100);
Application.ProcessMessages;
until (Apprunning <> WAIT_TIMEOUT) ;
repeat
BytesRead := 0;
ReadFile(ReadPipe,Buffer[0],
ReadBuffer,BytesRead,nil) ;
Buffer[BytesRead]:= #0;
OemToAnsi(Buffer,Buffer) ;
AMemo.Text := AMemo.text + String(Buffer) ;
until (BytesRead < ReadBuffer) ;
end;
FreeMem(Buffer) ;
CloseHandle(ProcessInfo.hProcess) ;
CloseHandle(ProcessInfo.hThread) ;
CloseHandle(ReadPipe) ;
CloseHandle(WritePipe) ;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
RunDosInMemo1('c:\imagex',memo1) ;
end;