[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 440
  • Last Modified:

Thunk problems with 2000

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
Pandora
Asked:
Pandora
  • 2
  • 2
1 Solution
 
PandoraAuthor Commented:
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
 
intheCommented:
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
 
TOndrejCommented:
> 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
 
PandoraAuthor Commented:
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
 
intheCommented:
oops i apologize,
i didnt read question properly at all <g>
 :-)
0

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now