Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

ВИДЕОКУРС 2017
выпущен 15 марта!


УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Как вызывать функцию 16-битной DLL из 32-битного приложения

Автор: Nomadic

Надо использовать Thunks.

Кусок работающего только под Windows 95 кода


 const
   Gfsr_SystemResources = 0;
   Gfsr_GdiResources = 1;
   Gfsr_UserResources = 2;
 var
   hInst16: THandle;
   GFSR: Pointer;
   { Undocumented Kernel32 calls. }
 
 function LoadLibrary16(LibraryName: PChar): THandle; stdcall; external kernel32
   index 35;
 
 procedure FreeLibrary16(HInstance: THandle); stdcall; external kernel32 index
   36;
 
 function GetProcAddress16(Hinstance: THandle; ProcName: PChar): Pointer;
   stdcall;
   external kernel32 index 37;
 
 procedure QT_Thunk; cdecl; external kernel32 name 'QT_Thunk';
 { QT_Thunk needs a stack frame. }
 {$STACKFRAMES On}
 { Thunking call to 16-bit USER.EXE. The ThunkTrash argument
 allocates space on the stack for QT_Thunk. }
 
 function NewGetFreeSystemResources(SysResource: Word): Word;
 var
   ThunkTrash: array[0..$20] of Word;
 begin
   { Prevent the optimizer from getting rid of ThunkTrash. }
   ThunkTrash[0] := hInst16;
   hInst16 := LoadLibrary16('user.exe');
   if hInst16 < 32 then
     raise Exception.Create('Can''t load USER.EXE!');
   { Decrement the usage count. This doesn't really free the
   library, since USER.EXE is always loaded. }
   FreeLibrary16(hInst16);
   { Get the function pointer for the 16-bit function in USER.EXE. }
   GFSR := GetProcAddress16(hInst16, 'GetFreeSystemResources');
   if GFSR = nil then
     raise Exception.Create('Can''t get address of GetFreeSystemResources!');
   { Thunk down to USER.EXE. }
   asm
     push SysResource { push arguments }
     mov edx, GFSR { load 16-bit procedure pointer }
     call QT_Thunk { call thunk }
     mov Result, ax { save the result }
   end;
 end;
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS