DLLにおいて呼び出し元のモジュール名を得る方法

昔、Delphi-MLに投稿した、DLLにおいて呼び出し元のモジュール名を得るためのサンプル。
自作DLLの利用を制限させたい場合などに利用できるかも知れない。過去ログから探すのに苦労したため、今後のためにここに貼っておく。

まず、スタックをさかのぼり、DLLの呼び出し元(リターンアドレス)を取得する。(asm〜endの、アセンブラ記述部)。次に、Toolhelp32を利用してロードされているモジュール一覧とそのアドレスを列挙し、リターンアドレスがどのモジュールの範囲に含まれているかを検索している。
自作DLLに組み込む場合、関数のネストする段数によってスタック内でのリターンアドレスの位置が変わることに注意。

以下、呼び出し元の EXE/DLL のモジュール名を返す DLL のサンプルです。モジュールごとのアドレスを取得するのに Toolhelp32 を使っていますので、NT4 では動きません。

foo.exe --> Sample.dll という呼び出しであれば、'path\foo.exe' を返し、foo.exe --> bar.dll --> Sample.dll という呼び出しであれば、'path\bar.dll'を返します。

動作確認は Delphi 5 on Windows 98SE ですので、他ではもしかすると動作しないかもしれません。

library Sample;
uses SysUtils, Windows;

const
  TH32CS_SNAPMODULE = $8;
  MAX_MODULE_NAME32 = 255;

type
  TMODULEENTRY32 = record
    dwSize:        DWORD;
    th32ModuleID:  DWORD;
    th32ProcessID:  DWORD;
    GlblcntUsage:  DWORD;
    ProccntUsage:  DWORD;
    modBaseAddr:    DWORD;
    modBaseSize:    DWORD;
    hModule:        HMODULE;
    szModule:      array [0..MAX_MODULE_NAME32] of Char;
    szExePath:      array [0..MAX_PATH] of Char;
  end;
  LPMODULEENTRY32 = ^TMODULEENTRY32;

function CreateToolhelp32Snapshot( dwFlags:DWORD; th32ProccessID:DWORD ):THANDLE stdcall; external 
'kernel32.dll';
function Module32First( hSnapshot:THandle; lpme:LPMODULEENTRY32 ):LongBool stdcall; external 
'kernel32.dll';
function Module32Next( hSnapshot:THandle; lpme:LPMODULEENTRY32 ):LongBool stdcall; external 
'kernel32.dll';

function GetCallerModuleName( P:PChar; dwSize:DWORD ):LongBool; stdcall;
var
  h: DWORD;    
  Ent: TMODULEENTRY32;
  Caller: DWORD;
begin
  Result := False;
  asm
    push  ebx
    mov  ebx, ebp
    add  ebx, 4
    mov  eax, [ebx]
    mov  Caller, eax
    pop  ebx
  end;
  h := CreateToolhelp32snapshot( TH32CS_SNAPMODULE, GetCurrentProcessID );
  if h <> $FFFFFFFF then
  try
    Ent.dwSize := SizeOf( Ent );
    if Module32First( h, @Ent ) then
    repeat
      if ( Ent.modBaseAddr <= Caller ) and
        ( Caller <= Ent.modBaseAddr + Ent.modBaseSize ) then
      begin
        Result := True;
        StrLCopy( P, Ent.szExePath, dwSize );
        break;
      end;
    until not Module32Next( h, @Ent );
  finally
    CloseHandle( h );
  end;
end;

exports GetCallerModuleName;

begin
end;