Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Низкоуровневое программирование > Win Api
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 05.04.2012, 12:34   #1
arxlex
Пользователь
 
Регистрация: 18.01.2012
Сообщений: 23
Сообщение Create Process без подвисаний

Кто скажет, как модифицировать эту фукцию, чтобы при ее использовании программа не подвисала. Как запустить её в новом потоке?
Код:
function ExecuteCommand(CmdLine: String; OutLine: TStrings): String;
const
  ReadBuffer = 2400;
var
  Buffer: PAnsichar;
  dwRead: DWord;
  dwExit: Cardinal;
  si: TStartUpInfo;
  sa: TSecurityAttributes;
  sd: PSecurityDescriptor;
  pi: TProcessInformation;
  newstdout, read_stdout: THandle;
  osv: TOSVersionInfo;

begin
  newstdout := 0;
  read_stdout := 0;
  si.cb := SizeOf(si);
  FillChar(si, SizeOf(si), #0);
  sa.nlength := SizeOf(TSecurityAttributes);

  GetVersionEx(osv);

  if (osv.dwPlatformId = VER_PLATFORM_WIN32_NT) then
  begin
    InitializeSecurityDescriptor(sd, SECURITY_DESCRIPTOR_REVISION);
    SetSecurityDescriptorDacl(sd, true, nil, false);
    sa.lpsecuritydescriptor := sd;
  end
  else
    sa.lpsecuritydescriptor := nil;

  sa.binherithandle := true;

  // Create pipe
  if not(CreatePipe(read_stdout, newstdout, @sa, 0)) then
  begin
    if Application.MessageBox('There was an error creating the pipe.', 'Error...', MB_OK + MB_ICONERROR) = IDOK then
      Result := '';
    Exit;
  end;

  GetStartupInfo(si);
  si.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
  si.wShowWindow := SW_HIDE;
  si.hStdOutput := newstdout;
  si.hStdInput := read_stdout;
  si.hStdError := newstdout;

  // Create Process for Inno Setup Unpacker
  if not(CreateProcess(nil, PChar(CmdLine), nil, nil, true, NORMAL_PRIORITY_CLASS, nil, nil, si, pi)) then
  begin
    if Application.MessageBox('Could not Create Process', 'Error...', MB_OK + MB_ICONERROR) = IDOK then
    begin
      CloseHandle(newstdout);
      CloseHandle(read_stdout);
      Result := '';
      Exit;
    end;
  end;

  Buffer := AllocMem(ReadBuffer + 1);
  dwRead := 1;
  dwExit := STILL_ACTIVE;

  while ((dwExit = STILL_ACTIVE) or (dwRead > 0)) do
  begin
    PeekNamedPipe(read_stdout, nil, 0, nil, @dwRead, nil);

    if (dwRead > 0) then
    begin
      ReadFile(read_stdout, Buffer[0], ReadBuffer, dwRead, nil);
      Buffer[dwRead] := #0;
      OemToAnsi(Buffer, Buffer);
      OutLine.Text := Buffer;
    end
    else
      Sleep(100);

    GetExitCodeProcess(pi.hProcess, dwExit);

    // Make sure we have no data before killing getting out of the loop
    if (dwExit <> STILL_ACTIVE) then
      PeekNamedPipe(read_stdout, nil, 0, nil, @dwRead, nil);

  end;

  if (Pos('Error', OutLine.Text) <> 0) Or (Pos('corrupted', OutLine.Text) <> 0) then
  begin
    if Application.MessageBox(PChar(OutLine), 'Error...', MB_OK + MB_ICONERROR) = IDOK then
    begin
      OutLine.Text := '';
      FreeMem(Buffer);
      CloseHandle(pi.hProcess);
      CloseHandle(pi.hThread);
      CloseHandle(read_stdout);
      CloseHandle(newstdout);
      Result := '';
      Exit;
    end;
  end;
  FreeMem(Buffer);
  CloseHandle(pi.hProcess);
  CloseHandle(pi.hThread);
  CloseHandle(read_stdout);
  CloseHandle(newstdout);
  Result := OutLine.Text;
end;
Mess With the Best, Die Like the Rest
arxlex вне форума Ответить с цитированием
Старый 05.04.2012, 12:56   #2
Alex11223
Старожил
 
Аватар для Alex11223
 
Регистрация: 12.01.2011
Сообщений: 19,500
По умолчанию

Цитата:
Как запустить её в новом потоке?
TThread
www.google.ru
http://forum.vingrad.ru/topic-60076.html
Ушел с форума, https://www.programmersforum.rocks, alex.pantec@gmail.com, https://github.com/AlexP11223
ЛС отключены Аларом.
Alex11223 вне форума Ответить с цитированием
Старый 05.04.2012, 15:40   #3
Пепел Феникса
Старожил
 
Аватар для Пепел Феникса
 
Регистрация: 28.01.2009
Сообщений: 21,000
По умолчанию

ТС, у вас тормозит то не CreateProcess.
Хорошо поставленный вопрос это уже половина ответа. | Каков вопрос, таков ответ.
Программа делает то что написал программист, а не то что он хотел.
Функции/утилиты ждут в параметрах то что им надо, а не то что вы хотите.
Пепел Феникса вне форума Ответить с цитированием
Старый 05.04.2012, 17:02   #4
arxlex
Пользователь
 
Регистрация: 18.01.2012
Сообщений: 23
По умолчанию

Цитата:
Сообщение от Пепел Феникса Посмотреть сообщение
ТС, у вас тормозит то не CreateProcess.
А от чего же? Может из-за:
Код:
ReadFile(read_stdout, Buffer[0], ReadBuffer, dwRead, nil);
Как сделать чтоб не тормозил при получении данных из внешнего источника?
Mess With the Best, Die Like the Rest
arxlex вне форума Ответить с цитированием
Старый 05.04.2012, 17:17   #5
Пепел Феникса
Старожил
 
Аватар для Пепел Феникса
 
Регистрация: 28.01.2009
Сообщений: 21,000
По умолчанию

вся процедура блокирующая в принципе то.

но попробуйте в цикл добавить
Код:
Application.ProcessMessages();
Хорошо поставленный вопрос это уже половина ответа. | Каков вопрос, таков ответ.
Программа делает то что написал программист, а не то что он хотел.
Функции/утилиты ждут в параметрах то что им надо, а не то что вы хотите.
Пепел Феникса вне форума Ответить с цитированием
Старый 06.04.2012, 04:38   #6
arxlex
Пользователь
 
Регистрация: 18.01.2012
Сообщений: 23
По умолчанию

Спасибо всем! Помогло!

Код:
function ExecuteCommand(CmdLine: String): String;
const
  ReadBuffer = 2400;
var
  Buffer: PAnsichar;
  dwRead: DWord;
  dwExit: Cardinal;
  si: TStartUpInfo;
  sa: TSecurityAttributes;
  sd: PSecurityDescriptor;
  pi: TProcessInformation;
  newstdout, read_stdout: THandle;
  osv: TOSVersionInfo;

begin
  newstdout := 0;
  read_stdout := 0;
  si.cb := SizeOf(si);
  FillChar(si, SizeOf(si), #0);
  sa.nlength := SizeOf(TSecurityAttributes);

  GetVersionEx(osv);

  if (osv.dwPlatformId = VER_PLATFORM_WIN32_NT) then
  begin
    InitializeSecurityDescriptor(sd, SECURITY_DESCRIPTOR_REVISION);
    SetSecurityDescriptorDacl(sd, true, nil, false);
    sa.lpsecuritydescriptor := sd;
  end
  else
    sa.lpsecuritydescriptor := nil;

  sa.binherithandle := true;

  // Create pipe
  if not(CreatePipe(read_stdout, newstdout, @sa, 0)) then
  begin
    if Application.MessageBox('There was an error creating the pipe.', 'Error...', MB_OK + MB_ICONERROR) = IDOK then
      Result := '';
    Exit;
  end;

  GetStartupInfo(si);
  si.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
  si.wShowWindow := SW_HIDE;
  si.hStdOutput := newstdout;
  si.hStdInput := read_stdout;
  si.hStdError := newstdout;

  // Create Process for Inno Setup Unpacker
  if not(CreateProcess(nil, PChar(CmdLine), nil, nil, true, NORMAL_PRIORITY_CLASS, nil, nil, si, pi)) then
  begin
    if Application.MessageBox('Could not Create Process', 'Error...', MB_OK + MB_ICONERROR) = IDOK then
    begin
      CloseHandle(newstdout);
      CloseHandle(read_stdout);
      Result := '';
      Exit;
    end;
  end;

  Buffer := AllocMem(ReadBuffer + 1);
  dwRead := 1;
  dwExit := STILL_ACTIVE;

  while ((dwExit = STILL_ACTIVE) or (dwRead > 0)) do
  begin
    PeekNamedPipe(read_stdout, nil, 0, nil, @dwRead, nil);

    if (dwRead > 0) then
    begin
      ReadFile(read_stdout, Buffer[0], ReadBuffer, dwRead, nil);
      Buffer[dwRead] := #0;
      OemToAnsi(Buffer, Buffer);
      Result := Buffer;
    end
    else
      Application.ProcessMessages;
      Sleep(100);

    GetExitCodeProcess(pi.hProcess, dwExit);

    // Make sure we have no data before killing getting out of the loop
    if (dwExit <> STILL_ACTIVE) then
      PeekNamedPipe(read_stdout, nil, 0, nil, @dwRead, nil);

  end;

  if (Pos('Error', Result) <> 0) Or (Pos('corrupted', Result) <> 0) then
  begin
    if Application.MessageBox(PChar(Result), 'Error...', MB_OK + MB_ICONERROR) = IDOK then
    begin
      Result := '';
      FreeMem(Buffer);
      CloseHandle(pi.hProcess);
      CloseHandle(pi.hThread);
      CloseHandle(read_stdout);
      CloseHandle(newstdout);
      Result := '';
      Exit;
    end;
  end;
  FreeMem(Buffer);
  CloseHandle(pi.hProcess);
  CloseHandle(pi.hThread);
  CloseHandle(read_stdout);
  CloseHandle(newstdout);
  Result := Buffer;
end;
Mess With the Best, Die Like the Rest
arxlex вне форума Ответить с цитированием
Старый 06.04.2012, 05:19   #7
Пепел Феникса
Старожил
 
Аватар для Пепел Феникса
 
Регистрация: 28.01.2009
Сообщений: 21,000
По умолчанию

я бы лучше сделал так(пишу только цикл)
Код:
while ((dwExit = STILL_ACTIVE) or (dwRead > 0)) do
  begin
    PeekNamedPipe(read_stdout, nil, 0, nil, @dwRead, nil);

    if (dwRead > 0) then
    begin
      ReadFile(read_stdout, Buffer[0], ReadBuffer, dwRead, nil);
      Buffer[dwRead] := #0;
      OemToAnsi(Buffer, Buffer);
      OutLine.Text := Buffer;
    end
    Application.ProcessMessages;

    GetExitCodeProcess(pi.hProcess, dwExit);

    // Make sure we have no data before killing getting out of the loop
    if (dwExit <> STILL_ACTIVE) then
      PeekNamedPipe(read_stdout, nil, 0, nil, @dwRead, nil);

  end;
а у вас вы слип вынесли из условия.
Хорошо поставленный вопрос это уже половина ответа. | Каков вопрос, таков ответ.
Программа делает то что написал программист, а не то что он хотел.
Функции/утилиты ждут в параметрах то что им надо, а не то что вы хотите.
Пепел Феникса вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
kill process legendary Общие вопросы Delphi 0 22.08.2010 14:20
process Aleander_beHDeP Общие вопросы C/C++ 1 29.03.2010 22:30
(process.h) Компилятор говорит Process не объявлен Парсифаль Общие вопросы C/C++ 0 15.02.2010 00:27
kill process const Общие вопросы C/C++ 2 28.08.2008 19:11
Прибить Create Process с содержимым Sashunya Win Api 4 06.11.2007 16:23