この発言に対し以下のコメントが寄せられています

#01013　遠藤　俊裕　　　さん　RE:9x のリソース不足を未然に防ぐ。





9x ではリソース不足などというわけのわからないもののおかげで
window の生成に注意を払わなければならないと言うわけの分から
ないプログラミングをしなければなりません。
でも、リソースを調べるにはサンクなどというこれまたわけの分
からないものを使わなくてはならず困ってしまいます。
そのためのサンプルを示します。
Thunk についてはこの辺がよさげかと。
http://www.itecuk.com/delmag/thunk95.htm

ただ、Thunk は NT には無い機能なので、NT とソースが混在出来
ない欠点があります。
このサンプルはそれも回避しています。
つまり、9x でも NT でも動きます。

,,,,,

type
  EThunkError = class(Exception);

function CheckMemory: Boolean;
procedure ShowError(ErrNo: Integer);

implementation

{$R *.DFM}

function LoadLibrary16(dllName: PChar): THandle; stdcall;
    external 'kernel32.dll' index 35;
function FreeLibrary16(hHand: THandle): Integer; stdcall;
    external 'kernel32.dll' index 36;
function GetProcAddress16(handle: integer; ProcName: PChar): pointer;
    stdcall; external 'kernel32.dll' index 37;

function GetFreeSysRes(SysRes: Word): Word;
var
  ThunkTrash    : array[0..$20] of Word;
  hInst         : THandle;
  globalPointer : Pointer;
  QT_Thunk      : TProcedure;
  Kernel32Mod   : THandle;
begin
  Result := 100;
  if SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT then
    exit;
//  else if SysUtils.Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
//    isWin9x;

  ThunkTrash[0] := 0;

  Kernel32Mod := GetModuleHandle('Kernel32.Dll');
  QT_Thunk := GetProcAddress(Kernel32Mod, 'QT_Thunk');
  try
    if @QT_Thunk = nil then
      raise EThunkError.Create('Flat thunks only supported under Windows 95');
  except
    exit;
  end;

  hInst := LoadLibrary16('user.exe');
  globalPointer := GetProcAddress16(hInst, 'GetFreeSystemResources');

  asm
    push SysRes
    mov  edx, globalPointer
    call QT_Thunk
    mov  Result, ax
  end;

  FreeLibrary16(hInst);
end;

Function CheckMemory: Boolean;
begin
  Result := False;

  if GetFreeSysRes(0) < 10 then Result := True; // 各リソースが 10%
  if GetFreeSysRes(1) < 10 then Result := True; // 以下になったら不
  if GetFreeSysRes(2) < 10 then Result := True; // 安定と判断。
end;

Procedure ShowError( ErrNo: Integer );
begin
  case ErrNo of
    1: MessageDlg( 
           'メモリ不足です。いくつかのウィンドウを閉じるか' + #13#10 +
           '他のアプリケーションを終了して下さい。', mtError, [mbOK], 0 
                 );
  end;
end;


使い方は

if CheckMemory then ShowError( 1 );

とかです。

                                     00/01/29(土) 21:44 遠藤　俊裕(SGU02140)

Original document by 遠藤　俊裕　　　氏 ID:(SGU02140)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。