Solved

Thunk problems with 2000

Posted on 2002-03-06
5
431 Views
Last Modified: 2007-12-19
Hi, I have an app thats testing sys res, but I'm only doing this when its a win 9.x OS as I know it can't be done this way for NT, 2000 etc.  However, the very presence of this unit seems to upset win2000, even though I'm not calling any of the functions. I suspect this is because of the external function calls in the declarations when they just don't exist.  How can I stop these causing a problem?  Many thanks, P.

interface

const
 SYSres    = 0;
 USERres   = 2;
 GDIres    = 1;

function GetSystemResources(Res: Word): Word;
function UserPercentage : Integer;
function SystemPercentage : Integer;
function GDIPercentage : Integer;
procedure DisplayFreeResources;


implementation

uses Windows,SysUtils,Dialogs;

function ThunkLoadLibrary(LibraryName: PChar): THandle; stdcall; external kernel32 index 35;
procedure ThunkFreeLibrary(HInstance: THandle); stdcall; external kernel32 index 36;
function ThunkGetProcAddress(Hinstance: THandle; ProcName: PChar): Pointer; stdcall; external kernel32
index 37;
procedure Thunk; cdecl; external kernel32 name 'QT_Thunk';

{$StackFrames On}

var
 Th : THandle = 0;
 P: Pointer = nil;

function GetSystemResources(Res: Word): Word;
var
 Ar : array[0..$40] of Word;
begin
 Ar[0] := Th; //get major error without this ?
 Th := ThunkLoadLibrary('user.exe');
 if Th < 32 then
   raise Exception.Create('Error loading User.exe');
  ThunkFreeLibrary(Th);
 P := ThunkGetProcAddress(Th,'GetFreeSystemResources');
 if P = nil then
   raise Exception.Create('GetSystemResources function not found');
  asm
   push Res
   mov edx, P
   call Thunk
   mov Result, ax
 end;
end;

function UserPercentage : Integer;
begin
 Result := GetSystemResources(USERres);
end;

function SystemPercentage : Integer;
begin
 Result := GetSystemResources(SYSres);
end;

function GDIPercentage : Integer;
begin
 Result := GetSystemResources(GDIres);
end;

Procedure DisplayFreeResources;
begin
showmessage(
'SYSTEM : '+inttostr(SystemPercentage)+'%'+#13#10+
'USER : '+inttostr(UserPercentage)+'%'+#13#10+
'GDI : '+inttostr(GDIPercentage)+'%');
end;

end.







0
Comment
Question by:Pandora
  • 2
  • 2
5 Comments
 
LVL 1

Author Comment

by:Pandora
Comment Utility
p.s. this is the w2000 error:
The procedure entry point QT_Thunk could not be located in the dynamic link library kernell32.dll

0
 
LVL 17

Expert Comment

by:inthe
Comment Utility
hi,
you cannot use thunking on winnt based systems (and win2k is nt based) ,it is completely not possible .
these sytems dont use resources in the same way as win9* pcs did.

for these systems you need to change to using the performance helper apis.
these have been enscapulated in various units.
here are some of the better demos & units available for it:

http://www.aldyn.ru/products/perfutils/download.html

http://www.wilsonc.demon.co.uk/delphi.htm
(scroll down to perfomance moniter)

http://www.jgsoftware.com/files/pdhd10.zip
http://www.jgsoftware.com/files/perfmon.zip
http://www.jgsoftware.com/files/ntperf.zip

Regards Barry



0
 
LVL 8

Accepted Solution

by:
TOndrej earned 200 total points
Comment Utility
> procedure Thunk; cdecl; external kernel32 name 'QT_Thunk';
That line is the source of your problem; you are linking this function statically. Instead, do something like this (I've only tested this briefly on WinMe):

var
  Kernel32: HMODULE;
  QTThunk: procedure;
  User16: HMODULE;
  ProcEntry: Pointer;

{$W+}

function GetSystemResources(Res: Word): Word;
var
  EatStackSpace: string[$3C];
begin
  EatStackSpace := ''; // avoid optimizer
  Kernel32 := GetModuleHandle('kernel32.dll');
  if Kernel32 <> 0 then
  begin
    QTThunk := GetProcAddress(Kernel32, 'QT_Thunk');
    if @QTThunk <> nil then
    begin
      User16 := ThunkLoadLibrary('user.exe');
      ProcEntry := ThunkGetProcAddress(User16, 'GetFreeSystemResources');
      if @ProcEntry <> nil then
      begin
        asm
          PUSH Res
          MOV EDX, ProcEntry
          CALL QTThunk
          ADD ESP, 4
          MOV Result, AX
        end;
      end;
      ThunkFreeLibrary(User16);
    end;
  end;
end;

{$W-}

Note: you cannot use Exceptions (try, finally, raise etc.) inside a thunking procedure, it can be another source of problems.
Of course, thunking cannot be done on NT-based systems, and you should check in your program which OS it runs on and never call this function on NT, 2000 or XP.
More details: http://www.thedelphimagazine.com/samples/thunk/thunk95.htm

HTH
TOndrej
0
 
LVL 1

Author Comment

by:Pandora
Comment Utility
Barry, thanks, but I think you answered a different question!!  TOndrej, smashing, bees knees, works like a dream on 2000 - I won't even pretend to understand the code but I think I get the vague gist!  Thanks very much both of you, and let's hope my fleeting encounter with thunking is over for ever! Best wishes, P :)
0
 
LVL 17

Expert Comment

by:inthe
Comment Utility
oops i apologize,
i didnt read question properly at all <g>
 :-)
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now