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

Материал из DRKB

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

Надо использовать 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('Cannot 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('Cannot 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;


Author: Андрей Гусев (Andrey Gusev)
Source: Взято из Akzhan's Delphi-related VCL&WinAPI Tips'n'Tricks
ID: 02006



Посылаю код для определения системных ресурсов (как в "Индикаторе ресурсов"). Использовалась статья "Calling 16-bit code from 32-bit in Windows 95".


{ GetFeeSystemResources routine for 32-bit Delphi.
Works only under Windows 9x }

unit SysRes32;

interface

const
  // Constants whitch specifies the type of resource to be checked
  GFSR_SYSTEMRESOURCES = $0000;
  GFSR_GDIRESOURCES = $0001;
  GFSR_USERRESOURCES = $0002;

// 32-bit function exported from this unit
function GetFeeSystemResources(SysResource: Word): Word;

implementation

uses
  SysUtils, Windows;

type
  // Procedural variable for testing for a nil
  TGetFSR = function(ResType: Word): Word; stdcall;
  // Declare our class exeptions
  EThunkError = class(Exception);
  EFOpenError = class(Exception);

var
  User16Handle: THandle = 0;
  GetFSR: TGetFSR = nil;

// Prototypes for some undocumented API
function LoadLibrary16(LibFileName: PAnsiChar): THandle; stdcall; external kernel32 index 35;
function FreeLibrary16(LibModule: THandle): THandle; stdcall; external kernel32 index 36;
function GetProcAddress16(Module: THandle; ProcName: LPCSTR): TFarProc; stdcall; external kernel32 index 37;
procedure QT_Thunk; cdecl; external 'kernel32.dll' Name 'QT_Thunk';


{$StackFrames On}

function GetFeeSystemResources(SysResource: Word): Word;
var
  EatStackSpace: string[$3C];
begin
  // Ensure buffer isn't optimised away
  EatStackSpace := '';
  @GetFSR := GetProcAddress16(User16Handle, 'GETFREESYSTEMRESOURCES');
  if Assigned(GetFSR) then  //Test result for nil
    asm
      // Manually push onto the stack type of resource to be checked first
      PUSH    SysResource
      // Load routine address into EDX
      MOV     EDX, [GetFSR]
      // Call routine
      CALL    QT_Thunk
      // Assign result to the function
      MOV     @Result, AX
    end
  else
    raise EFOpenError.Create('GetProcAddress16 failed!');
end;

initialization

  // Check Platform for Windows 9x
  if Win32Platform <> VER_PLATFORM_WIN32_WINDOWS then
    raise EThunkError.Create('Flat thunks only supported under Windows 9x');

  // Load 16-bit DLL (USER.EXE)
  User16Handle := LoadLibrary16(PChar('User.exe'));

  if User16Handle < 32 then
    raise EFOpenError.Create('LoadLibrary16 failed!');

finalization

  // Release 16-bit DLL when done
  if User16Handle <> 0 then
    FreeLibrary16(User16Handle);

end.


Source: Взято с http://delphiworld.narod.ru
ID: 02007