Советы по Delphi

         

Вызов 16-разрядного кода из 32-разрядного


Andrew Pastushenko пишет:

Посылаю код для определения системных ресурсов (как в "Индикаторе ресурсов"). Использовалась статья "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.

[001068]



Содержание раздела