Исправляем плохой дизайн API: функции обратного вызова без user-аргумента

Callback-функция (англ. call — вызов, англ. back — обратный) или функция обратного вызова в программировании — передача исполняемого кода в качестве одного из параметров другого кода.

См. также Разработка API (контракта) для своей DLL.

Введение в callback-функции

К примеру, если вы хотите установить таймер с использованием Windows API, вы можете вызвать функцию SetTimer, передав в неё указатель на свою функцию, которая и будет callback-функцией. Система будет вызывать вашу функцию каждый раз, когда срабатывает таймер:

procedure MyTimerHandler(Wnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD); stdcall;
begin
  // Будет вызвана через 100 мс.
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SetTimer(Handle, 1, 100, @MyTimerHandler);
end;

Вот ещё пример: если вы хотите найти все окна на рабочем столе, вы можете использовать функцию EnumWindows:

function MyEnumFunc(Wnd: HWND; lpData: LPARAM): Bool; stdcall;
begin
  // Вызывается для каждого найденного окна в системе
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  EnumWindows(@MyEnumFunc, 0);
end;

Поскольку функция обратного вызова обычно выполняет ту же задачу, что и код, который её устанавливает, то получается, что обоим кускам кода нужно работать с одними и теми же данными. Следовательно, данные от устанавливающего кода необходимо как-то передать в функцию обратного вызова. Для этой цели в функциях обратного вызова предусматриваются т.н. user-параметры: это либо указатель, либо целое число (обязательно типа Native(U)Int, но не (U)Int), который никак не используются самим API и прозрачно передаются в callback-функцию. Либо (в редких случаях) это может быть какое-то значение, уникально идентифицирующее вызов функции.

К примеру, в SetTimer есть idEvent, а в EnumWindows есть lpData. Мы можем использовать эти параметры, чтобы передать произвольные данные. Вот, к примеру, как можно найти все окна заданного класса:

type
  PEnumArgs = ^TEnumArgs;
  TEnumArgs = record
    ClassName: String;
    Windows: TStrings;
  end;

function FindWindowsOfClass(Wnd: HWND; lpData: LPARAM): Bool; stdcall;
var
  Args: PEnumArgs;
  WndClassName, WndText: String;
begin
  Args := Pointer(lpData);

  SetLength(WndClassName, Length(Args.ClassName) + 2);
  SetLength(WndClassName, GetClassName(Wnd, PChar(WndClassName), Length(WndClassName)));
  if WndClassName = Args.ClassName then
  begin
    SetLength(WndText, GetWindowTextLength(Wnd) + 1);
    SetLength(WndText, GetWindowText(Wnd, PChar(WndText), Length(WndText)));
    Args.Windows.Add(Format('%8x : %s', [Wnd, WndText]));
  end;

  Result := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Args: TEnumArgs;
begin
  // В Edit можно вводить значения типа 
  // 'TForm1', 'IME', 'MSTaskListWClass', 'Shell_TrayWnd', 'TTOTAL_CMD', 'Chrome_WidgetWin_1'
  Args.ClassName := Edit1.Text;  
  Args.Windows   := Memo1.Lines;

  Memo1.Lines.BeginUpdate;
  try
    Memo1.Lines.Clear;
    EnumWindows(@FindWindowsOfClass, LPARAM(@Args));
  finally
    Memo1.Lines.EndUpdate;
  end;
end;

Примечание: неким аналогом user-параметров являются свойства Tag и Data, хотя их использование не всегда бывает идеологически верным (правильно: создать класс-наследник).

Static и callback-методы вместо callback-функций

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Memo1: TMemo;
    Button1: TButton;

  // Переходник
  strict private
    type
      PInternalEnumArgs = ^TInternalEnumArgs;
      TInternalEnumArgs = record
        Self: TForm1;
        Data: Pointer;
      end;
    class function InternalEnumWindowsCallback(Wnd: HWND; lpData: LPARAM): Bool; stdcall; static;

  // Hi-level интерфейс
  protected
    function EnumWindowsCallback(const AWnd: HWND; const lpData: Pointer): Boolean; virtual;
    function EnumWindows(const lpData: Pointer = nil): Boolean;
  end;

// ...

function TForm1.EnumWindows(const lpData: Pointer): Boolean;
var
  Args: TInternalEnumArgs;
begin
  Args.Self := Self;
  Args.Data := lpData;

  Result := WinAPI.Windows.EnumWindows(@InternalEnumWindowsCallback, @Args);
end;

class function TForm1.InternalEnumWindowsCallback(Wnd: HWND; lpData: LPARAM): Bool;
var
  Args: PInternalEnumArgs;
begin
  Args := Pointer(lpData);

  Result := Args.Self.EnumWindowsCallback(Wnd, Args.Data);
end;

function TForm1.EnumWindowsCallback(const AWnd: HWND; const lpData: Pointer): Boolean;
var
  WndClassName, WndText: String;
begin
  // Ваш код - он может работать как с lpData, так и с членами класса.
  // К примеру:

  SetLength(WndClassName, Length(Edit1.Text) + 2);
  SetLength(WndClassName, GetClassName(Wnd, PChar(WndClassName), Length(WndClassName)));
  if WndClassName = Edit1.Text then
  begin
    SetLength(WndText, GetWindowTextLength(Wnd) + 1);
    SetLength(WndText, GetWindowText(Wnd, PChar(WndText), Length(WndText)));
    Memo1.Lines.Add(Format('%8x : %s', [Wnd, WndText]));
  end;

  Result := True;
end;

(подробнее про ключевое слово static можно почитать тут)

Здесь InternalEnumWindowsCallback служит в качестве переходника-адаптера, который конвертирует функцию stdcall в метод класса. Настоящий же callback (который и выполняет всю работу) содержится в обычном методе класса EnumWindowsCallback. Обратите внимание, что поскольку callback является методом, то он имеет доступ к свойствам и методам класса. Поэтому, как правило, callback-методы не используют user-параметры, а сами параметры читают напрямую из класса. Само собой, такой подход тем проще по сравнению с callback-функциями, чем больше параметров нужно передать и чем больше результата надо вывести - поскольку с callback-методами нам не нужно передавать каждое значение вручную через промежуточную запись. Тем не менее, в примере выше я сохранил параметр lpData для свободного использования: не исключена ситуация, когда какие-либо данные будет проще передать через параметр, а не свойства класса - как правило, это бывают локальные данные, которые рассчитываются внутри метода класса, но не сохраняются в полях класса. А если бы нам не нужно было сохранять функциональность lpData, то мы могли бы убрать тип TInternalEnumArgs, передавая Self напрямую как lpData.

Плохой дизайн API

Если дизайн API разрабатывает не слишком опытный программист, он может просто не подумать про необходимость наличия user-параметров для callback-функций (а равно как и множество других вещей). В результате у вас может быть на руках такой код:

type
  TCallback = function(FoundData: TData): BOOL; cdecl;

function RegisterCallback(Callback: TCallback): Integer; cdecl;

Как видите, здесь нет user-параметра, а единственный параметр для callback-функции представляет собственно данные для функции.

Решение в лоб: глобальные переменные

Само собой, поскольку разработчик API - не вы, то и изменить прототип функции обратного вызова вы не можете. Что же делать? Поскольку мы не можем передавать данные через локальный параметр, то остаётся только вариант с глобальным параметром:

var
  GMemo: TStrings;

function MyCallback(FoundData: TData): BOOL; cdecl;
begin
  GMemo.Lines.Add(DataToString(FoundData));
end;

function TForm1.Button1Click(Sender: TObject);
begin
  GMemo := Memo1;
  RegisterCallback(MyCallback);
end;

Конечно, мы можем сделать callback-функцию членом класса, как мы делали это выше (с помощью статических классовых методов), но надо понимать, что в этом варианте API callback-метод должен быть классовым, а не обычным, а переменная тоже должна быть классовой, а не полем класса - поскольку мы не можем передать Self через user-параметр. А следовательно, это будут всё те же глобальные функция и переменная, но немного замаскированные. Соответственно, обращаться к свойствам и методам класса из callback-а мы не сможем.

Данное решение можно рассматривать как "удовлетворительное", поскольку оно в принципе работает, но использует глобальные переменные - что плохо. Иногда это может быть допустимо, но часто нам необходимо вызывать callback-функции многопоточно или даже просто в несколько разных вызовов в рамках одного потока. В этом случае кажется, что надёжного способа идентификации нет?

Правильное решение: динамический код

Тем не менее, опытный программист может предложить гарантировано рабочий вариант, "добавляющий" user-параметр к существующему "плохому" API. Это вовсе не невыполнимая задача, как может показаться, но её решение достаточно нетривиально. Суть идеи в том, что user-параметр можно заменить на саму функцию обратного вызова, которая будет уникальна для каждого использования. Таким образом, вызов функции будет идентифицироваться не по параметру, а по тому, какая из функций вызвана.

Постановка задачи

Само собой, в предварительно скомпилированном файле невозможно иметь произвольное число функций для произвольных user-параметров. И именно поэтому это решение требует генерации кода на лету. К счастью, это не слишком сложная задача, поскольку вы можете воспользоваться услугами компилятора Delphi для генерации шаблона. Более того - вы можете даже не знать ассемблер. Но вам нужно иметь некоторое представление об устройстве памяти Windows.

Итак, пусть у нас есть следующее:

type
  TData                   = Integer; // просто для примера; это может быть что угодно: указатель, запись и т.п.
  TCallback               = function(FoundData: TData): BOOL; cdecl;
  TRegisterCallbackFunc   = function(Callback: TCallback): Integer; cdecl;
  TUnregisterCallbackFunc = procedure(Callback: TCallback); cdecl;
var
  RegisterCallback: TRegisterCallbackFunc;      // импортируется из DLL
  UnregisterCallback: TUnregisterCallbackFunc;  // импортируется из DLL

Это - наш "плохой" API. Поскольку сторонний API обычно располагается в отдельной DLL, то я сделал пример с переменной-функцией, а не обычной функцией. В любом случае, если у вас есть обычная функция (API лежит в отдельном модуле, есть dcu, но не pas), то этот случай легко сводится к примеру выше. Итак, наша задача: добавить в этот API поддержку user-параметра.

Создание мастер-шаблона

Шаг первый: пишем следующий код:

function RealCallback(FoundData: TData; Data: Pointer): BOOL; cdecl;
begin
  Result := True;
end;

type
  TRealCallbackFunc = function(FoundData: TData; Data: Pointer): BOOL; cdecl;
var
  GRealCallback: TRealCallbackFunc = RealCallback;

function InternalCallback(FoundData: TData): BOOL; cdecl;
begin
  Result := GRealCallback(FoundData, Pointer($12345678));
end;

Здесь: InternalCallback - это callback-функция, прототип которой полностью соответствует API. Именно её мы будем устанавливать в качестве callback-а. RealCallback - это модифицированная callback-функция, которая отличается от API лишь наличием дополнительного параметра: это и есть наш user-параметр. Хотя прототип RealCallback может быть произвольным, но для упрощения нашей жизни желательно, чтобы он был бы максимально похожим на InternalCallback. Сама InternalCallback должна просто вызывать RealCallback, передавая фиксированный указатель в качестве параметра. Значение $12345678 выбрано по той простой причине, что его легко будет увидеть. Вы можете использовать любое другое "волшебное" значение.

Функция RealCallback из InternalCallback вызывается не напрямую, а опосредованно - через глобальную переменную GRealCallback. Я поясню ниже зачем это сделано.

Итак, добавьте прямой вызов InternalCallback в ваш код:

procedure TForm1.Button1Click(Sender: TObject);
begin
  InternalCallback(0); // здесь: TData = Integer (для этого примера)
end;

и установите на него точку останова. Запустите проект, нажмите кнопку, встаньте на точку останова, зайдите в функцию InternalCallback (F7) и откройте CPU-отладчик (Ctrl + Alt + C или View / Debug Windows / CPU View). Вы увидите такой код:

Unit1.pas.38: begin
005B5C7C 55               push ebp
005B5C7D 8BEC             mov ebp,esp
005B5C7F 51               push ecx
Unit1.pas.39: Result := GRealCallback(FoundData, Pointer($12345678));
005B5C80 6878563412       push $12345678
005B5C85 8B4508           mov eax,[ebp+$08]
005B5C88 50               push eax
005B5C89 FF15A0395C00     call dword ptr [$005c39a0]
005B5C8F 83C408           add esp,$08
005B5C92 8945FC           mov [ebp-$04],eax
Unit1.pas.40: end;
005B5C95 8B45FC           mov eax,[ebp-$04]
005B5C98 59               pop ecx
005B5C99 5D               pop ebp
005B5C9A C3               ret

Выделите этот код и скопируйте куда-нибудь (не нужно его запускать!). Вы можете увидеть, что весь код состоит из трёх строк: begin (он же - пролог), вызов функции, end (он же - эпилог). Каждая строка помечена комментарием. Если вы не знаете ассемблер, то всё, что вам нужно знать: первый столбец это адреса инструкций. Эти адреса принадлежат вашему exe (ведь именно код exe мы вызвали по Button1Click). Второй столбец: hex-коды байтов кода. Т.е. это машинный код в чистом виде. Третий столбец - это ассемблерный код, соответствующий машинному коду. Самое замечательное в этом листинге - нам не нужен ассемблерный код, нам нужен лишь машинный код. Сейчас я поясню почему...

Теперь смотрим: в этой функции есть всего два переменных значения:

1. Адрес вызываемой функции (RealCallback)
2. Значение user-параметра

Весь остальной текст статичен и не зависит ни он чего, т.е. он будет ровно тем же самым в любых случаях: для любых user-параметров, для любых callback-функций. Это означает, что если мы хотим сами генерировать функции, подобные InternalCallback, то мы можем просто скопировать весь код целиком и просто подставить в него два числа: адрес функции и адрес параметра.

User-параметр легко увидеть, поскольку мы использовали волшебное значение $12345678. Адрес функции увидеть сложнее (если вы не знакомы с ассемблером), но можно догадаться, что он зашифрован в этой строке:

005B5C89 FF15A0395C00     call dword ptr [$005c39a0]

Почему?

1. Слово call намекает на "вызов".
2. Адрес $005C39A0 явно лежит недалеко от адресов $005B5C7C-$005B5C9A, т.е. это какой-то код в exe.

Поскольку наш Паскаль-код вызывает функцию не напрямую, а через глобальную переменную, то легко предположить, что $005C39A0 - это адрес не самой функции, а адрес указателя на функцию.

Примечание: вот почему я использовал конструкцию с опосредованным вызовом функции вместо прямого: потому что в этой конструкции вызов задаётся как "вызвать функцию по этому адресу". Здесь явно присутствует "этот адрес" - что означает, что его можно легко поменять. Если бы вызов был прямым, то машинный код говорил бы "вызвать функцию, которая лежит перед этой через N байтов". Задавать адрес функции в таком варианте было бы намного сложнее.

Вот и всё, что касается разбора шаблона. Обратите внимание, что мы не использовали никаких особенных знаний, кроме умения пользоваться отладчиком и здравого смысла.

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

55
8BEC
51
6878563412    // $12345678 - user-параметр
8B4508
50
FF15FFEEDDCC  // $CCDDEEFF - указатель на функцию
83C408
8945FC
8B45FC
59
5D
C3

Напоминаю, что не нужно руками выписывать эти коды - выделите в CPU-отладчике мышью нужные строки и нажмите Ctrl + C - это скопирует выделенные строки в буфер обмена. Затем перейдите в редактор кода и вставьте текст из буфера, после чего удалите три строки с комментариями, а также первый и последний столбцы, оставив только машинный код.

Обратите внимание, что x86 является little-endian архитектурой - что означает, что все числа "записываются наоборот".

После этого я убрал разделители строк, объединив весь машинный код в длинный поток байтов:

558BEC5168785634128B450850FF15FFEEDDCC
83C4088945FC8B45FC595DC3

(я разбил на две строки для упрощения читабельности в блоге, в редакторе это одна строка)

После чего я вставил #$ через каждые два символа и оформил эту константу как строку:

const
  CallbackTemplate: RawByteString =
    #$55#$8B#$EC#$51#$68#$78#$56#$34#$12#$8B#$45#$08#$50#$FF#$15#$FF#$EE#$DD#$CC +
    #$83#$C4#$08#$89#$45#$FC#$8B#$45#$FC#$59#$5D#$C3;

Почему строку? Ну, это проще и короче, чем настоящий массив байтов: не надо вставлять пробелы, запятые, не надо указывать размерность массива. Кроме того, для строк есть готовая функция поиска и замены (мы увидим позднее почему это важно). Строка однобайтовая, без кодировки (RawByteString - это AnsiString в старых версиях Delphi) - поэтому эта строка является массивом байтов.

Теперь неплохо бы проверить, что мы нигде не ошиблись. Измените обработчик нажатия на кнопку следующим образом:

procedure TForm1.Button1Click(Sender: TObject);
begin
  TCallback(Pointer(CallbackTemplate))(0);
end;

Этой странной строкой мы говорим, что указатель CallbackTemplate (а любая строка - это указатель; для статического массива вам потребовалось бы брать указатель явно через @) следует трактовать не как строку, а как функцию типа TCallback. Ну и эту функцию, стало быть, надо вызвать. Вот более длинная версия того же кода:

procedure TForm1.Button1Click(Sender: TObject);
var
  Template: AnsiString;
  Ptr: Pointer;
  CB: TCallback;
begin
  Template := CallbackTemplate;
  Ptr := Pointer(Template);
  CB := TCallback(Ptr);
  CB(0);
end;

Установите точку останова на вызов функции (в любом варианте - длинном или коротком), запустите программу, нажмите кнопку, встаньте на точке останова. Не нажимайте F7: поскольку для функции закодированной в CallbackTemplate отсутствует исходный код, то компилятор выполнит всю функцию целиком за один проход - что приведёт к Access Violation, поскольку оба наших указателя ($12345678 и $CCDDEEFF) указывают в космос. Вместо этого вызовите CPU отладчик (Ctrl + Alt + C или View / Debug Windows / CPU View) и несколько раз нажмите F7 уже в нём - пока вас не перебросит к знакомому коду:

005B5C74 55               push ebp
005B5C75 8BEC             mov ebp,esp
005B5C77 51               push ecx
005B5C78 6878563412       push $12345678
005B5C7D 8B4508           mov eax,[ebp+$08]
005B5C80 50               push eax
005B5C81 FF15FFEEDDCC     call dword ptr [$ccddeeff]
005B5C87 83C408           add esp,$08
005B5C8A 8945FC           mov [ebp-$04],eax
005B5C8D 8B45FC           mov eax,[ebp-$04]
005B5C90 59               pop ecx
005B5C91 5D               pop ebp
005B5C92 C3               ret 

Убедитесь, что этот фрагмент точно совпадает с исходным кодом (разве что с изменённым адресом на $CCDDEEFF). Если совпадает, то вы всё сделали верно, шаблон готов. Если нет - исправьте и будьте в дальнейшем более внимательны.

Динамическая генерация кода

Следующий шаг - нам необходимо создавать реальные функции обратного вызова (с реальными адресами) по шаблону CallbackTemplate. Собственно, сделать это очень просто - достаточно просто заменить адреса функций и код готов. Есть только небольшая особенность: в архитектуре x86 любой исполняемый код должен располагаться в странице памяти, имеющей атрибут выполнения (EXECUTE). Если мы просто выделим память (GetMem/AllocMem или просто используем строку, массив и другие данные), то это будут "данные": у них будет доступ на чтение (READ), запись (WRITE), но не выполнение (EXECUTE). Поэтому попытка вызова этого кода приведёт к Access Violation.

Примечание: на ранних процессорах архитектуры x86 атрибуты "чтение" и "выполнение" были эквивалентными. Поэтому, хотя технически ставить равенство между ними никогда не было верным, некоторые воспользовались этой особенностью реализации и передавали управление на код в сегментах данных. Повторим: это никогда не было корректным, но это работало на старых процессорах. Теперь этот код будет вылетать. См. также: DEP.

Вспомним как работает менеджер памяти: он дробит страницы памяти на блоки, которые программа "выделяет" из памяти. Отсюда следует, что мы не можем просто взять память средствами языка Delphi и изменить ей атрибуты: эта память будет расположена в одной странице с какими-то другими данными, и, меняя доступ к странице, мы поменяем доступ к каким-то ещё данным. По этой причине нам необходимо выделять память напрямую у системы, минуя посредников.

Суммируя сказанное, вот подходящий код:

unit FixCallbacks;

interface

// Функция динамически генерирует код для вызова
// функции ACallback с параметром AUserParam по известному шаблону машинного кода ATemplate
// Шаблон ATemplate должен использовать значения $12345678 и $CCDDEEFF как заглушки
// для передачи AUser и указателя на ACallback соответственно
// Результат работы функции можно передавать в "плохой" API
function AllocTemplate(const ATemplate: RawByteString; const ACallback, AUserParam: Pointer): Pointer;

// Функция освобождает шаблон, созданный функцией AllocTemplate
// В неё необходимо передать те же параметры, что и в AllocTemplate
// Функция вернёт указатель, который необходимо передать в функцию дерегистрации "плохого" API
function DisposeTemplate(const ACallback, AUser: Pointer): Pointer;

implementation

uses
  Winapi.Windows, 
  System.SysUtils, 
  System.Classes;

var
  // Список всех динамически сгенерированных кусков кода
  KnownTemplates: TThreadList;

function AllocTemplate(const ATemplate: RawByteString; const ACallback, AUserParam: Pointer): Pointer;

  procedure StrReplace(var ATemplate: RawByteString; const ASource, ADest: NativeUInt);
  var
    X: Integer;
  begin
    for X := 1 to Length(ATemplate) - SizeOf(ASource) do
      if PNativeUInt(@ATemplate[X])^ = ASource then
      begin
        PNativeUInt(@ATemplate[X])^ := ADest;
        Break;
      end;
  end;

var
  OrgPtr: Pointer;
  OrgSize: Cardinal;
  Ptr: PPointer;
  ActualTemplate: RawByteString;
  Dummy: Cardinal;
begin
  // Шаг первый: выделяем ресурсы

  // Взяли шаблон
  ActualTemplate := ATemplate;
  // Выделили память для динамической генерации кода
  // Добавили размер указателя, т.к. нам нужно куда-то сохранять указатель на ACallback
  // Второй указатель нужен для удобства: в него мы сохраним user-параметр (см. DisposeTemplate ниже)
  // Атрибуты страницы: чтение + запись - поскольку сначала нам нужно записать туда код
  OrgSize := Length(ATemplate) + SizeOf(Pointer) * 2;
  OrgPtr := VirtualAlloc(nil, OrgSize, MEM_COMMIT or MEM_RESERVE, PAGE_READWRITE);
  Win32Check(Assigned(OrgPtr));
  Ptr := OrgPtr;

  // Шаг второй: готовим данные

  // Подменяем в шаблоне заглушки на реальные данные
  // Блок начнётся с самого указателя на функцию, а машинный код пойдёт за ним,
  // поэтому в качестве "указателя на указатель на функцию" будет выступать сам Ptr
  StrReplace(ActualTemplate, $12345678, NativeUInt(AUserParam));
  StrReplace(ActualTemplate, $CCDDEEFF, NativeUInt(Ptr));

  // Шаг третий: копируем данные

  // Раз блок начинается с указателя на функцию, то сначала сохраняем указатель
  Ptr^ := ACallback;
  Inc(Ptr);
  // Затем - user-параметр
  Ptr^ := AUserParam;
  Inc(Ptr);
  // Наконец, копируем готовый машинный код в место его выполнения (сразу за указателем)
  Move(Pointer(ActualTemplate)^, Ptr^, Length(ActualTemplate));

  // Шаг четвёртый: делаем код кодом

  // Меняем атрибуты страницы на "чтение + выполнение"
  // "Чтение" необходимо по той причине, что мы храним в этом же блоке указатель на функцию -
  // а его (указатель) читает код. Соответственно, без доступа на чтение код вылетит с AV.
  Win32Check(VirtualProtect(OrgPtr, OrgSize, PAGE_EXECUTE_READ, Dummy));
  // Не забываем про многоядерные процессоры: надо указать, что мы модифицировали исполняемый код
  Win32Check(FlushInstructionCache(GetCurrentProcess, OrgPtr, OrgSize));

  // Шаг пятый: возвращаем результат

  Result := Ptr;
  // Сохраняем результат в списке сгенерированных callback-функций.
  // Это необходимо, чтобы DisposeTemplate могла найти динамический шаблон по статическому
  KnownTemplates.Add(Ptr);
end;

function DisposeTemplate(const ACallback, AUser: Pointer): Pointer;
// AllocTemplate возвращает указатель на машинный код -
// что на SizeOf(Pointer) * 2 ( = SizeOf(TSavedTemplate)) байт дальше начала блока памяти.
// Соответственно, нам сначала нужно найти реальный указатель блока памяти.
type
  PSavedTemplate = ^TSavedTemplate;
  TSavedTemplate = packed record
    Callback, User: Pointer;
  end;
var
  List: TList;
  X: Integer;
  SavedTemplate: PSavedTemplate;
begin
  Result := nil;
  if ACallback = nil then
    Exit;

  SavedTemplate := nil;

  // Ищем динамический шаблон по статическому
  // Необходимо заблокировать список на время работы, т.к. у нас не атомарная операция
  List := KnownTemplates.LockList;
  try
    for X := 0 to List.Count - 1 do
    begin
      SavedTemplate := List[X];

      // Ещё раз: мы храним сдвинутые указатели, начало блока находится на два указателя ранее
      Dec(SavedTemplate);

      // Нашли шаблон?
      if (SavedTemplate.Callback = ACallback) and
         (SavedTemplate.User = AUser) then
      begin
        // Вернём указатель на динамический шаблон для его разрегистрации
        Result := List[X];
        // Сначала удаляем его из списка...
        List.Delete(X);
        Break;
      end
      else
        SavedTemplate := nil;
    end;
  finally
    KnownTemplates.UnlockList;
  end;

  if SavedTemplate = nil then
    Exit;

  // ...а затем - освобождаем память
  Win32Check(VirtualFree(SavedTemplate, 0, MEM_RELEASE));
end;

initialization
  KnownTemplates := TThreadList.Create;
finalization
  FreeAndNil(KnownTemplates);
end.

Данный модуль предлагает две универсальные функции для динамической генерации кода переходников callback-функций. Логика кода достаточно понятно расписана в комментариях, поэтому я не буду её описывать отдельно.

С этими функциями мы можем переделать интерфейсный модуль для "плохого" API следующим образом:

// ...

interface

// ...

type
  TData                   = Integer; // осталось как было

  // Новый тип - как замена TCallback, но с добавленным lpUser
  TRealCallback           = function(FoundData: TData; const lpUser: Pointer): BOOL; cdecl;

// Новые функции - как замена старых, но с добавленным lpUser
function  RegisterCallback(const Callback: TRealCallback; const lpUser: Pointer): Integer;
procedure UnregisterCallback(const Callback: TRealCallback; const lpUser: Pointer);

implementation

uses 
  FixCallbacks; // подключаем "волшебные" функции
 
// Старые декларации скрыли в implementation
type
  TCallback               = function(FoundData: TData): BOOL; cdecl;
  TRegisterCallbackFunc   = function(Callback: TCallback): Integer; cdecl;
  TUnregisterCallbackFunc = procedure(Callback: TCallback); cdecl;
var
  InternalRegisterCallback: TRegisterCallbackFunc;
  InternalUnregisterCallback: TUnregisterCallbackFunc;

function RegisterCallback(const Callback: TRealCallback; const lpUser: Pointer): Integer;
var
  UniqueCallback: TCallback;
begin
  UniqueCallback := TCallback(AllocTemplate(CallbackTemplate, @Callback, lpUser));
  Result := InternalRegisterCallback(UniqueCallback);
end;

procedure UnregisterCallback(const Callback: TRealCallback; const lpUser: Pointer);
begin
  InternalUnregisterCallback(TCallback(DisposeTemplate(@Callback, lpUser)));
end;

// ...

И тогда мы можем написать такой код:

function MyCallback(FoundData: TData; const lpUser: Pointer): BOOL; cdecl;
var
  Self: TForm1;
begin
  Self := TForm1(lpUser);
  Self.Memo1.Lines.Add(IntToStr(FoundData));

  Result := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  RegisterCallback(MyCallback, Pointer(Self));
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  UnregisterCallback(MyCallback, Pointer(Self));
end;

Вуаля! Магия!

Обратите внимание, что функции AllocTemplate и DisposeTemplate являются универсальными и никак не зависят от вашего кода. Чтобы проиллюстрировать эту универсальность - давайте перепишем наш пример поиска окон заданного класса через EnumWindows так, чтобы он не использовал бы user-параметр функции EnumWindows. Для этого нам нужно составить шаблон. Пишем код:

function RealFindWindowsOfClass(Wnd: HWND; lpData: LPARAM; User: Pointer): Bool; stdcall;
begin
  Result := True;
end;

type
  TFindWindowsOfClassFunc = function(Wnd: HWND; lpData: LPARAM; User: Pointer): Bool; stdcall;
var
  GFindWindowsOfClass: TFindWindowsOfClassFunc = RealFindWindowsOfClass;

function FindWindowsOfClass(Wnd: HWND; lpData: LPARAM): Bool; stdcall;
begin
  Result := GFindWindowsOfClass(Wnd, lpData, Pointer($12345678));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  FindWindowsOfClass(0, 0);
end;

Получаем такой ассемблерный листинг:

Unit44.pas.40: begin
005B5CE4 55               push ebp
005B5CE5 8BEC             mov ebp,esp
005B5CE7 51               push ecx
Unit44.pas.41: Result := GFindWindowsOfClass(Wnd, lpData, Pointer($12345678));
005B5CE8 6878563412       push $12345678
005B5CED 8B450C           mov eax,[ebp+$0c]
005B5CF0 50               push eax
005B5CF1 8B4508           mov eax,[ebp+$08]
005B5CF4 50               push eax
005B5CF5 FF15A0395C00     call dword ptr [$005c39a0]
005B5CFB 8945FC           mov [ebp-$04],eax
Unit44.pas.42: end;
005B5CFE 8B45FC           mov eax,[ebp-$04]
005B5D01 59               pop ecx
005B5D02 5D               pop ebp
005B5D03 C20800           ret $0008

Вырезаем машинный код и делаем его константой (не забыв заменить 005C39A0 на CCDDEEFF):

const
  EnumWndTemplate: RawByteString =
   #$55#$8B#$EC#$51#$68#$78#$56#$34#$12#$8B#$45#$0C#$50#$8B#$45#$08#$50#$FF#$15#$FF#$EE#$DD#$CC +
   #$89#$45#$FC#$8B#$45#$FC#$59#$5D#$C2#$08#$00;

Всё готово, можно вызывать:

function FindWindowsOfClass(Wnd: HWND; lpData: LPARAM; User: Pointer): Bool; stdcall;
var
  Self: TForm1;
  WndClassName, WndText: String;
begin
  Self := TForm1(User);

  SetLength(WndClassName, Length(Self.Edit1.Text) + 2);
  SetLength(WndClassName, GetClassName(Wnd, PChar(WndClassName), Length(WndClassName)));
  if WndClassName = Self.Edit1.Text then
  begin
    SetLength(WndText, GetWindowTextLength(Wnd) + 1);
    SetLength(WndText, GetWindowText(Wnd, PChar(WndText), Length(WndText)));
    Self.Memo1.Lines.Add(Format('%8x : %s', [Wnd, WndText]));
  end;

  Result := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  EnumWndTemplate: RawByteString =
   #$55#$8B#$EC#$51#$68#$78#$56#$34#$12#$8B#$45#$0C#$50#$8B#$45#$08#$50#$FF#$15#$FF#$EE#$DD#$CC +
   #$89#$45#$FC#$8B#$45#$FC#$59#$5D#$C2#$08#$00;
var
  CustomizedCallback: Pointer;
begin
  CustomizedCallback := AllocTemplate(EnumWndTemplate, @FindWindowsOfClass, Pointer(Self));
  try
    Memo1.Lines.BeginUpdate;
    try
      Memo1.Lines.Clear;
      EnumWindows(CustomizedCallback, 0);
    finally
      Memo1.Lines.EndUpdate;
    end;
  finally
    DisposeTemplate(@FindWindowsOfClass, Pointer(Self));
  end;
end;

Вот и всё, что я хотел сегодня сказать.

ВАЖНОЕ ПРИМЕЧАНИЕ

Подход, описанный в этой статье, является хаком. Это означает, что это - костыль, обходной путь, способ заставить код работать хоть как-то. Это не оправдание для написания "плохого" кода API. Если у вас есть контроль над прототипами callback-функций - измените их! Введите поддержку user-параметров.

См. также Разработка API (контракта) для своей DLL.

P.S. Глобальный список в KnownTemplates не является обязательным. Вполне можно обойтись без него. Для этого вызывающий должен сохранять результат вызова AllocTemplate, а затем передавать его в DisposeTemplate (вместо тех же аргументов, как это сделано сейчас). Тогда список был бы не нужен, потому что DisposeTemplate смогла бы извлечь указатель на освобождаемый блок из своего аргумента. Этот сценарий удобен в случае кода как в примере с EnumWindows: нам достаточно передать CustomizedCallback в DisposeTemplate - и это совершенно не накладно. Почему же я сделал список? Потому что такой подход накладывает обязанность хранения указателя на вызывающего. Посмотрите сценарий с интерфейсным модулей для "плохого" API. Если мы хотим в точности сохранить интерфейс кода, то мы не можем передать вызывающему указатель. Вот почему нам и потребовался список. Если же вы готовы пойти на изменение интерфейса заголовочных модулей "плохого" API, то вы вполне можете отказаться от списка. Тогда DisposeTemplate будет выглядеть так:

// ATemplate - указатель, возвращённый функцией AllocTemplate
procedure DisposeTemplate(ATemplate: Pointer);
begin
  if ATemplate = nil then
    Exit;

  ATemplate := Pointer(NativeUInt(ATemplate) - SizeOf(Pointer) * 2);
  if ATemplate = nil then
    Exit;

  Win32Check(VirtualFree(ATemplate, 0, MEM_RELEASE));
end;

А из функции AllocTemplate надо будет убрать строку с добавлением в KnownTemplates, после чего все упоминания KnownTemplates можно также удалить (а заодно - удалить модуль Classes из uses).