Сейчас на форуме: jinoweb (+6 невидимых)

 eXeL@B —› Программирование —› Решить проблему с принудительным закрытием программы (Delphi)
Посл.ответ Сообщение


Ранг: 275.9 (наставник), 340thx
Активность: 0.22=0.22
Статус: Участник
RBC

 Создано: 26 января 2018 18:47 · Поправил: Kindly
· Личное сообщение · #1

Дабы далеко по программерским форумам не ходить, создал здесь

Проблема заключается с принудительным закрытием всего приложения, если закрыть окно консоли, вызванной через AllocConsole. Используется это в патч-мейкере:
https://exelab.ru/f/action=vthread&forum=3&topic=23332&page=0#16

Прежде чем писать, гугла вкурил сколько мог, но безрезультатно.

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

Залил образец для тестирования:
https://www.upload.ee/files/7940823/pack.7z.html

Как проверять:
- анпакнуть желательно в корень диска C, чтобы пути не менять.
- все установки настроены, от вас требуется нажать кнопку Build Patch.
- после этого начнется создание патча и вызов консольного окна на момент обработки скрипта препроцессором инно.
- повторите компиляцию и успейте закрыть консоль вручную - всю программу ожидает вылет.
- в папке DLLSRC исходник dll, а саму dll нужно закидывать в папку pdata патч-мейкера ISXPM_.

В качестве попытки был использован обработчик, а процедура FreeConsole в нем не приносит нужного эффекта.
Code:
  1. //-----------------------------------------------------
  2. // Консольный обработчик событий
  3. //-----------------------------------------------------
  4. function ConProc(CtrlType: DWord): Bool; stdcall; far;
  5. var
  6.   S: string;
  7. begin
  8.   case CtrlType of
  9.     CTRL_C_EVENT: S:= 'CTRL_C_EVENT';
  10.     CTRL_BREAK_EVENT: S:= 'CTRL_BREAK_EVENT';
  11.     CTRL_CLOSE_EVENT: S:= 'CTRL_CLOSE_EVENT';
  12.     CTRL_LOGOFF_EVENT: S:= 'CTRL_LOGOFF_EVENT';
  13.     CTRL_SHUTDOWN_EVENT: S:= 'CTRL_SHUTDOWN_EVENT';
  14.   else
  15.     S:= 'UNKNOWN_EVENT';
  16.   end;
  17.   Result:= True;
  18.   MessageBox(0,PChar(S +' detected'),'Result',MB_ICONEXCLAMATION);
  19. end;


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

Если отметить опцию SimplyLog в Build and Log Options, то консоль будет вызываться не через dll, а через инновскую Exec (аналог CreateProcess) и при ее досрочном закрытии будет возвращен код ошибки.
Вызов консоли с отображением процесса компиляции через dll возможен только с отключенной опцией SimplyLog.

По моему понятию, нужно где-то вызвать FreeConsole так, чтобы она безвредно закрыла консоль и не позволила приложению улететь.

Просьба гуру подсказать

-----
Array[Login..Logout] of Life


Ранг: 337.6 (мудрец), 224thx
Активность: 0.21↘0.1
Статус: Участник
born to be evil

 Создано: 26 января 2018 19:39
· Личное сообщение · #2

Kindly увы, только так. а на контрол-хендлере и обрабатывай брейки от юзера
Code:
  1. Function AttachConsole(dwProcessId : Longword) : Bool; stdcall; external 'KERNEL32.DLL';
  2. Function GetConsoleWindow : HWND; stdcall; external 'KERNEL32.DLL';
  3.  
  4. procedure TForm1.FormCreate(Sender: TObject);
  5. var
  6.   wnd  : HWND;
  7.   menu : HMENU;
  8. begin
  9. AllocConsole();
  10. AttachConsole($FFFFFFFF);
  11. wnd:=GetConsoleWindow();
  12. if wnd<>0 then
  13.   begin
  14.   Menu:=GetSystemMenu(wnd,False);
  15.   if Menu<>0 then DeleteMenu(Menu,SC_CLOSE,MF_BYCOMMAND);
  16.   end;
  17. end;
  18.  
  19. procedure TForm1.FormDestroy(Sender: TObject);
  20. begin
  21. FreeConsole();
  22. end;


-----
От многой мудрости много скорби, и умножающий знание умножает печаль

| Сообщение посчитали полезным: Kindly


Ранг: 275.9 (наставник), 340thx
Активность: 0.22=0.22
Статус: Участник
RBC

 Создано: 26 января 2018 20:15
· Личное сообщение · #3

ajax, ну так норм робит и обрабатывает, можно вернуть и выполнить в обработчике уже что угодно.
Этот метод вполне подойдет. Спасибо!!!

Если кто желает найти способ как заставить обработчик корректно выполниться до разрушения консоли после нажатия на "крестик", то можете предоставить решение.

А пока повисит тема пару дней до закрытия.

-----
Array[Login..Logout] of Life


Ранг: 307.9 (мудрец), 196thx
Активность: 0.18↘0
Статус: Участник

 Создано: 26 января 2018 22:59 · Поправил: mysterio
· Личное сообщение · #4

Code:
  1. Var bExit : Boolean;
  2.  
  3. function HandlerRoutine(dwCtrlType: DWORD): BOOL; stdcall;
  4.  
  5. Var S : String;
  6.  
  7. begin
  8.   S := '';
  9.  case dwCtrlType of
  10.     CTRL_C_EVENT: S := IntToStr(CTRL_C_EVENT);
  11.     CTRL_BREAK_EVENT: S := IntToStr(CTRL_BREAK_EVENT);
  12.     CTRL_CLOSE_EVENT: S := IntToStr(CTRL_CLOSE_EVENT); // Нажали на крестик обрабатываем что хотим здесь же ;)
  13.     CTRL_LOGOFF_EVENT: S := IntToStr(CTRL_LOGOFF_EVENT);
  14.     CTRL_SHUTDOWN_EVENT: S := IntToStr(CTRL_SHUTDOWN_EVENT);
  15.    else
  16.      S := 'UNKNOWN_EVENT';
  17.   end;
  18.   HandlerRoutine := True;
  19.   MessageBox(0, PChar('Exit Code: ' + S), PChar('Caption'), 0);
  20.   bExit := True;
  21. //  FreeConsole;
  22. end;
  23.  
  24. begin
  25.   bExit := False;
  26.   SetConsoleCtrlHandler(@HandlerRoutine, True);
  27.  
  28. // Если bExit = True будет выход ?
  29. //  Repeat Until bExit <> False;
  30. //  ReadLn;
  31. //  FreeConsole;
  32.   MessageBox(0, PChar('Text'), PChar('Caption'), 0); // Чтобы не закрывалось просто так
  33. end.


-----
Don_t hate the cracker - hate the code.


Ранг: 275.9 (наставник), 340thx
Активность: 0.22=0.22
Статус: Участник
RBC

 Создано: 26 января 2018 23:33
· Личное сообщение · #5

mysterio, не, мою прогу валит такой код. А так-то во все case выставил FreeConsole.

-----
Array[Login..Logout] of Life


Ранг: 307.9 (мудрец), 196thx
Активность: 0.18↘0
Статус: Участник

 Создано: 27 января 2018 00:06 · Поправил: mysterio
· Личное сообщение · #6

Качнул исходник: там обрабатывается bTest - засунь ее в обработчик, присваивай False.
поменяй местами строки вида:
Code:
  1.  if not bTest then break; // в случае ошибки, что произошла ранее, читать далее не имеет смысла ?
  2.  bTest := ReadFile(hPipeBlaBlaBla, szBuffer[0], 256, dwNumberOfBytesRead, nil);
  3.  
  4. // Перед FreeConsole обработчик соответственно убрать - что бы не срабатывал дважды:
  5.   SetConsoleCtrlHandler(@ConProc, False);


-----
Don_t hate the cracker - hate the code.

| Сообщение посчитали полезным: Kindly


Ранг: 275.9 (наставник), 340thx
Активность: 0.22=0.22
Статус: Участник
RBC

 Создано: 04 февраля 2018 12:56 · Поправил: Kindly
· Личное сообщение · #7

Все сделал норм, но в ходе теста на Windows 10 возник глюк, как оказалось, 10-ка не переваривает для записи в консоль процедуру write или writeln, т.е. запись в цикле работает, но только первый раз, потом выбивает ошибку и вылет приложения, перезапускаешь прогу - опять, первый раз работает, потом ошибка и вылет. решение:

перед циклом объявляем:
Code:
  1. h := GetStdHandle(STD_OUTPUT_HANDLE);

в цикле:
Code:
  1.       while bRead do
  2.       begin
  3.         DllProcessMessages;
  4.         bTest := ReadFile(hPipeOutputRead, szBuffer[0], 256, dwNumberOfBytesRead, nil);
  5.         if not bTest then break;
  6.         Stream.Write(szBuffer, dwNumberOfBytesRead); // запись в поток для последующего целостного вывода в TStingList
  7.         // запись непосредственно в выделенную консоль
  8.         szBuffer[dwNumberOfBytesRead] := #0;
  9.         OemToAnsi(szBuffer, szBuffer); // OemToAnsi компилем транслируется как OemToCharA
  10.         WriteConsole(h, PChar(s + String(szBuffer)), Length(s + String(szBuffer)), cb, nil);
  11.       end;

может когда кому пригодится

-----
Array[Login..Logout] of Life
 eXeL@B —› Программирование —› Решить проблему с принудительным закрытием программы (Delphi)
:: Ваш ответ
Жирный  Курсив  Подчеркнутый  Перечеркнутый  {mpf5}  Код  Вставить ссылку 
:s1: :s2: :s3: :s4: :s5: :s6: :s7: :s8: :s9: :s10: :s11: :s12: :s13: :s14: :s15: :s16:


Максимальный размер аттача: 500KB.
Ваш логин: german1505 » Выход » ЛС
   Для печати Для печати