Вопрос по ConsoleWindowClass

[flug]

Уважаемые специалисты по WinApi, подскажите пожалуйста можно ли из консольного окна получить текст? Дело в том что нужная мне программа выводит в самом конце консольного окна процент выполнения задачи, и мне хотелось бы получить эти цифры (пусть даже в виде текста) чтобы в своей программе отображать по ним прогресс бар.
Заранее спасибо.

[Stilet]

Ну один из способов это перенаправит вывод из консоли в файл или pipe.
Поищи тут примеры с функцией ExecConsoleApp
Так же на Delphi World есть пример перенаправления и работы с консолью.

[flug]

Stilet Спасибо что откликнулся!
Только я обрадовался, что нашёл ответ, но не тут то было
Всё дело в том что код который я привожу ниже выводит в memo нужную мне информацию лишь когда запущенная программа завершает свою работу, может кто знает как сделать чтобы информация заносилась в тот же memo хотя бы раз в секунду, или по мере поступления.

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;

 { Если вы хотите запустить процесс без параметров, заnil`те второй параметр
   и используйте первый
 }
 Res := CreateProcess(nil, pchar(CommandLine), nil, nil, true,
                CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, @env, nil, si, pi);

 // Если не получилось - то выходим
 if not Res then
 begin
   CloseHandle(hPipeOutputRead);
   CloseHandle(hPipeOutputWrite);
   CloseHandle(hPipeErrorsRead);
   CloseHandle(hPipeErrorsWrite);
   Exit;
 end;
 CloseHandle(hPipeOutputWrite);
 CloseHandle(hPipeErrorsWrite);

 //Читаем вывод
 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;

 //Вывод о ошибках
 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;


 Пример использования:procedure TForm1.Button1Click(Sender: TObject);
var OutP : TStringList;
    ErrorP: TStringList;
begin
 OutP := TStringList.Create;
 ErrorP := TstringList.Create;

 ExecConsoleApp('ping localhost', OutP, ErrorP);
//ExecConsoleApp('dir', OutP, ErrorP);

 Memo1.Lines.Assign(OutP);

 OutP.Free;
 ErrorP.Free;
end;

[ultrakiller]

есть ответ, но есть одна проблема с кодировкой вывода он в квадратики выводит (код для Delphi 2009), помогите с проблемой

procedure TForm1.RunDosInMemo(CmdLine:String;AMemo:TMemo);
const
   ReadBuffer = 2400;
var
  Security        : TSecurityAttributes;
  ReadPipe,WritePipe  : THandle;
  start           : TStartUpInfo;
  ProcessInfo     : TProcessInformation;
  Buffer          : PChar;
  BytesRead       : DWord;
  Apprunning      : DWord;
  WasOK           : Boolean;
begin
  Screen.Cursor:=CrHourGlass;

  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,
          PWChar(WideString(CmdLine)),
          nil,//@Security,
          nil,//@Security,
          true,
          NORMAL_PRIORITY_CLASS,
          nil,
          nil,
          start,
          ProcessInfo)
         then
      begin
        CloseHandle(WritePipe);
        Apprunning := WaitForSingleObject (ProcessInfo.hProcess,100);

        try
          repeat
            WasOK:=ReadFile(ReadPipe,Buffer[0], ReadBuffer,BytesRead,nil);
            Buffer[BytesRead]:= #0;
            OemToAnsi(pAnsiChar(Buffer),PAnsiChar(Buffer));
            AMemo.Text := AMemo.text + String(Buffer);

            Application.ProcessMessages;
          until (not WasOK) or ( BytesRead = 0 );
        finally
          CloseHandle(ProcessInfo.hProcess);
          CloseHandle(ProcessInfo.hThread);
        end;
    end;

    FreeMem(Buffer);
    CloseHandle(ReadPipe);
  end;
  Screen.Cursor:=CrDefault;

end;


procedure TForm1.Button1Click(Sender: TObject);
begin
 Memo1.Clear;
 RunDosInMemo('ping 10.1.0.115',Memo1);
end;

end.

[PekopT]

ясное дело что проблема в кодировке.

 try
          repeat
            WasOK:=ReadFile(ReadPipe,Buffer[0], ReadBuffer,BytesRead,nil);
            Buffer[BytesRead]:= #0;
            OemToAnsi(pAnsiChar(Buffer),PAnsiChar(Buffer));
            AMemo.Text := AMemo.text + PAnsiChar(String(Buffer));

[ultrakiller]

Спасибо за исправление.. помогло частично. проблема вот такая выявилась
на команду ping 10.1.0.115 он выдает

Обмен пакетами с 10.1.0.115 по 32 байт:


Ответ от 10.1.0.115: число байт=32 время<1мс TTL=127

Ответ от 10.1.0.115: 0.1.0.115 яю 32 срщЄ:число байт=32 время<1мс TTL=127

32 ёЁ•к:Ответ от 10.1.0.115: ьё TTL=127

32 ¬иХъ:число байт=32 время<1мс TTL=127

32 мш-·:Ответ от 10.1.0.115: ьё TTL=127

32 ь°-¬:число байт=32 время<1мс TTL=127



Статистика Ping для 10.1.0.115:

    Пакетов: отправлено = 4, получено = 4, потеряно = 0 (0% потерь),

Приблизительное время приема-передачи в мс:

    Минимальное = 0мсек, Максимальное = 0 мсек, Среднее = 0 мсек

От куда то мусор берется, левый,
И еще вопрос:

dsadd user "CN=YashinaEA,OU=test,DC=test" -ln "Яшина" -fn "Екатерина" -mi "А" -upn "YashinaEA@test" -pwd "12345" 
-display "Яшина Екатерина А" -desc "Кафедра 200807571" -dept "32" -office "ФСПиП" -tel "ФСПиП" -email "ФСПиП" -hometel "ФСПиП" 
-mobile " ФСПиП" -title "ФСПиП" -hmdir "\\Share\YashinaEA" -hmdrv s: -canchpwd yes -pwdneverexpires yes 
-profile "\\DS\Profiles\YashinaEA"

Ответа вообще никакого нет, в чем может быть глюк