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

Автор: Andrew Pastushenko

Идет Илья Муромец по полю. Видит - Змей Горыныч сидит. Ну, тот подкрался к нему и срубил ему голову. У Змея Горыныча две выросло. Срубил Илья ему две - четыре выросло! Срубил четыре - выросло восемь!!! И так далее... И вот когда Илья Муромец срубил 65535 голов Змей Горыныч помер... Потому что был он 16-ти битным.

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

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