Ermittlung von System-, User- und GDI-Resourcen
Kay Siegel
Ich wollte ein kleines Programmchen schreiben, welches mir zeigt, wie viel
System-, User- und GDI-Ressourcen noch frei sind (in Prozent).
Unter Turbo Pascal gab es da noch die Funktion GetFreeSystemResources, der
man als Parameter eben an geben konnte, ob man die System-, User oder
GDI-Ressourcen, die noch frei sind, haben möchte.
Unter Delphi habe ich nichts derartiges finden können!
Kann mir da jemand weiter helfen?
Mfg
Kay
Marian Aldenhövel
> Unter Turbo Pascal gab es da noch die Funktion GetFreeSystemResources
Das war keine Turbo-Pascal-Funktion sondern eine aus dem Win-16 API. In
Win32 gibt es sie nicht mehr.
Stattdessen gibt es GetGlobalMemoryStatus. Das liefert absolute Größen
statt Prozentangaben - ich vermute, weil die nicht so nach Notstand
aussehen :-).
Ciao, MM
--
Marian Aldenhövel, Hainstraße 8, 53121 Bonn
http://www.marian-aldenhoevel.de
"Das wirkliche Leben bleibt eine blaue Blume
im Land des Digitalen" W.Höck
Christian NineBerry Schwarz
Kay Siegel schrieb:
> Ich wollte ein kleines Programmchen schreiben, welches mir zeigt,
> wie viel System-, User- und GDI-Ressourcen noch frei sind (in
> Prozent).
Dabei (System, User, GDI) geht es um einen speziellen
Speicherbereich, der für Objekt-Handles verwendet wird.
Dieser Bereich ist nur unter Win95/98/ME begrenzt (und zwar auf je
etwa 2MB), unter NT/2000 gibt es keine Begrenzung.
Unter Windows 3.11 war dieser Speicher sogar noch stärker beschränkt
(je 64K). Dort gab es eine Routine namens GetFreeSystemResources, um
die Prozentzahlen zu ermitteln.
Diese Routine gibt es auch unter 32bit Windows Versionen noch, ist
aber in der 16bit - Datei User.EXE enthalten und kann somit nur von
16bit Programmen (wie z.B. von Delphi 1 erstellt) verwendet werden.
Mehr Informationen dazu gibt es unter
http://support.microsoft.com/support/kb/articles/Q190/2/17.ASP
Die Resourcenanzeige von Windows verwendet auch den Trick, dass sie
mit einer 32bit-DLL (Rsrc32.dll) arbeitet, die über einen Mechanismus
namens "Thunking", der leider mit Delphi nicht möglich ist, eine
16bit-DLL (Rsrc16.dll) verwendet, die ihrerseits
GetFreeSystemResources aufruft.
Sind auf einem System diese beiden DLLs vorhanden, so kann zumindest
Rsrc32.dll von Delphi aus verwendet werden. Dazu folgende Unit:
======8<=8<=8<=====================================================
unit uFreeSystemRecources;
interface
function FreeSystemRecourcesAvailable: Boolean;
function GetFreeUserRecources: Integer;
function GetFreeSystemRecources: Integer;
function GetFreeGDIRecources: Integer;
implementation
uses Windows;
type
TGetFreeSystemRecourcesFunc =
function(fuSysResource: Integer): Integer;stdcall;
var
IsDLLLoaded: Boolean;
DLLHandle: HInst;
Proc: TGetFreeSystemRecourcesFunc;
const
DLLName = 'RSRC32.DLL';
const
GFSR_SYSTEMRESOURCES = 0;
GFSR_GDIRESOURCES = 1;
GFSR_USERRESOURCES = 2;
procedure Init;
var
ProcID: Word;
begin
DLLHandle:= LoadLibrary(DLLName);
IsDLLLoaded:= DLLHandle <> 0;
if IsDLLLoaded then
begin
ProcID:= 1;
Proc:= GetProcAddress(DLLHandle, PChar(ProcID));
ISDLLLoaded:= Assigned(Proc);
if not IsDLLLoaded then
FreeLibrary(DLLHandle);
end;
end;
procedure Done;
begin
if IsDLLLoaded then
FreeLibrary(DLLHandle);
end;
function FreeSystemRecourcesAvailable: Boolean;
begin
Result:= IsDLLLoaded;
end;
function GetFreeUserRecources: Integer;
begin
if IsDLLLoaded then
Result:= Proc(GFSR_USERRESOURCES)
else
Result:= 90;
end;
function GetFreeSystemRecources: Integer;
begin
if IsDLLLoaded then
Result:= Proc(GFSR_SYSTEMRESOURCES)
else
Result:= 90;
end;
function GetFreeGDIRecources: Integer;
begin
if IsDLLLoaded then
Result:= Proc(GFSR_GDIRESOURCES)
else
Result:= 90;
end;
initialization
Init;
finalization
Done;
end.
======>8=>8=>8=====================================================
Verwendung könnte so aussehen:
if FreeSystemRecourcesAvailable then
begin
ShowMessage(Format('Freie System-Resourcen: %d %%',
[GetFreeSystemRecources]));
ShowMessage(Format('Freie User-Resourcen: %d %%',
[GetFreeUserRecources]));
ShowMessage(Format('Freie GDI-Resourcen: %d %%',
[GetFreeGDIRecources]));
end
else
ShowMessage('Resourcenanzeige nicht installiert');
Traubensaft gibt Traubenkraft
Christian "NineBerry" Schwarz
--
"If Java had true garbage collection,
it would delete itself upon execution."
Nicos Gollan
Michael Winter
> Die Resourcenanzeige von Windows verwendet auch den Trick, dass sie
> mit einer 32bit-DLL (Rsrc32.dll) arbeitet, die über einen Mechanismus
> namens "Thunking", der leider mit Delphi nicht möglich ist, eine
> 16bit-DLL (Rsrc16.dll) verwendet, die ihrerseits
> GetFreeSystemResources aufruft.
Wie bitte?
> leider mit Delphi nicht möglich
Lauter Protest.
function QT_Thunk: Word; stdcall; external kernel32;
function LoadLibrary16(Name: PChar): THandle; stdcall; external kernel32
index 35;
procedure FreeLibrary16(Handle: THandle); stdcall; external kernel32
index 36;
function GetProcAddress16(Handle: THandle; FuncName: PChar): Pointer;
stdcall; external kernel32 index 37;
function ThunkDown(Func16: Pointer; const Args: Array of Word): Word;
register;
// author: Michael Winter, 2001
// based on information from Matt Pietrek's
// 'Windows 95 System Programming Secrets'
// EAX = Func16 (CS:IP) , EDX = @Args[0], ECX = High(Args)
// s. W95SPS p. 208
asm
push esi
push ebp
mov ebp,esp
sub esp,40h
mov esi,edx
mov edx,eax
inc ecx
jz @@noargs
@@argloop:
lodsw
push ax
loop @@argloop
@@noargs:
call QT_Thunk
add esp,40h
pop ebp
pop esi
end;
const
GFSR_SYSTEMRESOURCES = 0;
GFSR_GDIRESOURCES = 1;
GFSR_USERRESOURCES = 2;
function GetFreeSystemResources(SysResource: Word): Integer;
var
hUser16: THandle;
GFSR16: Pointer;
begin
Result := 90;
hUser16 := LoadLibrary16('USER.EXE');
if hUser16 < 32 then exit;
try
GFSR16 := GetProcAddress16(hUser16, 'GetFreeSystemResources');
if GFSR16 = nil then exit;
Result := ThunkDown(GFSR16, [SysResource]);
finally
FreeLibrary16(hUser16);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessageFmt('System: %d%%, GDI: %d%%, User: %d%%',
[GetFreeSystemResources(GFSR_SYSTEMRESOURCES),
GetFreeSystemResources(GFSR_GDIRESOURCES),
GetFreeSystemResources(GFSR_USERRESOURCES)]);
end;
Da die vier Funktionen Kernel32-Funktionen natürlich nur in 9x
existieren, wird man für ein Programm, das auch unter NT laufen soll,
a) diese Funktionalität in ein DLL auslagern und nur unter 9x dynamisch
laden oder
b) die vier Funktionen selber dynamisch laden. Dabei tut sich dann ein
anderes Problem auf: W9x lehnt aus gewissen Gründen das dynamische Laden
von Kernel32-Funktionen über Index (drei haben keinen Namen) ab. Nicht
tragisch, nur ärgerlich: weitere 20 Zeilen.
-Michael
Christian NineBerry Schwarz
Michael Winter schrieb:
>> Die Resourcenanzeige von Windows verwendet auch den Trick, dass
>> sie mit einer 32bit-DLL (Rsrc32.dll) arbeitet, die über einen
>> Mechanismus namens "Thunking", der leider mit Delphi nicht möglich
>> ist, eine 16bit-DLL (Rsrc16.dll) verwendet, die ihrerseits
>> GetFreeSystemResources aufruft.
>
> Wie bitte?
Yupp. Das ist so.
>> leider mit Delphi nicht möglich
>
> Lauter Protest.
Ach das meinstest du. :)
Ich korrigiere: Nicht ohne Hilfe von außen so einfach möglich.
> function QT_Thunk: Word; stdcall; external kernel32;
> function LoadLibrary16(Name: PChar): THandle; stdcall; external
> kernel32 index 35;
> procedure FreeLibrary16(Handle: THandle); stdcall; external kernel32
> index 36;
> function GetProcAddress16(Handle: THandle; FuncName: PChar):
> Pointer; stdcall; external kernel32 index 37;
Oha. Das kannte ich bisher noch nicht. Danke für die Info. Ist
archiviert und wird bei nächster Gelegenheit näher untersucht.
Traubensaft gibt Traubenkraft
Christian "NineBerry" Schwarz
--
Mer hat's net leicht. Aber leicht hat's 'm.
Wenn mer's so leicht hätt', wie's 'm hat,
dann hätt' mer's leicht.
Marian Aldenhövel
> unter NT/2000 gibt es keine Begrenzung.
Oh doch, die gibt es ganz genauso. Sie wird aber durch zwei Unterschide
entschärft:
Erstens hat standardmäßig jede Applikation für sich den kompletten Platz
zur Verfügung, das multipliziert die Gesamtzahl.
Zweitens räumt NT übriggelassene Dinge nach dem Programmende wesentlich
sauberer weg, so daß schleichende Lecks nicht ganz so drastisch wirken.
> die über einen Mechanismus namens "Thunking", der leider mit Delphi
> nicht möglich ist
Das ist mit Delphi auch möglich, aber recht knifflig - nicht kniffliger als
in anderen Sprachen allerdings. Welcher technische Grund spräche denn
dagegen, 16-nach-32 Thunks habe ich in Delphi1 schon benutzt.
Juergen Schwarze
Christian NineBerry Schwarz schrieb :
[...]
> Oha. Das kannte ich bisher noch nicht. Danke für die Info. Ist
> archiviert und wird bei nächster Gelegenheit näher untersucht.
dann solltest Du dir [1] auch anschauen.
[...]
CU,
Jürgen
[1] http://www.thedelphimagazine.com/samples/thunk/thunk95.htm
Christian NineBerry Schwarz
Marian Aldenhövel schrieb:
>> unter NT/2000 gibt es keine Begrenzung.
>
> Oh doch, die gibt es ganz genauso. Sie wird aber durch zwei
> Unterschide entschärft
Hmmm. Soweit ich das bisher verstanden habe, werden Handles unter NT
im normalen Heap verwaltet, nicht in einem gesonderten Bereich.
Hast du entsprechende Links, um deine Aussage zu untermauern?
Traubensaft gibt Traubenkraft
Christian "NineBerry" Schwarz
--
Marian Aldenhövel
> Hast du entsprechende Links, um deine Aussage zu untermauern?
Nein. Aber ein Programm, von dem man unter Win95 nur eine Instanz, unter
NT4 aber viele viele viele starten kann.
Für 16-Bitter unter NT ist es ein extra Schalter irgendwo, der angibt ob
alle 16er zusammen in einem WoW-System oder jeder in seinem eigenen laufen
sollen. Ich habe daraus und aus dem Verhalten des Resourcenfressers, auf
den ich mich oben beziehe, einfach extrapoliert, daß wenigstens getrennte
Heaps für Win32-Anwendungen Standard sei.
"Beliebig" groß können die Heaps nicht sein, sonst gäbe es keine
Prozentangaben wie voll sie sind, und die kann man auch unter NT noch
bekommen.
Reine Empirie also.
Christian NineBerry Schwarz
Marian Aldenhövel schrieb:
> "Beliebig" groß können die Heaps nicht sein, sonst gäbe es keine
> Prozentangaben wie voll sie sind, und die kann man auch unter NT
> noch bekommen.
Wenn ich mich richtig erinnere, wird dort immer fest der Wert "90%"
zurückgegeben. Mal kucken, wo ich das gelesen habe.
Ach ja:
http://support.microsoft.com/support/kb/articles/Q190/2/17.ASP
| Note that Windows NT (all versions) and Windows 2000 is designed to
| dynamically allocate memory to the GDI and User heaps as needed.
| GetFreeSystemResources always returns 90% on Windows NT and 2000.
| Unlike other versions of Windows, Windows NT and 2000 do not run
| out of system resources and stop responding. It is highly unlikely
| that your Visual Basic application will have any need to monitor
| system resources on Windows NT and 2000.
Marian Aldenhövel
> | Note that Windows NT (all versions) and Windows 2000 is designed to
> | dynamically allocate memory to the GDI and User heaps as needed.
> | GetFreeSystemResources always returns 90% on Windows NT and 2000.
:-)
> | Unlike other versions of Windows, Windows NT and 2000 do not run
> | out of system resources and stop responding.
Für das System trifft das zu, man kann ein WinNT nicht kaputtmachen indem
man eine Applikation alle Resourcen fressen lässt.
Aber für die einzelne Applikation ist es eine glatte Lüge. Die kann sehr
wohl ihre Resourcen aufbrauchen und selber dann daran zugrundegehen.
> | It is highly unlikely
> | that your Visual Basic application will have any need to monitor
> | system resources on Windows NT and 2000.
Wenn es keine Lüge wäre, wäre es nicht "highly unlikely" sondern völlig
unnötig.
Wenn außerdem das Ergebnis von 90% festkodiert ist, dann ist es weder
"highly unlikely" noch völlig unnötig sondern sogar unmöglich "to monitor
system resources".
Christian NineBerry Schwarz
[Systemressourcen]
Und weil es grade so schön zum Thema passt:
http://msdn.microsoft.com/voices/askgui05222001.asp
Traubensaft gibt Traubenkraft
Christian "NineBerry" Schwarz
--
.cum yourself