Konsola çıkan mesajları yakalama (Redirection)

[z]

Delphide yazdığım program (IDE) bir noktada batch dosya çağırıyor.

Batch dosya ise özel bir derleyiciyi çalıştırarak bir source programın otomatik olarak derlenmesini sağlıyor.

Eğer derleyici derleme aşamasında hata bulursa hata mesajları konsolda görülüyor. Ancak yukarılara doğru akıp gidiyor.

Amacım, ekranda akan bu mesajları "Delphi"deki programıma bir şekilde aktarabilmek.

Malesef "DOS"dan tanıdığımız > tipi redirection komutları işe yaramıyor.

Win98 ortamında konsola giden mesajları "Delphi"ye nasıl aktarırım?
File üzerinden okumaya bile razıyım.

[picusta]

Delphi'de WINAPI çagrilabiliyor mu? Hani visual basic'de windows DLL'lerini import edip, prototipleri yazinca WINAPI fonksyonlari çagrilabiliyor.
WINAPI'ler ile yapilir tahminimce. ShellExecuteEx veya CreateProcess API'lerine bakin.

[SpeedyX]

Formda birer tane richedit ve buton olsun

function RunProg(Cmd, WorkDir: String): string;
var
 tsi: TStartupInfo;
 tpi: TProcessInformation;
 nRead: DWORD;
 aBuf: Array[0..101] of char;
 sa: TSecurityAttributes;
 hOutputReadTmp, hOutputRead, hOutputWrite, hInputWriteTmp, hInputRead,
 hInputWrite, hErrorWrite: THandle;
 FOutput: String;
begin
 FOutput := '';

 sa.nLength              := SizeOf(TSecurityAttributes);
 sa.lpSecurityDescriptor := nil;
 sa.bInheritHandle       := True;

 CreatePipe(hOutputReadTmp, hOutputWrite, @sa, 0);
 DuplicateHandle(GetCurrentProcess(), hOutputWrite, GetCurrentProcess(),
   @hErrorWrite, 0, true, DUPLICATE_SAME_ACCESS);
 CreatePipe(hInputRead, hInputWriteTmp, @sa, 0);
 DuplicateHandle(GetCurrentProcess(), hOutputReadTmp,  GetCurrentProcess(),
   @hOutputRead,  0, false, DUPLICATE_SAME_ACCESS);
 DuplicateHandle(GetCurrentProcess(), hInputWriteTmp, GetCurrentProcess(),
   @hInputWrite, 0, false, DUPLICATE_SAME_ACCESS);
 CloseHandle(hOutputReadTmp);
 CloseHandle(hInputWriteTmp);

 FillChar(tsi, SizeOf(TStartupInfo), 0);
 tsi.cb         := SizeOf(TStartupInfo);
 tsi.dwFlags    := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
 tsi.hStdInput  := hInputRead;
 tsi.hStdOutput := hOutputWrite;
 tsi.hStdError  := hErrorWrite;

 CreateProcess(nil, PChar(Cmd), @sa, @sa, true, 0, nil, PChar(WorkDir),
   tsi, tpi);
 CloseHandle(hOutputWrite);
 CloseHandle(hInputRead );
 CloseHandle(hErrorWrite);
 Application.ProcessMessages;

 repeat
    if (not ReadFile(hOutputRead, aBuf, 16, nRead, nil)) or (nRead = 0) then
    begin
       if GetLastError = ERROR_BROKEN_PIPE then Break
       else MessageDlg('Pipe read error, could not execute file', mtError, [mbOK], 0);
    end;
    aBuf[nRead] := #0;
    FOutput := FOutput + PChar(@aBuf[0]);
    Application.ProcessMessages;
 until False;

 Result := FOutput;
 //GetExitCodeProcess(tpi.hProcess, nRead) = True;
end;

kullanımı

procedure TForm1.Button1Click(Sender: TObject);
begin
    RichEdit1.Text:=RunProg('C:\java.exe','C:\');
end;

[birumher]

Bir tane de benden olsun. Bu da çalışma esnasında program kapanmasa da çıkışını memo ya aktarıyor...

procedure CaptureConsoleOutput(DosApp : string;AMemo : TMemo);
const
  ReadBuffer = 1048576;  
var
  Security            : TSecurityAttributes;
  ReadPipe,WritePipe  : THandle;
  start               : TStartUpInfo;
  ProcessInfo         : TProcessInformation;
  Buffer              : Pchar;
  TotalBytesRead,
  BytesRead           : DWORD;
  Apprunning,n,
  BytesLeftThisMessage,
  TotalBytesAvail : integer;
  terminateProcessExitCode: cardinal;
begin
  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;


	//Console application create ediliyor
    if CreateProcess(nil      ,PChar(DosApp),
                     @Security,@Security,
                     true     ,CREATE_NO_WINDOW or NORMAL_PRIORITY_CLASS,
                     nil      ,nil,
                     start    ,ProcessInfo) then
    begin
      n:=0;
      TotalBytesRead:=0;
      repeat

        Inc(n,1);

        Apprunning := WaitForSingleObject(ProcessInfo.hProcess,100);
        Application.ProcessMessages;

        if not PeekNamedPipe(ReadPipe        ,@Buffer[TotalBytesRead],
                             ReadBuffer      ,@BytesRead,
                             @TotalBytesAvail,@BytesLeftThisMessage) then break
        else if BytesRead > 0 then
          ReadFile(ReadPipe,Buffer[TotalBytesRead],BytesRead,BytesRead,nil);
        TotalBytesRead:=TotalBytesRead+BytesRead;

        Buffer[TotalBytesRead]:= #0;
        OemToChar(Buffer,Buffer);
        AMemo.Text := StrPas(Buffer);

      until (Apprunning <> WAIT_TIMEOUT) or (n > 100); //n yerine zaman kontrolü de yapılabilir program kapanmıyorsa kapatmak için koyulmuştur
      //until (Apprunning <> WAIT_TIMEOUT) //n kullanılmayabilir o zaman termişnate process i de kaldırmak lazım

	
      if n > 100 then
        TerminateProcess(ProcessInfo.hProcess, terminateProcessExitCode);

      Buffer[TotalBytesRead]:= #0;
      OemToChar(Buffer,Buffer);
      AMemo.Text := AMemo.text + StrPas(Buffer);
    end;
    FreeMem(Buffer);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ReadPipe);
    CloseHandle(WritePipe);
  end;
end;