home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 1996 May / CD2_DEMO.ISO / code / prog / listing1.txt
Encoding:
Text File  |  1996-02-28  |  1.4 KB  |  59 lines
  1. program thunk;
  2.  
  3. uses
  4.     Windows, SysUtils;
  5.  
  6. {$R *.RES}
  7.  
  8. function LoadLibrary16 (lpLibFileName: PAnsiChar): HMODULE; stdcall; 
  9. external kernel32 name '' index 35;
  10.  
  11. function FreeLibrary16 (hLibModule: HMODULE): Bool; stdcall; stdcall; 
  12. external kernel32 name '' index 36;
  13.  
  14. function GetProcAddress16 (hModule: HMODULE; lpProcName: LPCSTR): FARPROC; stdcall; 
  15. external kernel32 name '' index 37;
  16.  
  17. procedure QT_Thunk; 
  18. external kernel32;
  19.  
  20. var
  21.     hUser16: HModule;
  22.     FSRProc: Pointer;
  23.     UResult, GResult: Word;
  24.     szBuff: array [0..255] of Char;
  25.  
  26. procedure GetFSR;
  27. var
  28.     ThunkJunk: array [0..127] of Char;
  29. begin
  30.     ThunkJunk [0] := #0;
  31.  
  32.     hUser16 := LoadLibrary16 ('USER.EXE');
  33.     if hUser16 < HModule (32) then Halt;
  34.     FreeLibrary16 (hUser16);
  35.     FSRProc := GetProcAddress16 (hUser16, 'GetFreeSystemResources');
  36.     if FSRProc = Nil then Halt;
  37.  
  38.     { OK, we've got a 16:16 ptr to the wanted proc - now do the business... }
  39.  
  40.     asm
  41.         push    1                  // GFSR_GDIResources
  42.         mov     edx,FSRProc
  43.         call    QT_Thunk
  44.         mov     GResult,ax
  45.  
  46.         push    2                  // GFSR_UserResources
  47.         mov     edx,FSRProc
  48.         call    QT_Thunk
  49.         mov     UResult,ax
  50.     end;
  51. end;
  52.  
  53. begin
  54.     GetFSR;
  55.     StrPCopy (szBuff, Format ('USER Resources = %d%%, GDI Resources = %d%%',
  56.               [UResult, GResult]));
  57.     MessageBox (0, szBuff, 'Thunk', mb_ok);
  58. end.
  59.