[2 days left] What’s wrong with your cloud strategy? Learn why multicloud solutions matter with Nimble Storage.Register Now

x
?
Solved

Thunk problems with 2000

Posted on 2002-03-06
5
Medium Priority
?
439 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
5 Comments
 
LVL 1

Author Comment

by:Pandora
ID: 6844148
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
ID: 6844582
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 800 total points
ID: 6845153
> 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
ID: 6848087
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
ID: 6848809
oops i apologize,
i didnt read question properly at all <g>
 :-)
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
In this video, Percona Solutions Engineer Barrett Chambers discusses some of the basic syntax differences between MySQL and MongoDB. To learn more check out our webinar on MongoDB administration for MySQL DBA: https://www.percona.com/resources/we…
Are you ready to place your question in front of subject-matter experts for more timely responses? With the release of Priority Question, Premium Members, Team Accounts and Qualified Experts can now identify the emergent level of their issue, signal…
Suggested Courses

656 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