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

Откуда:
Сообщений: 25
Повторюсь, что сей зависон возникает не со всеми консольными приложениями, но как-то связан с их выводом.

Друзья, кто может удаленно помочь - напишите, пжалста, в телегу @khudiakov_s
Моя благодарность не будет иметь границ)) Сил уже нет...
19 ноя 20, 11:24    [22235166]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
segor
Member

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


Извиняюсь, выше неверно указал кусок кода.
Тут зависает:
               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);
19 ноя 20, 11:27    [22235176]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
segor
Member

Откуда:
Сообщений: 25
wadman
segor
пропущено...


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

Жесть... А если прочитается ровно столько сколько в буфере максимум? Что будет с последним байтом?


Там будет последний прочитанный байт. Разве нет?
19 ноя 20, 11:29    [22235179]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
wadman
Member

Откуда: Санкт-Петербург
Сообщений: 26836
segor
wadman
пропущено...

Жесть... А если прочитается ровно столько сколько в буфере максимум? Что будет с последним байтом?


Там будет последний прочитанный байт. Разве нет?


Кроик Семён
Buffer := AllocMem(READ_BUFFER_SIZE+1);

Отставить панику. Это моя невнимательность. Всё нормально. :)
19 ноя 20, 11:31    [22235181]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
wadman
Member

Откуда: Санкт-Петербург
Сообщений: 26836
segor
Извиняюсь, выше неверно указал кусок кода.
Тут зависает:

Там чуть выше есть комментарий:
Кроик Семён
//WARNING: if the console app never writes anything to the StdOutput, then ReadFile will block and never return
19 ноя 20, 11:33    [22235183]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
segor
Member

Откуда:
Сообщений: 25
wadman
segor
Извиняюсь, выше неверно указал кусок кода.
Тут зависает:

Там чуть выше есть комментарий:
Кроик Семён
//WARNING: if the console app never writes anything to the StdOutput, then ReadFile will block and never return


Но подвисает как раз когда есть вывод(
19 ноя 20, 11:39    [22235188]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
Kazantsev Alexey
Member

Откуда:
Сообщений: 4724
segor
Друзья, кто может удаленно помочь - напишите, пжалста, в телегу @khudiakov_s
Моя благодарность не будет иметь границ)) Сил уже нет...


Ты готовое решение пробовал? https://www.sql.ru/forum/actualutils.aspx?action=gotomsg&tid=1330938&msg=22233231
19 ноя 20, 11:45    [22235196]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
Zelius
Member

Откуда: Россия, Москва
Сообщений: 1475
segor,

посмотри здесь, не зависает, передает данные на вход, вычитывает все что передано обратно...

Перенаправление вывода в файл
19 ноя 20, 11:45    [22235197]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
alekcvp
Member

Откуда:
Сообщений: 2494
У меня как-то так сделано, ничего не подвисает:

  procedure ProcessFlow(hProcess, hReadPipe: THandle);
  const
    BUFFER_SIZE = 1024;
  var
    BytesAvail: Cardinal;
    BytesRead: Cardinal;
    Buffer: array [0..BUFFER_SIZE - 1] of AnsiChar;
    dwWait: Cardinal;
  begin
    repeat
      dwWait := WaitForSingleObject(hProcess, 100);
      WinAPICheck(PeekNamedPipe(hReadPipe, nil, 0, nil, @BytesAvail, nil), 'PeekNamedPipe');
      while BytesAvail > 0 do
      begin
        WinAPICheck(
          ReadFile(hReadPipe, @Buffer[0], Min(BytesAvail, BUFFER_SIZE), @BytesRead, nil), 'ReadFile');
        if BytesRead = 0 then Break; // что-то пошло не так
        Dec(BytesAvail, BytesRead);
//        OemToCharBuffA(@Buffer[0], @Buffer[0], BytesRead);
        Обрабатываем Buffer
      end;
    until dwWait <> WAIT_TIMEOUT;
  end;

P.S: Повырезал всё лишнее.

Сообщение было отредактировано: 19 ноя 20, 11:46
19 ноя 20, 11:50    [22235202]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
YuRock
Member

Откуда: Донецк
Сообщений: 4339
wadman
Всё нормально
Ну я б не сказал.
Если ReadFile начнет возвращать False, или размер прочитанного окажется меньше ожидаемого - будет вечный цикл.
Каша-алгоритм это, а не всё нормально. Надежда только на везение.

Сообщение было отредактировано: 19 ноя 20, 11:55
19 ноя 20, 12:00    [22235207]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
segor
Member

Откуда:
Сообщений: 25
Kazantsev Alexey
segor
Друзья, кто может удаленно помочь - напишите, пжалста, в телегу @khudiakov_s
Моя благодарность не будет иметь границ)) Сил уже нет...


Ты готовое решение пробовал? https://www.sql.ru/forum/actualutils.aspx?action=gotomsg&tid=1330938&msg=22233231


Я его не осилил( Не хватает знаниев. Не компилируется.
19 ноя 20, 12:07    [22235211]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
Kazantsev Alexey
Member

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

Какая у тебя версия Delphi?
19 ноя 20, 12:49    [22235247]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
segor
Member

Откуда:
Сообщений: 25
Kazantsev Alexey
segor,

Какая у тебя версия Delphi?


10.3
19 ноя 20, 13:25    [22235285]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
Dimitry Sibiryakov
Member

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

segor
Я его не осилил( Не хватает знаниев. Не компилируется.

Ну так прокачивай знания пока не осилишь.

Posted via ActualForum NNTP Server 1.5

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

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

+ Упрощённый ExecuteProcess
program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Windows;

//
Function ExecuteProcess(Const AExecutable, ACommandLine, ACurrentDir : String; ACodePage : Word = CP_OEMCP) : String;
Const

 CP_UTF16_LE = 1200;

Var

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

Begin

 Result := '';

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

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

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

 Try

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

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

  //
  ZeroMemory(@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;

    While ReadFile(RPipe, Buffer, SizeOf(Buffer), Count, NIL) And (Count > 0) Do
     Begin

      SetLength(AccBuffer, Length(AccBuffer) + Integer(Count));
      Move(Buffer, AccBuffer[Length(AccBuffer) - Integer(Count) + 1], Count);

     End;

    If ACodePage = CP_UTF16_LE Then
     Begin

      SetLength(Result, Length(AccBuffer) Div SizeOf(WideChar));
      Move(Pointer(AccBuffer)^, Pointer(Result)^, Length(Result) * SizeOf(WideChar));

     End
    Else
     Begin

      SetCodePage(AccBuffer, ACodePage, False);

      Result := String(AccBuffer);

     End;

   Finally

    WaitForSingleObject(PA.hProcess, INFINITE);

    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;
//

var
 s : string;
begin

 WriteLn(ExecuteProcess('C:\Program Files (x86)\Embarcadero\Studio\20.0\bin\dcc32.exe', '', ''));

 s := ExecuteProcess('c:\windows\system32\cmd.exe', '/U /C dir', 'c:\', 1200);
 MessageBox(0, PChar(s), 'cmd', MB_ICONINFORMATION or MB_OK);

end.
19 ноя 20, 13:39    [22235303]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
Fr0sT-Brutal
Member

Откуда:
Сообщений: 459
Да возьмите у джедаев и все
19 ноя 20, 18:09    [22235599]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
makhaon
Member

Откуда: A galaxy far far away
Сообщений: 3731
возьмите готовое и многократно опробованное решение в жедаях. так вам нравится ковыряться в велосипедах, которые уже лет 20 как отлично решены
19 ноя 20, 18:58    [22235643]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
segor
Member

Откуда:
Сообщений: 25
Спасибо. Покурим с джедаями)
19 ноя 20, 19:34    [22235659]     Ответить | Цитировать Сообщить модератору
 Re: После выполнения CreateProcess зависаем на WaitForSingleObject  [new]
segor
Member

Откуда:
Сообщений: 25
Kazantsev Alexey
segor,

+ Упрощённый ExecuteProcess
program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Windows;

//
Function ExecuteProcess(Const AExecutable, ACommandLine, ACurrentDir : String; ACodePage : Word = CP_OEMCP) : String;
Const

 CP_UTF16_LE = 1200;

Var

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

Begin

 Result := '';

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

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

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

 Try

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

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

  //
  ZeroMemory(@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;

    While ReadFile(RPipe, Buffer, SizeOf(Buffer), Count, NIL) And (Count > 0) Do
     Begin

      SetLength(AccBuffer, Length(AccBuffer) + Integer(Count));
      Move(Buffer, AccBuffer[Length(AccBuffer) - Integer(Count) + 1], Count);

     End;

    If ACodePage = CP_UTF16_LE Then
     Begin

      SetLength(Result, Length(AccBuffer) Div SizeOf(WideChar));
      Move(Pointer(AccBuffer)^, Pointer(Result)^, Length(Result) * SizeOf(WideChar));

     End
    Else
     Begin

      SetCodePage(AccBuffer, ACodePage, False);

      Result := String(AccBuffer);

     End;

   Finally

    WaitForSingleObject(PA.hProcess, INFINITE);

    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;
//

var
 s : string;
begin

 WriteLn(ExecuteProcess('C:\Program Files (x86)\Embarcadero\Studio\20.0\bin\dcc32.exe', '', ''));

 s := ExecuteProcess('c:\windows\system32\cmd.exe', '/U /C dir', 'c:\', 1200);
 MessageBox(0, PChar(s), 'cmd', MB_ICONINFORMATION or MB_OK);

end.


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

Откуда: A galaxy far far away
Сообщений: 3731
segor
Спасибо. Покурим с джедаями)

Что бы долго не искать:
https://github.com/project-jedi/jcl/blob/9d89903a2ee38fa72be47df433c46c7747ba4025/jcl/source/common/JclSysUtils.pas#L501

Сообщение было отредактировано: 20 ноя 20, 10:46
20 ноя 20, 10:48    [22235899]     Ответить | Цитировать Сообщить модератору
Топик располагается на нескольких страницах: 1 2      [все]
Все форумы / Delphi Ответить