|
| hente frie resourcer Fra : Michael Vilhelmsen |
Dato : 16-09-03 08:49 |
|
Hej
jeg har brug for, at hente de frie resourcer på en windows 9x maskine (Free
GDI, Free SYS og Free User).
Hvordan kan jeg det ?
Michael
| |
Torben Friis (16-09-2003)
| Kommentar Fra : Torben Friis |
Dato : 16-09-03 09:35 |
|
> jeg har brug for, at hente de frie resourcer på en windows 9x maskine
(Free
> GDI, Free SYS og Free User).
> Hvordan kan jeg det ?
Brug nedenstående unit
unit SystemResources;
interface
uses
Windows, SysUtils;
function GetSystemResources: Integer;
function GetGDIResources: Integer;
function GetUserResources: Integer;
function RunningLowOnResources: Boolean;
implementation
{***************************************************************}
var
hKernel32Dll: HWND;
_QT_Thunk: procedure; cdecl;
hUserExe: HWND;
_GetFreeSystemResources: function(const nResourceType: Word): Word;
stdcall;
function _LoadLibrary16(pLibraryName: PChar): HWND; stdcall; external
kernel32 index 35;
procedure _FreeLibrary16(hInstance: HWND); stdcall; external kernel32 index
36;
function _GetProcAddress16(hInstance: HWND; pProcName: PChar): Pointer;
stdcall; external kernel32 index 37;
function GetFreeSystemResources(const nResourceType: Word): Integer;
var
arrThunk: array[0..32] of Word;
nFreeSystemResources: Word;
begin
Result := -1;
if Win32Platform <> VER_PLATFORM_WIN32_NT then
begin
if Assigned(_GetFreeSystemResources) then
begin
arrThunk[0] := hUserExe;
asm
push nResourceType
mov edx, _GetFreeSystemResources
call _QT_Thunk
mov nFreeSystemResources, ax
end;
Result := nFreeSystemResources;
end;
end;
end;
function GetSystemResources;
begin
Result := GetFreeSystemResources(0);
end;
function GetGDIResources;
begin
Result := GetFreeSystemResources(1);
end;
function GetUserResources;
begin
Result := GetFreeSystemResources(2);
end;
function RunningLowOnResources;
const
MINIMUMRESOURCES = 10;
var
nSystemResources, nGDIResources, nUserResources: Integer;
begin
Result := False;
if Win32Platform <> VER_PLATFORM_WIN32_NT then
begin
nSystemResources := GetSystemResources;
nGDIResources := GetGDIResources;
nUserResources := GetUserResources;
Result := ((nSystemResources <= MINIMUMRESOURCES) and (nSystemResources
> -1)) or ((nGDIResources <= MINIMUMRESOURCES) and (nGDIResources > -1)) or
((nUserResources <= MINIMUMRESOURCES) and (nUserResources > -1));
end;
end;
initialization
begin
if Win32Platform <> VER_PLATFORM_WIN32_NT then
begin
hKernel32Dll := LoadLibrary(kernel32);
if hKernel32Dll > 0 then
begin
@_QT_Thunk := GetProcAddress(hKernel32Dll, 'QT_Thunk');
if Assigned(_QT_Thunk) then
begin
hUserExe := _LoadLibrary16('user.exe');
if hUserExe >= 32 then
@_GetFreeSystemResources := _GetProcAddress16(hUserExe,
'GetFreeSystemResources');
end;
end;
end;
end;
finalization
begin
if Win32Platform <> VER_PLATFORM_WIN32_NT then
begin
if hKernel32Dll > 0 then
begin
if hUserExe >= 32 then
_FreeLibrary16(hUserExe);
FreeLibrary(hKernel32Dll);
end;
end;
end;
end.
| |
Michael Vilhelmsen (16-09-2003)
| Kommentar Fra : Michael Vilhelmsen |
Dato : 16-09-03 10:21 |
|
Jeg takker mange gange.
Michael
"Torben Friis" <tf@proinfo._dk_> skrev i en meddelelse
news:mXz9b.72540$Kb2.3412398@news010.worldonline.dk...
> > jeg har brug for, at hente de frie resourcer på en windows 9x maskine
> (Free
> > GDI, Free SYS og Free User).
> > Hvordan kan jeg det ?
>
> Brug nedenstående unit
>
>
> unit SystemResources;
> interface
>
> uses
> Windows, SysUtils;
>
> function GetSystemResources: Integer;
> function GetGDIResources: Integer;
> function GetUserResources: Integer;
> function RunningLowOnResources: Boolean;
>
> implementation
> {***************************************************************}
>
> var
> hKernel32Dll: HWND;
> _QT_Thunk: procedure; cdecl;
> hUserExe: HWND;
> _GetFreeSystemResources: function(const nResourceType: Word): Word;
> stdcall;
>
> function _LoadLibrary16(pLibraryName: PChar): HWND; stdcall; external
> kernel32 index 35;
> procedure _FreeLibrary16(hInstance: HWND); stdcall; external kernel32
index
> 36;
> function _GetProcAddress16(hInstance: HWND; pProcName: PChar): Pointer;
> stdcall; external kernel32 index 37;
>
> function GetFreeSystemResources(const nResourceType: Word): Integer;
> var
> arrThunk: array[0..32] of Word;
> nFreeSystemResources: Word;
> begin
> Result := -1;
> if Win32Platform <> VER_PLATFORM_WIN32_NT then
> begin
> if Assigned(_GetFreeSystemResources) then
> begin
> arrThunk[0] := hUserExe;
> asm
> push nResourceType
> mov edx, _GetFreeSystemResources
> call _QT_Thunk
> mov nFreeSystemResources, ax
> end;
> Result := nFreeSystemResources;
> end;
> end;
> end;
>
> function GetSystemResources;
> begin
> Result := GetFreeSystemResources(0);
> end;
>
> function GetGDIResources;
> begin
> Result := GetFreeSystemResources(1);
> end;
>
> function GetUserResources;
> begin
> Result := GetFreeSystemResources(2);
> end;
>
> function RunningLowOnResources;
> const
> MINIMUMRESOURCES = 10;
> var
> nSystemResources, nGDIResources, nUserResources: Integer;
> begin
> Result := False;
> if Win32Platform <> VER_PLATFORM_WIN32_NT then
> begin
> nSystemResources := GetSystemResources;
> nGDIResources := GetGDIResources;
> nUserResources := GetUserResources;
> Result := ((nSystemResources <= MINIMUMRESOURCES) and
(nSystemResources
> > -1)) or ((nGDIResources <= MINIMUMRESOURCES) and (nGDIResources > -1))
or
> ((nUserResources <= MINIMUMRESOURCES) and (nUserResources > -1));
> end;
> end;
>
> initialization
> begin
> if Win32Platform <> VER_PLATFORM_WIN32_NT then
> begin
> hKernel32Dll := LoadLibrary(kernel32);
> if hKernel32Dll > 0 then
> begin
> @_QT_Thunk := GetProcAddress(hKernel32Dll, 'QT_Thunk');
> if Assigned(_QT_Thunk) then
> begin
> hUserExe := _LoadLibrary16('user.exe');
> if hUserExe >= 32 then
> @_GetFreeSystemResources := _GetProcAddress16(hUserExe,
> 'GetFreeSystemResources');
> end;
> end;
> end;
> end;
>
> finalization
> begin
> if Win32Platform <> VER_PLATFORM_WIN32_NT then
> begin
> if hKernel32Dll > 0 then
> begin
> if hUserExe >= 32 then
> _FreeLibrary16(hUserExe);
> FreeLibrary(hKernel32Dll);
> end;
> end;
> end;
>
> end.
>
>
| |
|
|