    ГЛАВА           32 

    Катание на санках 

    Дэвид Пауэл 

    -- Что такое "санки" 
    Информация о вызовах между 32- и 16-разрядным кодами и их назначении. 
    -- Виды "санок" 
    "  Три типа вызовов и поддерживающие их платформы. 
    -- Примеры 
    Здесь приведен пример 32разрядного приложения, использующего 16-разрядную DLL. 

    От редактора. Просим вас не удивляться введенному здесь термину санки. 
Дело в том, что дословно перевести термин thunk на русский язык просто 
невозможно, поэтому мы решили воспользоваться близким по звучанию рус- . ским 
словом санки, тем более что вызов 16-разрядного кода из 32-разрядного и 
наоборот сильно напоминает катание на санках с горки, а само написание такого 
перехода — подъем на крутую гору. Что ж, любишь кататься — люби и саночки возить! 
    Очень часто при переносе приложений с 16-разрядной платформы на 
32-разрядную программисты сталкиваются с необходимостью использовать код в 
16-разрядной DLL, 32-разрядный вариант которой недоступен (что чаще всего 
случается при использовании DLL независимого производителя). Подобная ситуация 
возникает, когда 32разрядная DLL должна использоваться приложениями обоих 
типов. Решить эту задачу можно с помощью санок. 
   
    733 


    Типы санок 

    Катание на санках (thunking) — это вызов 16-разрядным приложением 
32-разрядной DLL и наоборот. Санки представляют собой фрагмент кода, 
реализующий один из трех доступных типов вызовов. В табл. 32.1 перечислены 
типы санок и поддерживающие их платформы. 

    Таблица 32.1. Типы санок 

    Универсальные	Общие		Линейные 

    Платформа	16^32 32^16 ;	16^32	32^16	16Ф32	32Ч>16 

    Win32s	Да* Да	Нет	Нет	Нет	Нет 
    Windows NT	Нет Нет	Да	Нет	Нет	Нет 
    Windows 95	Нет Нет	Да	Нет i Да	Да 
    * Официально	не поддерживается. |		i 
    ' 

    Универсальные санки 

    Универсальные санки (Universal ThunK) поддерживаются только Win32s, что 
явно делает их не такими уж универсальными, как может показаться из названия. 
В Win32s все приложения (и 16-, и 32-разрядные) запускаются в одном адресном 
пространстве и могут взаимодействовать между собой с помощью универсальных 
санок. Два основных вызова API для их использования (UTRegister и 
UTUnRegister) экспортируются из модуля KERNEL32. Поскольку Delphi 3.0 не 
предназначена для работы под Win32s, в этой главе об универсальных санках 
больше не будет сказано ни слова. Не в свои сани не садись! 

    Общие санки 

    Общие санки (Generic ThunK) предоставляют доступ из 16-разрядного кода к 
32-разрядной DLL в Windows 95 и в Windows NT. К сожалению, они не позволяют 
вызывать 16-разрядную DLL из 32-разрядного приложения. Общие санки, помимо 
предоставления доступа к 32-разрядной DLL, позволяют вызывать функции Win32 
API, среди которых множество новых вызовов для работы с Common Controls в 
Windows 95 и Windows NT. При этом допускается использование строки состояния, 
управляющего элемента заголовка и других элементов 16-разрядных приложений. 
Общие санки документированы и описаны во многих книгах по Delphi 2.0 и 
журналах, вышедших в свет после выпуска этой версии Delphi. Изобилие 
литературы, посвященной этой теме, позволяет мне не описывадьдодгюбно 
конструкцию этих^санок. 

    Линейные санки 

    Линейные санки (Flat ThunK) позволяют вызывать как 32-разрядный код из 
16-разрядного, так и 16-разрядный код из 32-разрядного. Это волшебный сон, 
который немедленно превращается в кошмар. Действительно, трудно усидеть на 
линейных санках, если вы, конечно, сможете их вообразить. Прежде всего, они 
поддерживаются только в Windows 95. Вторая неприятность, согласно документации 
Microsoft, в том, что для них требуется санный компилятор. Этот компилятор, 
называемый THUNK. ЕХЕ, получает сценарий санок, который нужно подготовить 
вручную (вместе с вашими ЕХЕ и DLL), и перекомпилирует их, делая возможной их 
совместную работу. 
    К счастью, для нормальных героев есть способ пойти в обход (конечно же, 
недокументированный, зато позволяющий отказаться от навязчивого сервиса 
компилятора санок). 6 книге Секреты системного программирования в Windows 95 
Мэтт Питрек (Matt Pietrek) описал вызов API QT Thunk. Именно его использует 
компилятор санок в своей работе. Если вы не планируете применять свою 
программу под Windows NT, этот путь—для вас! Пример использования QT_Thunk 
привечен ниже в этой главе. 

    Что делать? 

    Риторический вопрос сейчас относится к разработке программ, вынужденных 
работать под Windows NT, в которой не поддерживается ни один метод вызова 
16-разрядного кода из 32-разрядного. Есть только призрачная надежда на 
использование сообщения WM_COPYDATA. Это не метод катания на санках, а если и 
метод, то по асфальту, так как все, что вы реально можете сделать,— передать 
данные из 32-разрядного приложения в 16-разрядную DLL. Но и это еще не все: 

    734                                       Часть VI. Сложный материал 

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

    Использование сообщения WM_COPYDATA 

    Сообщение WM_COPYDATA передает данные из одного процесса в другой 
(разрядность при этом значения не имеет). Передающее приложение посылает 
дескриптор получателя в параметре wparam и указатель на структуру 
TCopyDataStruct — в Iparam. Приложение-получатель имеет возможность доступа к 
данным и отсылает при необходимости такое же сообщение назад. Все необходимые 
меры по превращению указателей 0:32 в 16:16 и наоборот Windows принимает 
самостоятельно. Ниже приведено описание объекта TCopyDataStruct. 

    PCopyDataStruct = ''TCopyDataStruct; 
    TCopyDataStruct = packed record 
    dwData: DWORD; 
    cbData: DWORD; 
    IpData: pointer; 
    end; 

    Параметр dwData может использоваться для данных, определяемых 
пользователем. Параметр cbData содержит размер двоичных данных, на которые 
указывает IpData. 

    Совет 1 
    При передаче сообщения WM_COPYDATA используйте функцию SendMessage, а не 
Post.M.e.ssage, так как необходима приостановить выполнение программы до 
возврата из функции SendMessage. 

    Предположим, что 32-разрядное приложение должно отослать запись в 
16-разрядное. Запись содержит три поля разного типа. 16-разрядная программа 
должна корректно вывести поля на экран. В реальной жизни 16разрядное 
приложение должно будет получить данные и вызвать другое 16-разрядное 
приложение для их обработки, однако в качестве примера вполне подойдет и 
первый сценарий, так как нас интересует именно передача данных. В листинге 
32.1 приведен пример такого 32-разрядного приложения, которое находится на 
дополнительно распространяемой дискете. 

    Листинг 32.1. \UDELPHI3\CHP32\WMCOPYDATA\CPYDAT32. РАЗ. 32-разрядное 
приложение - источник данных 

    unit CpyDat32; 
    interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; 
    type 
    TCopy32 = class(TForm) 
    Labell: TLabel; 
    Label2: TLabel; 
    Label3: TLabel; 
    Send: TButton; 
    Editi: TEdit; 
    Edit2: TEdit; 
    Edit3: TEdit; 
    procedure SendClick(Sender: TObject) ; 
    private 
    { Private declarations ) 
    public 
    { Public declarations } 
    end; 
    var 
    Copy32: TCopy32; 


    Глава 32. Катание на санках                                           735 


    implementation 
    {$R *.DFM) 
    type 
    TMyRec = packed record 
    Fl : Smallint;   // 16-битовое целое. 
    F2 : Double; 
    F3 : String[20]; 
    end; 
    procedure TCopy32.SendClick(Sender: TObject); 
    var 
    RecSize: integer; 
    MyRec: TMyRec; 
    CopyDataStruct: TCopyDataStruct; 
    TargetWnd: hWnd; 
    begin 
    //Примечание. Не выполняются никакие проверки при переносе данных 
    //из поля ввода в поля записи. 
    //Получаем hWnd 16-битового приложения. 
    TargetWnd := Findwindow(nil,'16-bit Receiving Application'); 
    //Заполняем структуру данных. 
    RecSize := SizeOf(TMyRec) ; 
    with CopyDataStruct, MyRec do begin 
    Fl := StrToInt(Editl.Text) ; 
    F2 := StrToFloat(Edit2.Text); 
    F3 := Edit3.Text; 
    dwData := 5; // Помещаем сюда все, что хотим. 
    cbData := RecSize; 
    IpData := @MyRec; 
    end; 
    // Посылаем сообщение WM_CopyData. 
    SendMessage(TargetWnd, WM_COPYDATA, Handle, Longint(SCopyDataStruct)) ; 
    end; 
    end. 

    В Delphi 1.0 сообщения WM_COPYDATA и структура TCopyDataStruct доступны 
16-разрядному приложению в Win32s, однако не определены ни в WINPROC, ни в 
WINTYPES, а потому они должны быть определены в самом приложении. В листинге 
32.2 приведен приблизительный исходный текст такого приложения. 

    Листинг 32.2. \UDELPHI3\CHP32\WMCOPYDATA\CPYDAT16. PAS. 16-разрядное 
приложение - приемник данных 

    unit Cpydatl6; 
    interface 
    uses 
    SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 
Forms, Dialogs, StdCtrls; 
    const 
    (Определяем константу WM_COPYDATA.) WM_COPYDATA = $004A; 
    type 
    TCopyl6 = class(TForm) Editi: TEdit; 


    736                                       Часть VI. Сложный материал 


    Edit2: TEdit; 
    Edit3: TEdit; 
    Labell: TLabel; 
    Label2: TLabel; 
    Label3: TLabel; 
    Edit4: TEdit; 
    Label4: TLabel; 
    private 
    ( Private declarations ) 
    procedure WMCopyData(var M: TMessage); message WM_COPYDATA; 
    public 
    { Public declarations } 
    end; 
    var 
    Copy 16: TCopyl6; 
    implementation 
    ($R *.DFM) 
    type 
    PMyRec = ^TMyRec; 
    TMyRec = packed record 
    Fl : Integer;  {Соответствует 32-битовому Smalllnt.) 
    F2 : Double; 
    F3 : String[20]; 
    end; 
    (Определяем структуру для WM_COPYDATA.) 
    PCopyDataStruct = ^TCopyDataStruct; 
    TCopyDataStruct = packed record 
    dwData: Longint; (Соответствует 32-битовому DWORD.) 
    cbData: Longint; (Соответствует 32-битовому DWORD.} 
    IpData: Pointer; 
    end; 
    procedure TCopyl6.WMCopyData(var M: TMessage); 
    var 
    MyRec: TMyRec; 
    begin 
    MyRec := PMyRec (PCopyDataStruct (M. IParam) л. IpData) /\; 
    Editl.Text := IntToSTr(MyRec.Fl) ; 
    Edit2.Text := FloatToStr(MyRec.F2); 
    Edit3.Text := MyRec.F3; 
    Edit4.Text := IntToStr(PCopyDataStruct(M.IParam) -- .dwData) end; 
    end. 

    На рис. 32.1 показаны окна приложений в процессе передачи данных. После 
внесения изменений в окне 32-разрядного приложения и щелчка на кнопке Send 
16-разрядное приложение тут же их отобразит. 

    Integer )1234_____________ 
    Double J5678.9____________ 
    String   Data froni 32-bit App          ii"» 
    Ii "" Send" ""'I               . .User Defined Data )5              j 

    Рис. 32.1. Пример работы сообщения WM_COPYDATA 

    Если приложение-получатель должно изменить данные и отправить их назад, 
данные необходимо скопировать в локальную переменную, обработать и затем 
отослать точно так, как это делает 32-разрядное приложение. 

    Глава 32. Катание на санках                                           737 
    24 Использование Delphi 3. Специальное издание 


    С горки на санках QTJTiunk 

    QT_Thunk— недокументированный ВЫЗОВ API, позволяющий работать с линейными 
санками без использования жуткого компилятора санок, поддерживаемого только в 
Windows 95. При вызове QT_Thunk получает значение регистра EDX, рассматривая 
его как 16-разрядный адрес, и пытается осуществить переход по этому адресу. 
Заметьте, что я вызываю QT_Thunk внутри блока asm, чтобы быть уверенным, что 
значение регистра в момент вызова именно то, которое необходимо.       " """"""" 
    Теоретически можно перенести адрес 16:16 в регистр EDX через блок asm и 
затем вызвать QT_Thunk в коде Pascal, но этот метод предполагает, что 
компилятор оставляет неизменным значение, помещенное в регистр. Я, все же, не 
стану заключать пари, что компилятор именно так и поступит! 
    При использовании QT_Thunk необходимо выполнить некоторые действия в 
определенном порядке. 
    • Процедура или функция в вызывающем приложении должна иметь установленный 
кадр стека, что можно сделать с помощью директивы $W+. 
    • Следует зарезервировать хотя бы $ЗС байт в стеке, чтобы QT_Thunk могла 
установить свой кадр стека. 
    И Необходимо загружать 16-разрядную DLL, получать адрес интересующей вас 
процедуры и освобождать DLL с помощью недокументированных вызовов API 
LoadLibraryl6, GetProcAddressl6 и FreeLibraryi'6"" ~ 
    • Не создавайте локальных переменных в вызывающей процедуре — опыт 
показывает, что QT_Thunk может их изменить. 
    В листинге 32.3 приведен исходный текст модуля с описанием QT_Thunk и 
другими необходимыми вызовами API, которые пригодятся при "катании на санках". 
    ЛИСТИНГ 32.3. \UDELPHI3\CHP32\QT_THUNK\QTTHUNKU. РАЗ. МОДУЛЬ С ОПИСЗНИЯМИ 
ВЫЗОВОВ API для использования QT_Thunk 

    unit QTThunkU; 
    //От.кдюзаем проверки. 
    interface 
    uses 
    Windows; 
    type 
    // Описание 16-разрядного дескриптора 
    // (в Delphi 3.0 дескрипторы 32-разрядные). 
    TShortHandle = Word; 
    //Вызовы API из WOW32.DLL. 
    function WOWGetVDMPointer(vp, dwBytes: DWord; 
    fProtectedMode: Bool): Pointer; stdcall; 
    function WOWGetVDMPointerFix(vp, dwBytes: DWord; 
    fProtectedMode: Bool): Pointer; stdcall; 
    procedure WOWGetVDMPointerUnfix(vp: DWord); stdcall; 
    //Недокументированные вызовы Windows 95 API в Kernel32.DLL. 
    function GlobalAllocl6(Flags: Integer; Bytes: Longint): 
    TShortHandle; stdcall; 
    function GlobalLockl6(Mem: TShortHandle): Pointer; stdcall; 
    function GlobalUnLockl6(Mem: TShortHandle): WordBool; stdcall; 
    function GlobalFreel6(Mem: TShortHandle): TShortHandle; stdcall; 
    function LoadLibraryl6(LibFileName: PChar): THandle; stdcall; 
    function GetProcAddressl6(Module: HModule; ProcName: PChar): 
    TFarProc; stdcall; 
    procedure FreeLibraryl6(LibModule: THandle); stdcall; 
    procedure QT_Thunk; 


    738                                       Часть VI. Сложный материал 


    implementation 
    uses 
    SysUtils, Classes; 
    type 
    EVersionError = class(Exception); 
    //Экспорт вызовов API из WOW32.DLL. 
    function WOWGetVDMPointer;      external 'wow32.dll'; 
    function WOWGetVDMPointerFix;   external 'wow32.dll'; . 
    procedure WOWGetVDMPointerUnfix; external 'wow32.dll'; л 
    //Экспорт вызовов API из Kernel32.DLL                   \ 
    function GlobalAllocl6;    external 'kernel32.dll' indejj 24 
    function GlobalLockl6;     external 'kernel32.dll' index 25 
    function GlobalUnLockl6;   external 'kernel32.dll' index 26 
    function GlobalFreel6;     external 'kernel32.dll' index 31 
    function LoadLibraryl6;    external 'kernel32.dll' index 35 
    procedure FreeLibraryl6;    external 'kernel32.dll' index 36 
    function GetProcAddressl6; external 'kernel32.dll' index 37 
    procedure QT_Thunk;         external 'kernel32.dll' index 559; 
    initialization 
    //Проверка платформы. 
    if Win32Platform <> Ver_Platform_Win32_Windows then 
    raise EVersionError.Create('QT_Thunk only works '+ 
    'under Windows 95!'+#13#10+ 
    'For Windows NT use the'+ 
    ' WM_COPYDATA technique.'); 
    end. 

    Для проверки работоспособности модуля я создал приложение, вызывающее две 
Pascal-процедуры и одну С-функцию, содержащиеся "в 16-разряднои DLL. Первая 
процедура не имеет параметров, вторая"получает два параметра типа" longfnt, 
одно — по значению и одно — по ссылке. Параметр, переданный по ссылке, 
изменяется 32-разрядной DLL и передается назад в 32-разрядное приложение. 
С-функция получает два параметра типа longint и возвращает их сумму. В 
листинге 32.4 приведен исходный текст вызывающего приложения. 

    I Листинг 32.4. \UDELPHl3\CHP32\QT_THUNK\QT_TESTU. PAS. 32-разрядное 
вызывающее приложение 

    unit QT_TestU; 
    interface 
    uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
StdCtrls, ExtCtrls; 
    type 
    TCall32 = class(TForm) 
    PasProcNoParam: TButton; 
    PasProc2Param: TButton; 
    CFunc2Param: TButton; 
    procedure PasProcNoParamClick(Sender: TObject); 
    procedure PasProc2ParamClick(Sender: TObject); 
    procedure CFunc2ParamClick(Sender: TObject); 
    private 
    { Private declarations } 
    public 
    ( Public declarations } 
    end; 


    Глава 32. Катание на санках                                           739 


    var 
    Call32: TCall32; 
    implementation 
    ($R *.DFM} 
    // Включаем кадр стека. 
    ($W+} 
    uses 
    QTThunkU; 
    //Описываем все переменные как глобальные, дабы уберечь 
    //их от наезда санок QT_Thunk. 
    var 
    D1116Handle : THandle; 
    Procl6Addr : Pointer; 
    IntParamI : integer; 
    IntParam2 : integer; 
    PIntParam32 : "integer; 
    PIntParaml6 : "integer; 
    Return : integer; 
    function Lockl6Pointer(var P32: Pointer; Size: integer): Pointer; 
    begin 
    result := nil; 
    // Выделяем память в 16-разрядной области. 
    LongRec(result).Hi := GlobalAllocl6(GMEM_FIXED or 
    GMEM_ZEROINIT, Size) ; 
    //Преобразовываем 16-разрядный адрес в 32-разрядный. 
    P32 := WOWGetVDMPointer(DWORD(Result), 0, True); 
    end; 
    procedure UnLockl6Pointer(P: Pointer); 
    begin 
    GlobalFreel6(LongRec(P).Hi); 
    end; 
    procedure TCall32.PasProcNoParamClick(Sender: TObject); 
    var 
    QT_Stack_Space : String[$3C]; 
    begin 
    //Используем QT Stack Space, чтобы оптимизатор не удалил его. 
    QT_Stack_Space := ''; 
    // Загружаем 16-битовую DLL. 
    D1116Handle := LoadLibraryl6('Libl6DLL.DLL'); 
    Procl6Addr := GetProcAddressl6(D1116Handle, 'PasProcNoParam') ; 
    if Assigned(Procl6Addr) then 
    asm 
    mov edx, Procl6Addr 
    call QT_Thunk 
    end; 
    FreeLibraryl6(D1116Handle) ; 
    end; 
    procedure TCall32.PasProc2ParamClick(Sender: TObject); 
    // Процедура передает два параметра — по ссылке 
    // и по значению. 
    var 
    QT_Stack_Space : String[$3C]; 
    begin 
    //Используем QT Stack Space, чтобы оптимизатор его не удалил. 
    QT_Stack_Space := ''; 


    740                                       Часть VI. Сложный материал 


    // Загружаем 16-разрядную DLL. 
    D1116Handle := LoadLibraryl6('Libl6DLL.DLL'); 
    Procl6Addr := GetProcAddressl6(D1116Handle, 'PasProc2Params'); 
    if Assigned(Procl6Addr) then begin 
    IntParamI := 100; 
    IntParam2 := 200; 
    PIntParan>16 := Lockl6Pointer(Pointer(PIntParam32), SizeOf(IntParam2)) ; 
    //Переносим IntParam2 в новый буфер, на который указывает 
    //PIntParam32. 
    Move(IntParam2, PIntParam32^, sizeof(IntParam2)); 
    asm 
    push IntParamI 
    push PIntParaml6 
    mov edx, Procl6Addr 
    call QT_Thunk 
    end; 
    ShowMessage ('IntParam2 was 200 now it is '+ IntToStr (PIntParan^^) ) ; 
    UnLockl6Pointer(PIntParaml6) ; 
    end; 
    FreeLibraryl6(D1116Handle) ; 
    end; 
    procedure TCall32.CFunc2ParamClick(Sender: TObject); 
    // Эта процедура передает два целых значения в С-функцию, 
    // возвращающую их сумму. 
    var 
    QT_Stack_Space : String[$3C]; 
    begin 
    //Используем QT_Stack_Space, чтобы оптимизатор не удалил его. 
    QT_Stack_Space := ''; 
    // Загружаем 16-битовую DLL. 
    D1116Handle := LoadLibraryl6СLibl6DLL.DLL'); 
    Procl6Addr := GetProcAddressl6(D1116Handle, 'CFunc2Params'); 
    if Assigned(Procl6Addr) then begin 
    IntParamI := 100; 
    IntParam2 := 200; 
    // Это С-функция с передачей параметров справа налево 
    //и очисткой стека вызывающей функцией. 
    /•—asm 
    push IntParam2 
    push IntParamI 
    mov edx, Procl6Addr 
    call QT_Thunk 
    //Очищаем стек. 
    add esp, 2*4 // Два Longint no 4 байт. 
    mov Return.Word.2, dx 
    mov Return.Word.0, ax 
    end'' 
    ShowMessage(Format('%d + %d = %d', 
    [IntParamI,IntParam2,Return])) ; 
    end; 
    FreeLibraryl6(D1116Handle) ; 
    end; 
    end. 

    Соответствующая 16-разрядная DLL (без каких-либо извращений) приведена в 
листинге 32.5. 

    Глава 32. Катание на санках                                           741 


    Листинг 32.5. \UDELPHI3\CHP32\QTJHUNK\LIB16DLL.DPR. 16-разрядная DLL для 
использования с примером QT_Thunk 

    library Libl6DLL; 
    uses 
    Dialogs, SysUtils; 
    procedure PasProcNoParam; export; 
    begin 
    ShowMessage('Pascal procedure called with no paramters'); 
    end; 
    procedure PasProc2Params(pi: Longint; var p2: Longint); export; 
    begin 
    ShowMessage(Format('Pascal procedure called '+ 'with parameters %d and 
%d', [pl, p2])) ; 
    p2 := p2 * 5; 
    end; 
    function CFunc2Params(pi, p2: Longint): Longint; cdecl; export; 
    begin 
    ShowMessage(Format('С Function called with '+ 'parameters %d and %d', [pl, p2])); 
    CFunc2Params := pl + p2; 
    end; 
    exports 
    PasProcNoParam, PasProc2Params, CFunc2Params; 
    begin 
    end. 


    Резюме 

    В этой главе рассматривались методы вызова 16-разрядного кода из 
32-разрядного и 32-разрядного из 16-разрядного и методы такого вызова для 
разных платформ. Возможно, вам никогда не придется использовать эти вызовы, но 
если придется, то, изучив эту главу, вы без труда справитесь с проблемами. 

    742                                       Часть VI. Сложный материал 
