Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

Видеокурс программиста и крэкера 5D 2O17
(актуальность: ноябрь 2O17)
Свежие инструменты, новые видеоуроки!

  • 400+ видеоуроков
  • 800 инструментов
  • 100+ свежих книг и статей

УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Вызов 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.
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS