Еще раз об утечке атомов и баге VCL

[@Sleuthhound]

Код хука тривиален

Если так все тривиально, то наверно следовало бы привести хоть ссылки на этот код, а то одни слова…

[@MacIn]

Касаемо перехвата:

Это действительно тривиальный код — имея под руками SDK .h заголовки, процедура перехвата пишется за пол-часа.
Готовое решение можно посмотреть здесь: проект uall.
Или просто гуглить по «delphi iat hook», первые 3 результата — вполне.
Свой код привести не могу, часть коммерческого продукта, извините.

Сам код перехватчика в простейшем варианте примерно таков:

function myRegisterWindowMessageA(name: PAnsiChar): UINT; stdcall;
...
...
len := lstrlen(name);
if copy(name, 1, 10) = 'ControlOfs' then
  Result := OriginalRegisterWindowMessageA(PChar('abcd'));
else
  Result := OriginalRegisterWindowMessageA(Name);

Но его можно допилить для повышения эффективности.

[@MacIn]

В принципе, это здравая идея, но во-первых, перекомпилировать самому RTL не всегда безопасно, могут быть какие-то отличия в директивах и пр. Положиться на борландовскую RTL можно, ее все используют, и большинство ошибок отловлено. Во-вторых, могут возникнуть проблемы вида «unit was compiled with different...», т.е. объем перекомпиляции может быть большим. Ради исправления одной инструкции это нецелесообразно.

Так да — строку
RM_GetObjectInstance := RegisterWindowMessage(PChar(ControlAtomString));
Надо заменить на
RM_GetObjectInstance := RegisterWindowMessage(PChar('ControlAtomString'));

Если кто-то соберется перекомпилировать библиотеки, могут понадобиться ключи для system.pas и подобных:

dcc32.exe system.pas sysinit.pas strings.pas -JP -M -Y -Z -$D- -0 > sysbuild.log

[@Mercury13]

Лучше использовать строку 'RM_GetObjectInstance' — просто потому, что так описано на Embarcadero Quality Center. Чтобы поменьше разброда было.

[@Jef239]

Насколько я помню, как раз в Delphi 7 был неприятный баг (гонка) в WaitForThreads. Хотите совсем без багов — используйте Delphi 5.

[@MacIn]

Не приходилось использовать WaitForThreads, через WaitForMultipleObjects работаем. 7ка — и то старье, 5ка — вообще древность. Решим на работе проблему с Unicode строками, перейдем на XE.

[@MrShoor]

Замечательная бага. Правда «пофикшена» в XE5 по крайней мере точно:
RM_GetObjectInstance := RegisterWindowMessage(PChar('DelphiRM_GetObjectInstance'));
Удивительно, что по факту RM_GetObjectInstance вообще не нужен. Эта переменная лежит в имплементации юнита Control.pas и используется только в одном месте:

function ObjectFromHWnd(Handle: HWnd): TWinControl;
var
  OwningProcess: DWORD;
  ProcessId: DWORD;
begin
  ProcessId := GetCurrentProcessId;
  if (GetWindowThreadProcessId(Handle, OwningProcess) <> 0) and
     (OwningProcess = ProcessId) then
    Result := Pointer(SendMessage(Handle, RM_GetObjectInstance, ProcessId, 0))
  else
    Result := nil;
end;

ObjectFromHWnd так же только в implementation, и ниоткуда снаружи не вызывается. В самом Controls.pas он вызывается дважды:

function FindControl(Handle: HWnd): TWinControl;
var
  OwningProcess: DWORD;
begin
  Result := nil;
  if (Handle <> 0) and (GetWindowThreadProcessID(Handle, OwningProcess) <> 0) and
     (OwningProcess = GetCurrentProcessId) then
  begin
    if GlobalFindAtom(PChar(ControlAtomString)) = ControlAtom then
      Result := Pointer(GetProp(Handle, MakeIntAtom(ControlAtom)))
    else
      Result := ObjectFromHWnd(Handle);
  end;
end;

function IsDelphiHandle(Handle: HWND): Boolean;
var
  OwningProcess: DWORD;
begin
  Result := False;
  if (Handle <> 0) and (GetWindowThreadProcessID(Handle, OwningProcess) <> 0) and
     (OwningProcess = GetCurrentProcessId) then
  begin
{$IF DEFINED(CLR)}
    Result := FindControl(Handle) <> nil;
{$ELSE}
    if GlobalFindAtom(PChar(WindowAtomString)) = WindowAtom then
      Result := GetProp(Handle, MakeIntAtom(WindowAtom)) <> 0
    else
      Result := ObjectFromHWnd(Handle) <> nil;
{$ENDIF}
  end;
end;

В обоих случаях он вызывается после проверок:
GlobalFindAtom(PChar(ControlAtomString)) = ControlAtom
GlobalFindAtom(PChar(WindowAtomString)) = WindowAtom
И обе эти проверки всегда возвращают TRUE. Следовательно до вызова ObjectFromHWnd вообще никогда не доходит, а следовательно RM_GetObjectInstance вообще не нужен. Так что можете даже ничего не менять в хуке, а просто забивать болт если там есть 'ControlOfs'

Кстати в MSDN не сказано что винда не чистит атомы от RegisterWindowMessage. Я проверил на WIN7 со всеми обновлениями. Сожрал атомы и прибил процесс. Через некоторое время винда очистила хендлы, но очистила их далеко не сразу после регистрации. Так что возможно в WIN7 такая ситуация с утечкой от RegisterWindowMessage не возникает вообще. Если конечно не запускать 16К приложений делфи одновременно. :) А поскольку RM_GetObjectInstance не используется — то приложению от того что оно не смогло регнуть себе мессагу для RM_GetObjectInstance — должно быть не холодно не жарко. Должно бы быть, но это не так. Какого-то лешего разработчики Windows решили, что в принципе достаточно использовать один скоуп для RegisterClipboardFormat и RegisterWindowMessage. Соответственно если вдруг закончится эта таблица — ни одно приложение не сможет регнуть свой формат буфера обмена. Да и потом, неудача с RM_GetObjectInstance VCL не огорчит, а вот все остальные приложения в ОС будут вести себя нестабильно. Ситуацию спасает лишь то, что винда периодически (и неизвестно при каких обстоятельствах) чистит эти атомы.

[@MacIn]

ObjectFromhWnd выглядит как костыль — получение дельфийского объекта из виндового хэндла. Видимо, использовался в древности для связи WinAPI — gui кода и VCL.
Промахнулся с ответом, извините — внизу простыня -вторая часть ответа.

[@MacIn]

Да, именно. Используется только в одном месте, поэтому можно использовать тупо константу.

Кстати в MSDN не сказано что винда не чистит атомы от RegisterWindowMessage

В MSDN сказано, как я цитировал в посте:

The message remains registered until the session ends.

Я проверил на WIN7 со всеми обновлениями. Сожрал атомы и прибил процесс. Через некоторое время винда очистила хендлы, но очистила их далеко не сразу после регистрации

Атомы вообще или именно RWMовские?
На WS2008 нет очистки, мы именно на 2008м увидели это впервые. И атомы накапливались там не один день.

Какого-то лешего разработчики Windows решили, что в принципе достаточно использовать один скоуп для RegisterClipboardFormat и RegisterWindowMessage

Это тянется, наверняка, чуть не с 1.0. В третьей версии атомы такие же, насколько я помню из обсуждения этой проблемы. Так что тогда они экономили ресурсы

Да и потом, неудача с RM_GetObjectInstance VCL не огорчит

Ну, как вам сказать — сообщение-то это VCL не нужно, но вот приложение не запустится. Вообще.

Ситуацию спасает лишь то, что винда периодически (и неизвестно при каких обстоятельствах) чистит эти атомы.

Я, к сожалению, не могу этого подтвердить. MSDN утверждает, что RWM атомы живут до конца сессии, и именно это я наблюдаю.

[@MrShoor]

В MSDN сказано, как я цитировал в посте:

Упс, не заметил конца фразы.

Атомы вообще или именно RWMовские?

Именно RWM-овские. Чистилось не сразу, а через некоторое время, после того как заканчивались. Т.е. я в цикле гоняю пачку RegisterWindowMessage с рандомными именами. Когда начинает возвращать 0 — прекращаю цикл и завершаю приложение. Таким образом у меня все атомы съедены. После этого поперезапускаю процессы (там IDE перезапущу, или еще какие тяжелые процессы), и атомы вновь появляются. По крайней мере RegisterWindowMessage начинает возвращать не ноль.

На WS2008 нет очистки, мы именно на 2008м увидели это впервые. И атомы накапливались там не один день.

Это очень печально, потому что RegisterWindowMessage сделан костылем через клипборд.

Ну, как вам сказать — сообщение-то это VCL не нужно, но вот приложение не запустится. Вообще.

А у меня все запускается. Там возвращается 0, ну и дальше все типтоп.

[@MacIn]

Тут надо отметить следующее: 1)в моем случае каждое приложение регистрировало по одному RWM атому, не пачкой; 2)Приложения запускались в non-interractive session, из-под сервиса, т.е. от SYSTEM.
Может быть, в этом разница.

А у меня все запускается. Там возвращается 0, ну и дальше все типтоп.

Эм, я не совсем правильно выразился. Да, 0, но просто в последствии там еще потребуются атомы при инциализации графики, и initialization какого-то из модулей просто вылетает с out of resources. Не помню последовательность, но после controls еще что-то графическое будет инициализироваться точно.