genthunk.pas

《Delphi开发人员指南》配书原码

unit GenThunk;
{ Unit which provides an interface to the 16-bit Windows on Win32 (WOW)   }
{ API from a 16-bit application running under Windows NT or Windows 95.   }
{ These functions allow you to call 32-bit DLLs from 16-bit applications. }
{ Copyright (c) 1996 Steve Teixeira }

interface

uses WinTypes;

type
  THandle32 = Longint;
  DWORD = Longint;

{ LoadLibraryEx32W enables you to load a 32-bit DLL from a 16-bit }
{ application. The parameters are identical to those of the       }
{ LoadLibraryEx API function.  The return value of this function  }
{ is a 32-bit handle to the DLL. }
function LoadLibraryEx32W(LibFileName: PChar; hFile, dwFlags: DWORD): THandle32;

{ FreeLibrary32W frees a 32-bit DLL loaded with LoadLibrary32W.   }
{ The LibModule parameter is the handle returned by               }
{ LoadLibrary32W. The return value indicates success or failure.  }
function FreeLibrary32W(LibModule: THandle32): BOOL;

{ GetProcAddress32W retrieves the address of a procedure located  }
{ in a 32-bit DLL which was loaded by LoadLibrary32W. The return  }
{ value is the address of the proc. }
function GetProcAddress32W(Module: THandle32; ProcName: PChar): TFarProc;

{ GetVDMPointer32W converts a 16-bit (16:16) pointer into a       }
{ 32-bit flat (0:32) pointer. The value of FMode should be 1 if   }
{ the 16-bit pointer is a protected mode address (the normal      }
{ situation in Windows 3.x) or 0 if the 16-bit pointer is real    }
{ mode. }
function GetVDMPointer32W(Address: Pointer; FMode: word): DWORD;

{ CallProc32W calls a proc whose address was retrieved by         }
{ GetProcAddress32W. The true definition of this function         }
{ actually allows for multiple DWORD parameters to be passed      }
{ prior to the ProcAddress parameter, and the nParams parameter   }
{ should reveal the number of params passed prior to ProcAddress. }
{ The AddressConvert parameter is a bitmask which indicates which }
{ of the params are 16-bit pointers in need of conversion before  }
{ the 32-bit function is called. Since this function doesn't lend }
{ itself to being defined in Object Pascal, you may want to use  }
{ the simplified Call32BitProc function instead. }
function CallProc32W(Params: DWORD; ProcAddress, AddressConvert,
                     nParams: DWORD): DWORD;

{ Call32BitProc accepts a constant array of Longints as the parameter }
{ list for the function given by ProcAddress. This procedure is       }
{ responsible for packaging the parameters into the correct format    }
{ and calling the CallProc32W WOW function. }
function Call32BitProc(ProcAddress: DWORD; const Params: array of Longint;
                       AddressConvert: Longint): DWORD;

{ Converts a 16-bit window handle to 32-bit for use by Windows NT. }
function HWnd16To32(Handle: hWnd): THandle32;

{ Converts a 32-bit window handle to 16-bit. }
function HWnd32To16(Handle: THandle32): hWnd;

implementation

uses WinProcs;

function HWnd16To32(Handle: hWnd): THandle32;
begin
  Result := Handle or $FFFF0000;
end;

function HWnd32To16(Handle: THandle32): hWnd;
begin
  Result := LoWord(Handle);
end;

function Call32BitProc(ProcAddress: DWORD; const Params: array of Longint;
                       AddressConvert: Longint): DWORD;
var
  NumParams: word;
begin
  NumParams := High(Params) + 1;
  asm
    les di, Params              { es:di -> Params }
    mov cx, NumParams           { loop counter = num params }
  @@1:
    push es:word ptr [di + 2]   { push hiword of param x }
    push es:word ptr [di]       { push loword of param x }
    add di, 4                   { skip to next param }
    loop @@1                    { iterate over all params }
    mov cx, ProcAddress.Word[2] { cx = hiword of ProcAddress }
    mov dx, ProcAddress.Word[0] { dx = loword of ProcAddress }
    push cx                     { push ProcAddress }
    push dx
    mov cx, AddressConvert.Word[2] { cx = hiword of AddressConvert }
    mov dx, AddressConvert.Word[0] { dx = loword of AddressConvert }
    push cx                     { push AddressConvert }
    push dx
    mov cx, NumParams
    mov ax, 0
    push ax                     { push Number of Params }
    push cx
    call CallProc32W            { call function }
    mov Result.Word[0], ax      { store return value }
    mov Result.Word[2], dx
  end
end;

{ 16-bit WOW functions }
function LoadLibraryEx32W;             external 'KERNEL' index 513;
function FreeLibrary32W;               external 'KERNEL' index 514;
function GetProcAddress32W;            external 'KERNEL' index 515;
function GetVDMPointer32W;             external 'KERNEL' index 516;
function CallProc32W;                  external 'KERNEL' index 517;

end.