Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Как вызывать функцию 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;

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.