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

[Delphi Skyline]

با سلام .
دیدم توی سایت های مختلف این تیپ رو همه برای دلفی 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;

[vcldeveloper]

مرسی، فقط بلوک زیر AllocMem را در try-finally قرار بدید، تا همیشه FreeMem و CloseHandle ها فراخوانی بشند.