[Agat330]

Есть вот такой код:

Код:

function TForm1.RunCmd(CommandLine: string): boolean;
type
  OEMString = type AnsiString(CP_OEMCP);

var
  I, dwAvail: byte;
  OEMStr: OEMString;
  U: UnicodeString;
  Flag: boolean;
  tRead, cWrite: THandle;
  dwRead: cardinal;
  SA: TSecurityAttributes;
  PI: TProcessInformation;
  SI: TStartupInfo;

begin
  Result:=False;

  SA.nLength:=SizeOf(SECURITY_ATTRIBUTES);
  SA.bInheritHandle:=True;
  SA.lpSecurityDescriptor:=nil;

  if not CreatePipe(tRead, cWrite, @SA, 0) then Exit;

  ZeroMemory(@SI, SizeOf(TStartupInfo));

  SI.cb:=SizeOf(TStartupInfo);
  SI.dwFlags:=STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  SI.wShowWindow:=SW_HIDE;
  SI.hStdOutput:=cWrite;

  if CreateProcess(nil,
                  PChar(CommandLine),
                  nil,
                  nil,
                  True,
                  0,
                  nil,
                  nil,
                  SI,
                  PI)
  then
  begin
      CloseHandle(PI.hProcess);
      CloseHandle(PI.hThread);
      CmdMemo.Clear;
      Flag:=True;

      while Flag do
      begin

         for I:=0 to 9 do
         begin
             PeekNamedPipe(tRead, nil, 0, nil, @dwAvail, nil);

             if dwAvail>0
             then
                 begin
                 Flag:=True;
                 Break;
                 end
             else Flag:=False;

             Sleep(100);
         end; //for I:=

         if dwAvail>0
         then
         begin
             SetLength(OEMStr, dwAvail);
             ReadFile(tRead, PChar(OEMStr)^, Length(OEMStr), dwRead, Nil);
             U := OEMStr;
             CmdMemo.Lines.Add(U);
             Application.ProcessMessages;
             Result:=True;
         end; // if dwAvail

      end;    // while Flag

  end;       // if CreateProcess
end;

При выполнении получается такая картинка: скрин на яндексе

То есть посередине пятой строки программа вешается. Понимаю, что где-то закрался косяк (и не один)), но не понимаю, где

p.s.: Delphi XE3

[Freeman]

Цикл какой-то странный. Разве пайп не генерирует обычных сообщений синхронизации, чтобы можно было пользоваться WaitForSingleObject?

[Agat330]

Ну, в пайпах я дуб, так что код не мой. Основная часть отсюда, плюс отсюда, как побороть кодировку. Чую, скоро совсем с миру по нитке прога будет

[Freeman]

Ха-ха, то-то же я смотрю, что код работы с OEM-кодировкой такой знакомый. Хоть кто-то на форуме поиском пользуется, и то радость.

[Agat330]

Так в чем ошибка?

[Agat330]

Блин, только обрадовался, что отозвались,.. и тишина...

[Agat330]

Снова здрасти! )) В общем, в том проекте год назад пришлось отказаться от примочек в консоли и пойти другим путем. Каким - уже не важно, это будет оффтоп. Прикол в том, что недавно мне снова пришлось писать прогу, в которой теперь уже точно нужен перехват вывода из консоли в Memo. В общем, у меня на XE-3 завелся код отсюда (ну, очень похоже на код, с которым я парился тогда)) с единственной правкой:
Var Buffer: PAnsiChar;

[Agat330]

Код:

procedure RunDosInMemo(CmdLine: string; AMemo: TMemo);
const
  ReadBuffer = 2400;
var
  Security: TSecurityAttributes;
  ReadPipe, WritePipe: THandle;
  start: TStartUpInfo;
  ProcessInfo: TProcessInformation;
  Buffer: PAnsiChar;
  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;

Снова всем здрасти!)) Как писал выше - у меня заработал этот код вот в этом виде. То есть если на вход процедуры я даю "ping ya.ru" и memo-объект - в мемо все отлично, яндекс пингуется. Но если любую из команд adb - (adb devices, например) программа виснет, приходится убивать процесс. Заранее скажу, что exe'шник программы я после компиляции копирую в папку, где находится adb.exe. Помогите понять, что не так делаю или идеями поделитесь...

[Bargest]

Посмотри под отладкой этот цикл. Может ADB ждет какого-то ввода или еще чего-нибудь. Еще ADB при старте пытается запустить свой daemon, может с этим какие-то косяки. Я с ADB код на C# делал, там все эти пайпы автоматом обрабатываются, но все равно обплевался - постоянно какие-то проблемы были с этим гугловым поделием.
А вообще, насколько я помню, ADB поддерживает работу через псевдосокеты. Можно один раз запустить его сервер, а потом слать команды на localhost.
Вот что-то типа документации (см. "II. Protocol details:"), а тут сами команды. Найти их непросто, мало кто это юзает, хотя имхо в миллион раз удобнее тупого перехвата и парсинга текста из консоли.

[Agat330]

Уау!!! Круто!!! Не знал, буду пробовать, спасибо)))
А "посмотри под отладкой цикл" - я дуб в отладке (((

[Bargest]

я дуб в отладке (((

Тогда учись, потому что без отладки время на разработку программ сложнее helloworld-ов будет увеличиваться в геометрической прогрессии по мере возрастания сложности.

[Agat330]

Bargest, подскажи литературу или сайты для начинающитх отладчиков

[Bargest]

Каких еще "начинающих отладчиков"? Просто берешь и отлаживаешь. По запросу "отладка delphi" выводятся тысячи статей. Там изучать-то нечего.