Об альтернативе Application.ProcessMessages для TWebBrowser и разрыве стека выполнения

  При использовании TWebBrowser существуют две неприятности, во-первых, это сам TWebBrowser =), а во-вторых, это Application.ProcessMessages, который необходимо выполнять чуть ли не на каждое действие (загрузить документ, сменить режим редактирования и т.п).
  Использование Application.ProcessMessages может вызывать неожиданные проблемы. Особенно это актуально, когда используются оконные windows сообщения для разрыва стека выполнения. Но нашелся способ, которое позволяет не выбирать все сообщения из очереди. На первый взгляд, решение даже работает, однако буду рекомендовать никогда его не использовать и всегда использовать Application.ProcessMessage и об этом ниже.
  Очевидно, что WebBrowser обрабатывает какие-то сообщения. Но поиск их казался гиблой идеей.   В действительности оказалось, что ни так все плохо. С помощью Window Detective было обнаружено, что в момент загрузки происходит подозрительная посылка сообщений окну с именем класса  ‘Internet Explorer_Hidden’. Решил проверить и выбрал из очереди оконных сообщений в момент загрузки документа сообщения предназначенные только этому окну. К моему удивлению — все заработало.
Сообщения получаемые окном IE
Вообщем вот заготовка кода:
TMyWebBrowser = class(TWebBrowser)
protected
procedure WBProcessMessage;
procedure InternalSetValue(const AValue: string);
public
procedure SetValue(const AValue: string); // Входная точка в примера
procedure WaitWB;
end;


function EnumWindowsToFindIEHiddenProc(AHandle: HWND; AParam:NativeInt): boolean; stdcall;

var
IEHiddenHandle: Hwnd;

implementation

procedure TMyWebBrowser.SetValue(const AValue: string);
begin
InternalSetValue(AValue); // выполняем каким либо способом присваивание разметки
WaitWB; // Ждем завершение загрузки документа.
FooFunction; //Какой то функционал для работы которого необходим полностью загруженные html документ.
end;

procedure TMyWebBrowser.WaitWB;
begin
//Как то так обычно выглядит ожидание пока документ полностью не загрузиться
while HTMLDocument2.readyState <> 'complete' do
begin
WBProcessMessage; // выбираем только нужные сообщения
//Forms.Application.ProcessMessages; // выбираем все сообщения из очереди
end;
end;


procedure TbtkHTMLEditor.WBProcessMessage;
var
msg: Windows.tagMSG;
processID : THandle;
begin
IEHiddenHandle := 0;
processID := GetCurrentProcessId;
if EnumWindows(@EnumWindowsToFindIEHiddenProc, processID) then // �щем хендл окна IE в нашем процессе перебирая все окна
if IEHiddenHandle <> 0 then // Проверяем найденный хендл валидный
if PeekMessage(msg, IEHiddenHandle, 0, 0, PM_REMOVE) then // извлекаем из очереди оконных сообщений все сообщения для окна IEHiddenHandle
begin
Windows.DispatchMessage(msg); // Передаем извлеченные сообщения окну IE
end;
end;

function EnumWindowsToFindIEHiddenProc(AHandle: HWND; AParam:NativeInt): boolean;
var
processId: NativeInt;
classbuf: array[0..255] of Char;
const
IEWndClassName = 'Internet Explorer_Hidden';
begin
result := true;
if Windows.GetWindowThreadProcessId(AHandle,@processId) <> 0 then
begin
if AParam = processId then
begin
GetClassName(AHandle, classbuf, SizeOf(classbuf));
if lstrcmp(@classbuf[0], @IEWndClassName[1]) = 0 then
begin
IEHiddenHandle := AHandle;
result := false;
end;
end;
end;

end;
  Код на скорую руку, проверялся с IE 9-10 в Windows 7-8. Но в данном случае я избегаю слова «решение», тут больше подходит — «грязный хак». На самом деле, если у вас есть проблема того, что внезапный ProcessMessages нарушает строгий порядок ваших вызовов, то проблема не в ProcessMessages. ProcessMessages это данность архитектуры Windows и VCL. Если посылаете оконное сообщение, то будьте готовы, что оно может быть извлечено раньше, чем вы предполагаете. Например, из окна посылаем себе же сообщение WM_Close. Сообщение извлекается вот таким неожиданным ProcessMessages еще до раскрутки стека выполнения, который вызвал посылку этого сообщения. В результате дальнейшая раскрутка стека выполнения пойдет по освобожденным объектам, так как на WM_Close будет убито родительское окно и все дети на нем.
  Подобные проблемы не решить изъятием вызовов ProcessMessages. Любой модальный диалог нарушит подобный не очень хитрый план. Для избегания подобной проблемы нужно использовать другие подходы. Мы, например, подобные проблемы решаем так называемыми контекстами асинхронного выполнения и подсистемой асинхронных команд. Говоря «асинхронные команды», я не подразумеваю много-поточное выполнение, а только разрыв стека выполнения. Что и происходит, когда посылаем в свой же поток оконное сообщение.
Вся суть в том, что асинхронные команды — это надстройка над механизмом оконных сообщений, позволяющая передавать в качестве сообщений объекты, а контекст — это состояние системы, определяющее возможность исполнения этого объекта.
Таким образом, асинхронная команда — это объект, который посылается в очередь сообщений, сообщением  WM_AsyncCommand, где в качестве параметра указатель на объект. При извлечении сообщения WM_AsyncCommand из очереди сообщений, у объекта асинхронной команды вызывается обработчик, который и исполняет полезный код. Асинхронная команда принадлежит контексту. Контекст создается при запуске приложения. Если на момент извлечения асинхронной команды из очереди сообщений контекст заблокирован, тогда асинхронная команда перемещается в особый буфер команд, где дожидается разблокировки контекста.  Все что осталось, это заблокировать контекст на момент начала роста стека вызовов, в котором могут посылаться команды, имеющие возможность порушить стек выполнения:

Context.Lock;
try
    AnyUserAction;
finally
    context.Unlock;
end;

Выше я приводил пример с WM_Close. Для этого мы используем TFormCloseAsyncCommand = class(TAsyncCommand). Ко всему прочему, контексты могут быть вложенными, а команды имеют фьючеры для возможности их отмены. Но это явно не вопрос темы текущей статьи (если кому интересно, то могу накидать шаблон кода и варианты использования в отдельной статье).
Вернемся к «грязному обходному пути» и оставим в стороне вопрос о том, что ProcessMessages — данность и не является безусловным злом. И тем не менее выборочная диспетчеризация сообщений для класса «Internet Explorer_Hidden» —  сомнительный путь:
1. Данный вопрос никак не документирован. В MSDN мне попадался только код вида while (browser.IsBusy){System.Windows.Forms.Application.DoEvents();} .
2. «Решение» не проверялось на всех возможных версиях IE и Windows.
3. Нет гарантии, что мы обрабатываем все нужные сообщения.
4. В будущем архитектура WebBrowser может измениться и данный подход уже может  не работать.
5. Извлекая только определенные сообщения, мы можем нарушить порядок обработки сообщений

Читать на сайте автора.

Жизнь и восстановление после StackOverflow

Распространено мнение, что StackOverlow — это приговор. Все, что остается приложению — это красиво схлопнуться, не оставив возможности пользователю продолжить работу, сохранить важные данные, и даже информацию об ошибке.

Дальше я расскажу, зачем и как можно обрабатывать ошибку переполнения стека, а так же какую «свинью» подложила EurekaLog — инструмент, который должен был обеспечивать нас информацией о том, почему клиент снова в бешенстве.

Сначала немного справочной информации о том, как устроен стек.

Устройство стека 

В каждом потоке под стек  резервируется по умолчанию 1 МБ адресного пространства. Зарезервированная память физически еще не выделена. Все адресное пространство разбито на страницы — минимальные блоки, которыми оперирует системный менеджер памяти. Стек растет от большего адреса к меньшему постранично. Память выделяется (становится commited) в момент роста стека. Для того, что бы определить необходимость выделения еще одной страницы из зарезервированных, используется защищенная страница памяти. Это такая страница, которая уже выделена (закомичена)  и помечена флагом Page_Guard. Защищенная страница всегда располагается следом за страницей, в которой находится текущая вершина стека. При росте стека происходит обращение к защищенной странице, система реагирует, снимается флаг Page_Guard со страницы и возбуждается исключение доступа к защищенной странице.  Обработав исключение система понимает, что необходимо выделить еще страницу памяти из зарезервированного пространства и пометить ее флагом Page_Guard. Уже выделенная память стека обратно не возвращается, и страницы остаются commited даже после полной раскрутки стека.
Последняя (в сторону роста стека) зарезервированная страница адресного пространства никогда не выделяется. Она служит буфером, что бы вершина стека не вышла за границы сегмента.

Механизм возбуждения StackOverflow 

В какой-то момент в процессе роста стека остается только одна защищенная страница перед последней зарезервированной. Приложение пытается нарастить стек. С защищенной страницы снимается флаг защиты и происходит попытка выделить еще одну защищенную страницу. Система не разрешает и возбуждает исключение переполнения стека (StackOverflow). Как правило, после этого у нас остается еще почти целая страница для обработки исключения.
С этого времени система снимает с себя ответственность за контроль стека. Page_Guard  в дальнейшем больше не выставляется страницам, и если стек снова достигнет предела, произойдет обращение к последней зарезервированной странице. В результате система убъет поток и приложение. Для пользователя — приложение просто схлопнется.

Почему StackOverflow это проблема

Почему же, зачастую пользователь не видит даже сообщения о переполнении стека? Вместо этого приложение просто исчезает. Все дело в том, что оставшиеся 4 килобайта памяти для обработки исключения это очень мало. В rtl много подобных мест:

procedure FmtStr(var Result: string; const Format: string;
const Args: array of const; const FormatSettings: TFormatSettings);
var
Len, BufLen: Integer;
Buffer: array[0..4095] of Char;
begin
..
end;

Лишь один такой вызов израсходует всю оставшуюся доступную память для того, что бы расположить на стеке массив Buffer. 
В рабочем проекте мы используем EurekaLog для сбора информации о стеке исключений и формирования отчета об ошибке. Но при обработке исключения StackOverflow, эврика обращалась к методам rtl, которые не оставляли нам шанса узнать причину, почему у клиентов на проекте наш продукт в момент работы схлопывается.
Была еще одна причина, которая побудила решить эту проблему кардинально. Большую часть нашего продукта занимает скриптовый движок для исполнения паскаль скриптов. Клиентская логика пишется на паскаль скрипте. Паскаль скрипт динамически подгружается. Таким образом, если программист допустит ошибку при написание скрипта и получит StackOverflow, то не останется другого варианта как снова перезапустить развесистый фреймворк.

Обработка StackOverflow

В MSDN есть функция
  BOOL WINAPI SetThreadStackGuarantee(_Inout_  PULONG StackSizeInBytes);
с помощью которой можно установить размер памяти, который останется доступным после возбуждение StackOverflow для обработки исключения. Функция выполняет простую вещь. Если с помощью ее установить гарантированный размер 8 килобайт, то в этом случае система будет держать перед вершиной стека 2 защищенные страницы по 4 килобайта.  
Теперь мы можем гарантированно собрать информацию об ошибке. Эвристическим путем было выяснено, что для эврики надо 32 кБ. Для перестраховки мы задаем 64кб. Однако следующее переполнение стека будет фатальным. 
Но для полного восстановления после StackOverflow необходимо вернуть защищенные страницы. Когда это сделать? Когда стек свернется, и вершина стека уйдет со страниц, на которых мы хотим восстановить Page_Guard. При этом остается вероятность, что при обработке исключения переполнения стека, мы получим новое переполнение стека. Для этого сразу же после первого переполнения стека выставим на одной верхней странице флаг Page_Guard.  И в случае нового переполнения стека при обработке предыдущего, мы сможем хотя бы сообщить о переполнение стека при обработке переполнения стека и закрыть приложение.
Вот так это выглядит в теории:
На практике будут следующие шаги:
  1. Установить гарантированный размер для обработки стека равный 68 кБ;
  2. Необходимо повесить хук на возникновение исключения. В случае StackOverflow начать процесс восстановления. Установить на 1 страницу Page_Guard. В Delphi можно повесить для этих целей обработчик на System.ExceptObjProc;
  3. Дождаться раскрутки стека. Это самый интересный момент. Тут возможны разные варианты. Один из самых простых вариантов —  установка хука на оконные сообщения и на onIdle. В VCL приложение стек как правило всегда раскручивается до Application.ProcessMessage. Вот тут и попытаемся восстановить остальные 16 защищенных страниц;
  4. Если в момент восстановления стека, система возбудила новое исключение StackOverflow, то ничего не остается, как сделать хорошую мину: информируем пользователя об исключении и выполняем перезапуск приложения.
Приведу простейший пример восстановления после StackOverflow. Все начинается с Button1Click и секция initialization:
unit main;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
procedure DoOnMessage(var Msg: TMsg; var Handled: Boolean);
end;

function SetThreadStackGuarantee(var StackSizeInBytes:
Cardinal): LongBool; stdcall; external 'kernel32.dll' name 'SetThreadStackGuarantee';
type
proc = procedure();
TRaiseExceptionProc = procedure(ExceptionCode, ExceptionFlags: LongWord;
NumberOfArguments: LongWord; Args: Pointer); stdcall;
TExceptObjProc = function(P: PExceptionRecord): Pointer;
var
Form1: TForm1;
oldRaiseExceptionProc: TExceptObjProc = nil;
restoringAfterStackOverlow: boolean = false;
stackGuaranteeSize: Cardinal;
const
PageSize = 4096;

function _RaiseExeceptionProc(P: PExceptionRecord): Pointer{Exception};
implementation

{$R *.dfm}

{$POINTERMATH ON}

function GetSegmentStackTop: Pointer; assembler;
type
NT_TIB32 = packed record
ExceptionList: DWORD;
StackBase: DWORD;
StackLimit: DWORD;
SubSystemTib: DWORD;
case Integer of
0 : (
FiberData: DWORD;
ArbitraryUserPointer: DWORD;
Self: DWORD;
);
1 : (
Version: DWORD;
);
end;
asm
MOV EAX, FS:[0].NT_TIB32.StackLimit
end;

function GetESP: Pointer; assembler;
asm
mov result, esp
end;

function GetMemoryInfo(addr: NativeUInt): TMemoryBasicInformation; inline;
begin
VirtualQuery(Pointer(addr), Result, SizeOf(Result));
end;

procedure TerminateRecoveringAfterStackOverflow;
begin
Assert(restoringAfterStackOverlow);
MessageBox(0, 'Не удалось восстановится после StackOverflow, приложение будет закрыто.',
'Все пропало',
MB_ICONERROR);
Halt(0);
end;

function RestoreStackPageGuard(APageAddress: Pointer): boolean;
var
oldProtectFlag: dword;
begin
result := VirtualProtect(APageAddress, PageSize, PAGE_READWRITE or PAGE_GUARD, oldProtectFlag);
end;

procedure StartRecoveringAfterStackOverflow;
begin
Assert(not restoringAfterStackOverlow);
restoringAfterStackOverlow := true;
RestoreStackPageGuard(GetSegmentStackTop);
Application.OnMessage := Form1.DoOnMessage;
end;

procedure StopRecoveringAfterStackOverflow;
begin
Assert(restoringAfterStackOverlow);
restoringAfterStackOverlow := false;
Application.OnMessage := nil; // Так конечно лучше не делать, а использовать для этих
// целей вместо обработчика OnMessage хук на сообщения
end;

procedure ValidateStackPageGuards;
var
memoryInfo: TMemoryBasicInformation;
address, stackLimit: NativeUInt;
guarded: Boolean;
begin
address := NativeUInt(GetESP);

guarded := False;
address := NativeUInt(GetMemoryInfo(address).BaseAddress);
stackLimit := NativeUInt(GetSegmentStackTop);


while not(guarded) and (address >= stackLimit) do
begin
memoryInfo := GetMemoryInfo(address);
guarded := (memoryInfo.Protect and PAGE_GUARD) = PAGE_GUARD;
address := address - PageSize;
end;

if not guarded then
begin
TerminateRecoveringAfterStackOverflow;
end;
end;


function _RaiseExeceptionProc(P: PExceptionRecord): Pointer{Exception};
begin
if (GetCurrentThreadId = MainThreadID) then
begin
if not restoringAfterStackOverlow then
begin
if Assigned(P) and (P.ExceptionCode = STATUS_STACK_OVERFLOW) then
begin
StartRecoveringAfterStackOverflow();
end
end else
ValidateStackPageGuards;
end;

if Assigned(oldRaiseExceptionProc) then
result := oldRaiseExceptionProc(P);
end;



procedure WeNeedToGoDeeper(var i : integer);
var
a:array[0..4000] of char;
begin
inc(i);
WeNeedToGoDeeper(i);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
begin
i := 0;
try
WeNeedToGoDeeper(i);
finally
MessageBox(0, PChar(Format('На %d вложение',[i])), 'Ошибка StackOverflow', mb_ok);
end;
end;

procedure TForm1.DoOnMessage(var Msg: TMsg; var Handled: Boolean);
var
i: integer;
begin
Assert(restoringAfterStackOverlow);
ValidateStackPageGuards;

for i := 1 to 16 do
begin
if not RestoreStackPageGuard(Pointer(NativeInt(GetSegmentStackTop) + PageSize * i)) then
begin
TerminateRecoveringAfterStackOverflow();
end;
end;
StopRecoveringAfterStackOverflow();
end;

initialization
stackGuaranteeSize := PageSize * 16;
SetThreadStackGuarantee(stackGuaranteeSize);

oldRaiseExceptionProc := ExceptObjProc;
ExceptObjProc := @_RaiseExeceptionProc;
end.

Проверить, что восстановление после StackOverflow работает можно с помощью утилиты  vmmap из SysInternalsSuite.

Первый скриншот после запуска приложения. 16 кБ используется стеком из 1МБ. 68 кБ защищенная область.

Сразу после StackOverflow. Вся память выделена.
После восстановления работоспособности.

Более подробно о работе стека можно почитать тут:

  1. MSDN http://msdn.microsoft.com/ru-ru/library/windows/desktop/ms686774(v=vs.85).aspx
  2. У Джефри Рихтера в книге «Создание эффективных WIN32-приложений»
  3. У Марка Руссиновича в блоге http://blogs.technet.com/b/markrussinovich/archive/2009/07/08/3261309.aspx и книге «Внутреннее устройство Microsoft Windows»

Читать на сайте автора.

Немного про замыкания

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

program closuretest;

{$APPTYPE CONSOLE}

{$R *.res}

uses
System.SysUtils;

procedure Test;
var
i: Integer;
m: string;
proc, proc2: TProc;

function GetClosure1:TProc;
begin
Result := proc;
end;

function GetClosure2:TProc;
begin
Result := proc2;
end;

var
intf1, intf2: IInterface;
begin
i := 0;
proc := procedure()
begin
inc(i,2);
Writeln(i);
end;
proc2 := procedure()
begin
inc(i,3);
Writeln(i);
end;

proc();
proc2();

GetClosure1.QueryInterface(IInterface, intf1);
GetClosure2.QueryInterface(IInterface, intf2);
Writeln(GetClosure1 = GetClosure2); //False
Writeln(intf1 = intf2); // TRUE, что и требовалось доказать

Read(m);
end;

begin
try
Test;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.

Читать на сайте автора.

Delphi Event bus

Решились на работе поддержать Delphi сообщество и начать выкладывать в open source собственные наработки. 

Первой ласточкой суждено было стать пакету DelphiEventBus — реализация паттерна проектирования Event Bus.  
В Jаva мире есть такие пакеты как guava-libraries, но в Delphi ничего похожего найти не удалось. Потому решено было запилить нечто подобное. 

Из статьи Java event bus library comparison можно выцепить характеристики библиотек реализующих шину сообщений. 

Для DelphiEventBus получается следующие:

  • Объявление слушателя — аннотация

  • Синхронность отправки в шину — по умолчанию отправка синхронна. 

  • Асинхронность — в планах на будующее

  • Фильтрация событий — статическая, т.е. у обработчиков в листенера можно задать декларативно фильтры и их значения. При посылки события задаются значения предопределенных фильтров для конкретного события

  • Иерархия событий — да. Событие это объект. Есть базовый класс всех событий. Обработчик может ждать события определенного класса и всех его наследников

  • Строгость ссылочности листенера — строгая. Обязательная дерегистрация. Регистрируются и дерегистрируются  сразу все обработчики в листенере

  • Приоритет обработчиков — отсутствует. Но дополнительно реализован механизм хуков, похожий на виндовый механизм.

  • Реализованы хуки — возможность игнорировать фильтры и выстраивать цепочки обработки. Вызов хуков строго обратен порядку регистрации.

Должно работать на XE3 и выше. Еще бы readme перевести на английский…


Читать на сайте автора.

Для расовых ненавистников "with"

Коим я являюсь (ненавистником with)

Добрые люди предложили замену:

(procedure (A: TObject)

  begin
    A.Free;
  end)(TObject.Create);

Читать на сайте автора.

Подводные камни при работе с исключениями в Delphi: Raise Exception, AcquireExceptionObject, исключения операционной системы

    Интересно, на сколько читатель уверен в своих знаниях подводных камней в работе с исключениями в Delphi.  Я решил подготовить три наиболее часто встречаемых ошибки в  рабочем проекте. Надо признаться, некоторые моменты меня удивили. В том числе и ответ на вопрос «в какой момент удаляются объекты исключений».
    Каждый может проверить свои познания подводных камней.  В листинге ниже приведены три метода Error#, каждый из которых ведет к определенной проблеме.
Пояснения я приведу вслед за кодом.

procedure  RaiseOSException;
var
res: integer;
zero: integer;
begin
zero := 0;
res := 5 div zero;
end;

function FormatException(E:Exception): Exception;
begin
if not (E is EMyException) then
result := EMyException.Create(E.Message)
else
begin
E.message := Format('Ошибка обработки исключения: %s', [E.Message]);
result := E;
endl
end;


procedure Error1;
begin
try
RaiseOSException;
except
on E: Exception do
begin
E.Message := Format('Заворачиваем в свой текст: %s', [E.Message]);
Raise;
end;
end;
end;

procedure Error2;
begin
try
raise EMyException.Create('Alarm!!111');
except
on E: Exception do
begin
Raise FormatException(E);
end;
end;
end;

procedure Error3;
begin
try
raise Exception.Create('Alarm!!111');;
except
Raise FormatException(AcquireExceptionObject);
end;
end;

Ответы:

  • Error1 — потеря изменений в сообщение исключения;
  • Error2 — Ошибка Access Violation
  • Error3 — Утечка памяти
Разберем каждый случай более детально:

Потеря сообщений

    В методе Error1 мы изменяем текст исходного сообщения и возбуждаем исключение вновь. Но в диалоге исключения мы не увидим текста с «Заворачиваем в свой текст: %s».
    При возбуждение внешнего исключения Delphi заворачивает его в обертку — собственное исключения и дает обработать в блоке except..end.  Далее, в вызове Raise вызывается System._RaiseAgain в котором происходит удаление объекта делфового исключения(в котором мы и сделали изменение данных поля Message), а дальше возбуждается исходное внешнее исключение  которое ничего не знает про наш новый текст сообщения. 
    Более подробно можно найти описание на stackoverflow.

Ошибка Access Violation (Или «в какой момент удаляются объекты исключений»)


   В методе Error2 мы поймали исключение, хотим отформатировать его текст и пробросить дальше. Однако это приведет к проблеме.  
   Проблема  случая из метода Error2 заключается в том, что Delphi попытается дважды удалить один и тот же объект исключения. Первый раз Raise FormatException(E),  второй раз скорее всего где нибудь в TApplication, в завершения цикла обработки исключений. Ответ находится в System._HandleAnyException в которой каждый сможет найти комментарий:

 { we come here if an exception handler has thrown yet another exception }
        { we need to destroy the exception object and pop the raise list. }

   Синтаксис «Raise Argument: Exception;» подразумевает что мы пытаемся возбудить другой объект исключения, а не тот, что находится сейчас на вершине стека возбужденных исключений. Для этого вычищаем объект исключения, что находится на вершине стека и вталкиваем в стек его новый объект. Проблема заключается в том, что удаляемый и вталкиваемый объект являются одним и тем же объектом. 
  Единственное место, где в документации Embarcadero явно говориться, что так делать нельзя нашел в статье Handling exceptions in Delphi
   Правильно выполнить вызов raise без аргументов(«Raise;»), либо использовать метод AcquireExceptionObject. О нем ниже.

Утечка памяти


    В Error3 мы вместо пойманного исключения стандартного класса создаем собственное исключение, которое может более точно сообщить о проблеме при обработке в вызывающем коде. Нюанс заключается в том, что исходный  объект исключения получаем через AcquireExceptionObject. Данный метод может оказаться незаменим, например если мы хотим передать исключение из одного потока в другой. AcquireExceptionObject возлагает на нас ответственность за дальнейшее освобождения памяти полученного объекта исключения, а Delphi тем временем «умывает руки».
Справка Delphi сообщает, что за методом  AcquireExceptionObject должен следовать ReleaseExceptionObject который уменьшает счетчик ссылок на фрейм исключения(структура в rtl описывающая исключение). Получается, что  в Error3 мы забыли вызвать метод ReleaseExceptionObject? Нет. Вызов ReleaseExceptionObject нам ничем не поможет: объект  утечет в любом случае.
   В действительности счет ссылок и ReleaseExceptionObject  актуальны только для Linux. В модуле System есть объявление типа TRaiseFrame — фрейма исключений, в случае компиляции под Windows счетчик ссылок не предусмотрен. Вот текст метода:

function AcquireExceptionObject: Pointer;
begin
if RaiseListPtr <> nil then
begin
Result := PRaiseFrame(RaiseListPtr)^.ExceptObject;
PRaiseFrame(RaiseListPtr)^.ExceptObject := nil;
end
else
Result := nil;
end;

Метод AcquireExceptionObject «забывает» ссылку на объект исключения во фрейме исключения. А при стандартном попытке удаление исключения  ничего не произойдет, так как предусмотрена проверка на nil в деструкторе объекта:

procedure TObject.Free;
begin
if Self <> nil then
Destroy;
end;

Именно по этому вызов из проблемы которая описана выше не приведет к AV:
except

  E := AcquireExceptionObject;
Raise E; // В данном случае это правильный код
end;

А для метода test3 наиболее правильным будет решение отказаться от AcquireExceptionObject, и получать объект используя синтаксис On E: Exception do. Но все же, если удобнее использовать AcquireExceptionObject, то за ним должен следовать Raise Argument;  либо явный вызов деструктора:

procedure Error3;
var
e : Exception;
begin
try
raise Exception.Create('Alarm!!111');;
except
e := AcquireExceptionObject;
try
Raise FormatException(e);
finally
FreeAndNil(e);
end;
end;
end;

Более подробно, про то, что справка иногда обманывает qc.embarcadero.com

Подводя итог, как делать нельзя:

//AV

On E: Exception do
raise E;
//Утечка
E := AcquireExceptionObject;
raise EMyException.Create(E.Message);
//Утечка
E := AcquireExceptionObject;
try
Foo(E);
finally
ReleaseExceptionObject(E); //Вызов метода бессмысленнен
end;

Читать на сайте автора.

Variant := TObject.Create ?

  Думаю многие сталкивались с тем, что иногда требуется в variant передавать blob, ну или TObject. В таких языках как Java и C# все проще, элементарные типы являются объектами ну или умеют упаковываться из значимых типов в объекты. Для всех типов в языке есть базовый тип. В Delphi же, когда тип на этапе компиляции не известен единственным универсальным решением является использование variant. 
  Но не все так гладко, тип Variant предназначен только для хранения простых типов и указатель на объект в него не поместить не используя грязных хаков. Хотя сам RTL ими так и кишит. Так для хранения ftBlob в variant используется строка. 
На самом деле есть «законный»  механизм как через Variant передавать любые данные, в том числе и объекты. Для этого есть базовый класс TCustomVariantType, на основе которого можно определить свой тип который можно будет передавать как Variant, перекрыть в нем бинарные арифметические  и логические операции. Т.е. реализовать например свое сравнению и сложение для экземпляров типа. 
Но вот тут мы подходим к самому интересному, в FireMonkey появились методы по преобразованию variant к TObject и обратно:

function VarIsObject(Value: Variant): Boolean;
function ObjectToVariant(const AObject: TObject): Variant;
function VariantToObject(const Value: Variant): TObject;
Выглядит интригующе, неправда ли? 
Но что внутри?
Совершенно обычный хак, все опять сделано через строки:
function ObjectToVariant(const AObject: TObject): Variant;
begin
Result := 'vgobj' + IntToStr(Integer(Pointer(AObject)));
end;

function VariantToObject(const Value: Variant): TObject;
var
S: string;
begin
S := Value;
{$IFDEF FPCCOMP}
if (S <> '') and (Pos(WideString('vgobj'), S) = 1) then
{$ELSE}
if (S <> '') and (Pos('vgobj', S) = 1) then
{$ENDIF}
Result := TObject(Pointer(StrToInt(Copy(S, 6, 10))))
else
Result := nil;
end;

…и расположено это все не в модули System или Variants, а в Types. Никакой поддержки на уровне компилятора нет. Т.е. все еще нельзя писать так

var 
v: Variant;
begin
v := TMyClass.Create();
end;

  Почему бы Embarcadero уже не реализовать нормальную поддержку объектов в variant, ну или хотя бы сделать на основе TCustomVariantType. Непонятно. Притом, что есть и наследники от него TInvokeableVariantType и TPublishableVariantType.


  Возможно, все ради совместимости с COM Variant, не хотят далеко от него уходить и пытаются сохранить Variant для типов передающихся по значению. Или, возможно, методы VariantToObject и ObjectToVariant были реализованы Евгением Крюковым KSDev, а в Embarcadero не стали ничего переделывать, работает и на том спасибо.


Читать на сайте автора.

Чтение в FinalBuilder VersionInfo из проекта Delphi 7

  С удивлением обнаружил, что на многих форумах у коллег возникают проблемы как при автоматической сборке проекта через FinalBuilder автоматизировать изменение VersionInfo.
  Для начала внесем ясность где настройки содержаться.
  В Делфи 7 проектах для настроек используется файл .dof, в этот файл IDE сохраняет все настройки проекта. При компиляции на основе этого файла формируется .rc файл — скрипт который уже поступает на вход компилятора ресурсов, на выходе который возвращает .res файл. .res файл будет содержать VersionInfo  и информацию об иконки исполняемого файла. При компиляции dcc( Delphi Pascal Compiler) включает ресурсы в исполняемое приложение (если они указаны в модулях {$R *.res}). Некоторые настройки могут перекрываться .cfg   файлом. cfg файл создается при каждом сохранение проекта из IDE. Dcc проверяет наличие .cfg файла c именем совпадающем с названием проекта и если файл обнаружен использует настройки из него при компиляции. В своем проекте Finalbuilder’а я удаляю перед сборкой этот файл.
  Вернемся к нашим баранам, .dof файл в действительности имеет формат ini файла. А для работы с ini файлами в FinalBuilder есть действия (action)  «Read Ini File» и «Write Ini File». С помощью их мы можем прочесть любые значения из VersionInfo, Version Info Keys (и других) и записать обратно до вызова dcc.
Пример настройки действия чтения MajorVer значения. 

  Но что бы такая схема заработало неодходимо в действие Build Delphi Win32 Project на закладке Project отменить «Load Settings from project File» и «Version Info»:


В этом случае при сборке будет использоваться .dof файл.

Читать на сайте автора.

IE9 in edit Mode & TWebBrowser = EZeroDivide

  В начале предисловия предисловие

  Приветствую тебя случайный гость. Данный блог давно задумывался, но все что то мешало, то не было темы с которой можно начать, то природная лень брала верх над намеченным. Основная цель преследуемая блогом это упорядочивание знаний, закрепление опыта, развитие навыков изложения материала, вообщем как и у всех, т.е. для себя. Если такие цели, то «какого черта» простите ждать? Садимся и пишем! Так и появилась первая запись в этом блоге, посмотрим что в дальнейшем из этого может выйти.

  На этой недели вылезла не самая тривиальная ошибка которой и хочу поделиться в первую очередь с собой=) и с возможным читателем. 

  В программной системе на моей текущей работе для отображения HTML разметки используется компонент TWebBrowser, который как известно является оберткой для COM ядра Internet Explorer’а. С недавних пор у некоторых клиентов нашего приложения  фрейм содержащий TWebBrowser стал валиться c исключением EZeroDivide — ошибка деления на ноль. В дальнейшем выяснилось, что ошибка имеет место лишь при установленном IE9 находящемся в режиме редактирования в OS Windows 7 64bit. И как только пользователь касался полосы прокрутки всплывало исключение. 
Место генерации исключения было не в Delphi обертке и находилось где то внутри IE.  Гугление показало, что я не одинок в своей проблеме, и нас как минимум трое=). Удалось установить и причину проблемы.   
  Все дело в том, что по умолчанию в MSVC и библиотеках написанных на нем при выполнение операций в FPU не возбуждаются исключения на ошибки, а возвращает значения NaN, +INF, -INF.  За настройку данного поведения в FPU отвечает так называемый регистр управляющее слово — Control Word (CW).Кроме того, через него можно задать и другие параметры влияющие на вычисление операций над числами с плавающей запятой, например точность. 
Для решения проблемы достаточно установить нужную маску в данный регистр перед созданием TWebBrowser и восстановить значение регистра после закрытия. Это может выглядеть как то так:

var 
CW: word;

procedure TForm1.FormCreate(Sender: TObject);
begin
CW := Get8087CW(); // Запоминаем предыдущее состояние регистра
System.Set8087CW($133f); // Выключаем исключения
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
System.Set8087CW(CW); // Восстанавливаем предыдущее значение регистра
end;


  Но данный способ приемлем если у вас форма с TWebBrowser открыта модально или приложение не большое. В случае же если приложение MDI, большое и пользователь может динамически выполнять скрипты, то ни как не хотелось бы отключать генерацию исключений на все время работы приложения. Но как сделать так, что бы исключения были выключены только для TWebBrowser? 
К счастью для меня TWebBrowser используется у нас для отображения статической HTML разметки и проблема была замечены только когда пользователь трогал полосу прокрутки, потому было решено менять значение управляющего регистра только когда мышь появляется над TWebBrowser и восстанавливать обратно, когда покидает границы компонента.


TEventObject = class(TInterfacedObject,IDispatch)
private
FOnEvent: TProc;
protected
function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
function GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
public
constructor Create(const OnEvent: TProc);
property OnEvent: TProc read FOnEvent write FOnEvent;
end;

var
webBrowser: IWebBrowser;
iDocument2: IHTMLDocument2;
eoMouseLeave, eoMouseEnter: TEventObject;
iElement2: IHTMLElement2;
j: Integer;
CW: Word;

implementation

function TEventObject.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
begin
if (Dispid = DISPID_VALUE) then
begin
if Assigned(FOnEvent) then
FOnEvent; // Вызываем обработчик события
Result := S_OK;
end
else Result := E_NOTIMPL;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
{Создание объектов обработчиков реализующих IDispatch}
eoMouseEnter := TEventObject.Create(self.OnMouseEnter);
eoMouseLeave := TEventObject.Create(self.OnMouseLeave);
end;

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
{Устанавливаем обработчики на события после загрузки страницы}
webBrowser := pDisp as IWebBrowser;
if Assigned(webBrowser.Document) then
begin
iDocument2 := webBrowser.Document as IHTMLDocument2;
iDocument2.DesignMode := 'On';

for j:=0 to iDocument2.All.Length-1 do
begin
iElement2 := iDocument2.All.item(j,EmptyParam) as IHTMLElement2;
iElement2.AttachEvent('onmouseenter', eomouseEnter);
iElement2.AttachEvent('onmouseleave', eoMouseLeave);
end;
end;
end;

procedure TForm1.WebBrowser1BeforeNavigate2(Sender: TObject;
const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
begin
{отсоединяем обработчики от событий, перед загрузкой новой страницы}
if Assigned(webBrowser.Document) then
begin
iDocument2 := webBrowser.Document as IHTMLDocument2;
for j:=0 to iDocument2.All.Length-1 do
begin
iElement2:=All.item(i,EmptyParam) as IHTMLElement2;
iElement2.detachEvent('onmouseenter', eoMouseEnter);
iElement2.detachEvent('onmouseleave', eoMouseLeave);
end;
end;
end;


procedure TForm1.OnMouseEnter;
begin
CW := Get8087CW();
System.Set8087CW($133f); // Отключаем исключения
end;

procedure TForm1.OnMouseLeave;
begin
System.Set8087CW(CW); // Восстанавливаем значение регистра
end;


  Здесь мы вешаем обработчики на события OnMouseEnter и OnMouseLeave, т.к. MSDN говорит нам, что события не всплывающие(не проходят по всей иерархии DOM до верхнего уровня), то обработчики устанавливаем на все объекты документа.  В качестве обработчика метод IHTMLDocument.AttachEvent просит объект с IDispatch, для этого реализуем TEventObject. И не забываем, что eoMouseEnter, eoMouseleave надо удалить перед закрытием формы.

Читать на сайте автора.