Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Delphi Новый топик    Ответить
Топик располагается на нескольких страницах: [1] 2   вперед  Ctrl      все
 После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
segor
Member

Откуда:
Сообщений: 25
Всем привет!
Подскажите, пожалуйста:

Необходимо выполнять консольное приложение и получить его вывод.

Нашел такой код:

function Run_Dos(CmdLine: string) : string;
const
  ReadBuffer = 255;
var
  Security: TSecurityAttributes;
  ReadPipe, WritePipe: THandle;
  start: TStartUpInfo;
  ProcessInfo: TProcessInformation;
  Buffer: array [0 .. 255] of AnsiChar;
  BytesRead: DWord;
  Apprunning: DWord;
begin
 
  with Security do
  begin
    nlength := SizeOf(TSecurityAttributes);
    binherithandle := true;
    lpsecuritydescriptor := nil;
  end;
  if Createpipe(ReadPipe, WritePipe,
    @Security, 0) then
  begin
    result := '';
 
    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
 
//     Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 10000);
     Apprunning := WaitForSingleObject(ProcessInfo.hProcess, infinite);
 
 
    //перед чтением из пайпа закрыть один конец
     CloseHandle(WritePipe);
 
      repeat
        ReadFile(ReadPipe, Buffer, ReadBuffer, BytesRead, nil);
        Buffer[BytesRead] := #0;
        result := result + Buffer;
 
 
      until (BytesRead < ReadBuffer);
    end;
 
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ReadPipe);
  end;
 
end;


Но, к сожалению, он не со всеми приложениями работает корректно. Выполнение некоторых консольных приложений привод к зависанию вот в этом месте:

     Apprunning := WaitForSingleObject(ProcessInfo.hProcess, infinite);


(в диспетчере задач видим незавершенный процесс запущенного консольного приложения)

Если это же консольное приложение выполнять из командной строки - то все выполняется корректно (выводит результаты в консоль и завершается).

Что в коде не так?

Сообщение было отредактировано: 16 ноя 20, 17:31
16 ноя 20, 17:32    [22233157]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
Kazantsev Alexey
Member

Откуда:
Сообщений: 4724
segor
Выполнение некоторых консольных приложений привод к зависанию вот в этом месте

Перенеси эту строчку после цикла чтения из пайпа.
16 ноя 20, 17:49    [22233173]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
Dimitry Sibiryakov
Member

Откуда:
Сообщений: 51775

segor
Что в коде не так?

В коде много чего неправильно. Изучай оригинал:
https://docs.microsoft.com/en-us/windows/win32/ProcThread/creating-a-child-process-with-redirected-input-and-output

Posted via ActualForum NNTP Server 1.5

16 ноя 20, 17:57    [22233185]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
segor
Member

Откуда:
Сообщений: 25
Kazantsev Alexey
segor
Выполнение некоторых консольных приложений привод к зависанию вот в этом месте

Перенеси эту строчку после цикла чтения из пайпа.


Перенес. Все равно на ней виснет.
16 ноя 20, 17:58    [22233187]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 12319
Kazantsev Alexey
Перенеси эту строчку после цикла чтения из пайпа.
Зачем? Сейчас все логично: ждем пока процесс не завершится, а потом выгребаем все из пайпа. А так, если дочерний процесс задумается перед выводом, то мы проскочим цикл и будем в тупую ждать завершения
16 ноя 20, 18:20    [22233200]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 12319
segor
Если это же консольное приложение выполнять из командной строки - то все выполняется корректно (выводит результаты в консоль и завершается).
Значит в чем-то отличие. Например в параметрах командной строки.

Сделайте
start.wShowWindow := SW_SHOW;
и посмотрите, что ждет приложение

Далее, поверьте, вот это
segor
start.hStdInput := ReadPipe;
вам не нужно
А вот эти две строки
segor
//     Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 10000);
     Apprunning := WaitForSingleObject(ProcessInfo.hProcess, infinite);
    //перед чтением из пайпа закрыть один конец
     CloseHandle(WritePipe);
логично будет поменять местами
16 ноя 20, 18:29    [22233212]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
Dimitry Sibiryakov
Member

Откуда:
Сообщений: 51775

_Vasilisk_
Сейчас все логично: ждем пока процесс не завершится, а потом выгребаем все из пайпа.

Ага, но перед этим сделали с вызываемым процессом грязный трюк, описанный в одном
бородатом анекдоте фразой "а теперь циркулируй".

Posted via ActualForum NNTP Server 1.5

16 ноя 20, 18:39    [22233222]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
Kazantsev Alexey
Member

Откуда:
Сообщений: 4724
segor
Перенес. Все равно на ней виснет.

У тебя ещё условие цикла некорректное. Чтение может вернуть меньше, чем ты просишь, но это не повод прерывать цикл.

_Vasilisk_
Сейчас все логично: ждем пока процесс не завершится, а потом выгребаем все из пайпа.

А буфер пайпа у тебя бесконечный?
16 ноя 20, 18:43    [22233224]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
segor
Member

Откуда:
Сообщений: 25
_Vasilisk_
segor
Если это же консольное приложение выполнять из командной строки - то все выполняется корректно (выводит результаты в консоль и завершается).
Значит в чем-то отличие. Например в параметрах командной строки.

Сделайте
start.wShowWindow := SW_SHOW;
и посмотрите, что ждет приложение

Далее, поверьте, вот это
segor
start.hStdInput := ReadPipe;
вам не нужно
А вот эти две строки
segor
//     Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 10000);
     Apprunning := WaitForSingleObject(ProcessInfo.hProcess, infinite);
    //перед чтением из пайпа закрыть один конец
     CloseHandle(WritePipe);
логично будет поменять местами


Сделал.
Появляется консольное окно. В нем мигает курсор. Вывода нет.
Тут все так же виснем WaitForSingleObject
16 ноя 20, 18:50    [22233229]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
Kazantsev Alexey
Member

Откуда:
Сообщений: 4724
+ ExecuteProcess

//
Function ExecuteProcess(Const AExecutable, ACommandLine, ACurrentDir : String; AOnOutputDataProc : TOnOutputDataProc; ATimeoutInterval : DWORD; ATimeoutExitCode : DWORD) : LongWord;
Var

 RPipe  : THandle;
 WPipe  : THandle;
 SA     : TSecurityAttributes;
 SI     : TStartupInfo;
 PA     : TProcessInformation;
 Buffer : Array [0 .. 128 - 1] Of Byte;
 Count  : Cardinal;

Begin

 Result := 0;

 //
 ZeroMem(@SA, SizeOf(SA));

 SA.nLength              := SizeOf(SA);
 SA.lpSecurityDescriptor := NIL;
 SA.bInheritHandle       := True;
 //

 If Not Assigned(AOnOutputDataProc) Then
  Begin

   RPipe := INVALID_HANDLE_VALUE;
   WPipe := INVALID_HANDLE_VALUE;

  End
 Else
  If Not CreatePipe(RPipe, WPipe, @SA, 0) Then
   RaiseLastOSError;

 Try

  //
  ZeroMem(@SI, SizeOf(SI));

  SI.cb          := SizeOf(SI);
  SI.hStdOutput  := WPipe;
  SI.hStdError   := WPipe;
  SI.dwFlags     := STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW;
  SI.wShowWindow := SW_HIDE;
  //

  //
  ZeroMem(@PA, SizeOf(PA));
  //

  If CreateProcess(PChar(AExecutable), PChar(ACommandLine), NIL, NIL, True, 0, NIL, PChar(Pointer(ACurrentDir)), SI, PA) Then
   Try

    If WPipe <> INVALID_HANDLE_VALUE Then
     Begin

      CloseHandle(WPipe);

      WPipe := INVALID_HANDLE_VALUE;

     End;

    If ATimeoutInterval <> INFINITE Then
     TWatchdogThread.Create(PA.hProcess, ATimeoutInterval, ATimeoutExitCode);

    If Assigned(AOnOutputDataProc) Then
     While ReadFile(RPipe, Buffer, SizeOf(Buffer), Count, NIL) And (Count > 0) Do
      AOnOutputDataProc(Buffer, Count);

   Finally

    WaitForSingleObject(PA.hProcess, INFINITE);

    If Not GetExitCodeProcess(PA.hProcess, Result) Then
     RaiseLastOSError;

    CloseHandle(PA.hThread);
    CloseHandle(PA.hProcess);

   End
  Else
   RaiseLastOSError;

 Finally

  If RPipe <> INVALID_HANDLE_VALUE Then
   CloseHandle(RPipe);

  If WPipe <> INVALID_HANDLE_VALUE Then
   CloseHandle(WPipe);

 End;

End;
//
16 ноя 20, 18:52    [22233231]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
bk0010
Member

Откуда:
Сообщений: 5001
segor
Если это же консольное приложение выполнять из командной строки - то все выполняется корректно (выводит результаты в консоль и завершается).
Точно завершается? Не пишет "Press any key"?
16 ноя 20, 18:52    [22233232]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
segor
Member

Откуда:
Сообщений: 25
Dimitry Sibiryakov

segor
Что в коде не так?

В коде много чего неправильно. Изучай оригинал:
https://docs.microsoft.com/en-us/windows/win32/ProcThread/creating-a-child-process-with-redirected-input-and-output


Ок, спасибо, будем изучать.
16 ноя 20, 18:53    [22233233]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
segor
Member

Откуда:
Сообщений: 25
bk0010
segor
Если это же консольное приложение выполнять из командной строки - то все выполняется корректно (выводит результаты в консоль и завершается).
Точно завершается? Не пишет "Press any key"?


Да точно. В диспетчере задач появляется после запуска и пропадает после завершения работы.
16 ноя 20, 18:54    [22233234]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 12319
segor
Появляется консольное окно. В нем мигает курсор. Вывода нет.
Логично, вы же весь вывод затягиваете к себе в программу.

Делайте так
segor
start.dwFlags := STARTF_USESHOWWINDOW;
и смотрите, чего не хватает процессу. А потом вернете флаг обратно
16 ноя 20, 19:11    [22233261]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
Dimitry Sibiryakov
Member

Откуда:
Сообщений: 51775

_Vasilisk_
Логично, вы же весь вывод затягиваете к себе в программу.

Нет. Присмотрись повнимательнее куда он засунул второй конец трубы.

Posted via ActualForum NNTP Server 1.5

16 ноя 20, 19:15    [22233268]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 12319
Dimitry Sibiryakov
Присмотрись повнимательнее куда он засунул второй конец трубы.
Это я уже говорил
_Vasilisk_
Далее, поверьте, вот это
segor
start.hStdInput := ReadPipe;
вам не нужно
Товарищ обещал исправить.

Ну и если программа не ожидает ввода, то это ни на что влиять не должно. А если ожидает, то код должен быть совершенно другим
16 ноя 20, 19:24    [22233282]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
segor
Member

Откуда:
Сообщений: 25
_Vasilisk_
segor
Появляется консольное окно. В нем мигает курсор. Вывода нет.
Логично, вы же весь вывод затягиваете к себе в программу.

Делайте так
segor
start.dwFlags := STARTF_USESHOWWINDOW;
и смотрите, чего не хватает процессу. А потом вернете флаг обратно


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


+ function Run_Dos
function Run_Dos(CmdLine: string) : string;
const
ReadBuffer = 255;
var
Security: TSecurityAttributes;
ReadPipe, WritePipe: THandle;
start: TStartUpInfo;
ProcessInfo: TProcessInformation;
Buffer: array [0 .. 255] of Char;
BytesRead: DWord;
Apprunning: DWord;
begin

with Security do
begin
nlength := SizeOf(TSecurityAttributes);
binherithandle := true;
lpsecuritydescriptor := nil;
end;
if Createpipe(ReadPipe, WritePipe,
@Security, 0) then
begin
result := '';

FillChar(Start, Sizeof(Start), #0);
start.cb := SizeOf(start);
start.hStdOutput := WritePipe;
// start.hStdInput := ReadPipe;

// start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
start.dwFlags := STARTF_USESHOWWINDOW;

// start.wShowWindow := SW_HIDE;
start.wShowWindow := SW_SHOW;


if CreateProcess(nil,
PChar(CmdLine),
@Security,
@Security,
true,
NORMAL_PRIORITY_CLASS,
nil,
nil,
start,
ProcessInfo) then
begin


//перед чтением из пайпа закрыть один конец
CloseHandle(WritePipe);

Apprunning := WaitForSingleObject(ProcessInfo.hProcess, infinite);




repeat
ReadFile(ReadPipe, Buffer, ReadBuffer, BytesRead, nil);
Buffer[BytesRead] := #0;
result := result + Buffer;


until (BytesRead < ReadBuffer);
end;


CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(ReadPipe);



end;

end;



Сообщение было отредактировано: 16 ноя 20, 19:26
16 ноя 20, 19:25    [22233284]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 12319
segor
Теперь вижу в консольном окне вывод приложения так, как было бы если запускал его из командой строки.
И приложение само завершается? Или ждет ввода от пользователя и только потом завершается?
16 ноя 20, 19:27    [22233286]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
segor
Member

Откуда:
Сообщений: 25
_Vasilisk_
segor
Теперь вижу в консольном окне вывод приложения так, как было бы если запускал его из командой строки.
И приложение само завершается? Или ждет ввода от пользователя и только потом завершается?


Само.
16 ноя 20, 19:28    [22233287]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 12319
segor
Само.
Я правильно понял, что если поставить
start.dwFlags := STARTF_USESHOWWINDOW;
то запущенное приложение завершается само и ваша программа не зависает? При этом в запущенном приложении вы не нажимаете никаких клавиш?
17 ноя 20, 15:19    [22233852]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
segor
Member

Откуда:
Сообщений: 25
_Vasilisk_
segor
Само.
Я правильно понял, что если поставить
start.dwFlags := STARTF_USESHOWWINDOW;
то запущенное приложение завершается само и ваша программа не зависает? При этом в запущенном приложении вы не нажимаете никаких клавиш?


Да, так и есть.
18 ноя 20, 10:46    [22234413]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
Кроик Семён
Member

Откуда: СПб --> Dortmund
Сообщений: 6656
segor,

попробуйте этот код

//Based on RunDosInMemo() from
//   https://stackoverflow.com/questions/9119999

procedure ExecAppAndGetOutput(const ACmdStr: string; AOutput: TStrings;
  AAsync: boolean = false);
const
   READ_BUFFER_SIZE = 2400;
var
   sCmdStr  : string;
   Security: TSecurityAttributes;
   readableEndOfPipe, writeableEndOfPipe: THandle;
   start: TStartUpInfo;
   ProcessInfo: TProcessInformation;
   Buffer: PAnsiChar;
   BytesRead: DWORD;
   AppRunning: DWORD;
begin
   sCmdStr := ACmdStr;

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

   if CreatePipe({var}readableEndOfPipe, {var}writeableEndOfPipe, @Security, 0) then
   begin
      Buffer := AllocMem(READ_BUFFER_SIZE+1);
      try
         FillChar(Start, Sizeof(Start), #0);
         start.cb := SizeOf(start);

         // Set up members of the STARTUPINFO structure.
         // This structure specifies the STDIN and STDOUT handles for redirection.
         // - Redirect the output and error to the writeable end of our pipe.
         // - We must still supply a valid StdInput handle (because we used STARTF_USESTDHANDLES to swear that all three handles will be valid)
         start.dwFlags := start.dwFlags or STARTF_USESTDHANDLES;
         start.hStdInput := GetStdHandle(STD_INPUT_HANDLE); //we're not redirecting stdInput; but we still have to give it a valid handle
         start.hStdOutput := writeableEndOfPipe; //we give the writeable end of the pipe to the child process; we read from the readable end
         start.hStdError := writeableEndOfPipe;

         //We can also choose to say that the wShowWindow member contains a value.
         //In our case we want to force the console window to be hidden.
         start.dwFlags := start.dwFlags + STARTF_USESHOWWINDOW;
         start.wShowWindow := SW_HIDE;

         // Don't forget to set up members of the PROCESS_INFORMATION structure.
         //--- ProcessInfo := Default(TProcessInformation);
         FillChar(ProcessInfo, SizeOf(ProcessInfo), 0);


         //WARNING: The unicode version of CreateProcess (CreateProcessW) can modify the command-line "DosApp" string.
         //Therefore "DosApp" cannot be a pointer to read-only memory, or an ACCESS_VIOLATION will occur.
         //We can ensure it's not read-only with the RTL function: UniqueString
         UniqueString({var}sCmdStr);

         try
            if CreateProcess(nil, PChar(sCmdStr), nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil, start, {var}ProcessInfo) then
            begin
               //Wait for the application to terminate, as it writes it's output to the pipe.
               //WARNING: If the console app outputs more than 2400 bytes (ReadBuffer),
               //it will block on writing to the pipe and *never* close.
               repeat
                  Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 100);
                  if AAsync then Application.ProcessMessages();
               until (Apprunning <> WAIT_TIMEOUT);

               //Read the contents of the pipe out of the readable end
               //WARNING: if the console app never writes anything to the StdOutput, then ReadFile will block and never return
               repeat
                  BytesRead := 0;
                  ReadFile(readableEndOfPipe, Buffer[0], READ_BUFFER_SIZE, {var}BytesRead, nil);
                  Buffer[BytesRead]:= #0;
                  OemToAnsi(Buffer,Buffer);
                  AOutput.Text := AOutput.Text + String(Buffer);
               until (BytesRead < READ_BUFFER_SIZE);
            end;
         finally
            CloseHandle(ProcessInfo.hProcess);
            CloseHandle(ProcessInfo.hThread);
            CloseHandle(readableEndOfPipe);
            CloseHandle(writeableEndOfPipe);
         end;
      finally
         FreeMem(Buffer);
      end;
   end; //if CreatePipe
end;


Сообщение было отредактировано: 18 ноя 20, 11:17
18 ноя 20, 11:16    [22234430]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
_Vasilisk_
Member

Откуда: Украина, Харьков
Сообщений: 12319
    start.hStdOutput := WritePipe;
    start.hStdInput := INVALID_HANDLE_VALUE;
 
    start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
 


Сообщение было отредактировано: 18 ноя 20, 12:59
18 ноя 20, 13:04    [22234532]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
segor
Member

Откуда:
Сообщений: 25
Кроик Семён
segor,

попробуйте этот код



Попробовал.
Зависает тут:
      repeat
        ReadFile(ReadPipe, Buffer, ReadBuffer, BytesRead, nil);
        Buffer[BytesRead] := #0;
        result := result + Buffer;
 
 
      until (BytesRead < ReadBuffer);
19 ноя 20, 10:33    [22235128]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
wadman
Member

Откуда: Санкт-Петербург
Сообщений: 26836
segor
Кроик Семён
segor,

попробуйте этот код



Попробовал.
Зависает тут:
      repeat
        ReadFile(ReadPipe, Buffer, ReadBuffer, BytesRead, nil);
        Buffer[BytesRead] := #0;
        result := result + Buffer;
 
 
      until (BytesRead < ReadBuffer);

Жесть... А если прочитается ровно столько сколько в буфере максимум? Что будет с последним байтом?
19 ноя 20, 10:57    [22235147]     Ответить | Цитировать Сообщить модератору
Топик располагается на нескольких страницах: [1] 2   вперед  Ctrl      все
Все форумы / Delphi Ответить