unit my_safedll;
{DLLプリロード攻撃対策}

interface

implementation
uses
	Windows,
	SysUtils;

function lfnsSystem32DirGet: String;
//システムディレクトリを返す
var
	li_Size : UINT;
	lp_Buff : PChar;
begin
	Result := '';

	li_Size := GetSystemDirectory(nil, 0);
	if (li_Size > 0)
	then begin
		lp_Buff := AllocMem(li_Size * SizeOf(Char));
		try
			li_Size := GetSystemDirectory(lp_Buff, li_Size);
			if (li_Size > 0)
			then begin
				Result := String(lp_Buff) + '\';
			end;
		finally
			FreeMem(lp_Buff);
		end;
	end;
end;


procedure lpcSafeDllInit;
//http://drupal.cre.jp/node/3281
//http://support.microsoft.com/kb/2389418/ja
//http://msdn.microsoft.com/en-us/library/dd266735(v=vs.85).aspx
//SetSearchPathModeやSetDllDirectory APIのないバージョンのOSでも動くよう動的に読み込んで実行
type
	//カレントディレクトリを削除するだけなのでSetDllDirectoryAでOK
	TSetDllDirectory   = function(lpPathName: PChar): BOOL stdcall;
	TSetSearchPathMode = function(Flags: DWORD): BOOL stdcall;
const
	BASE_SEARCH_PATH_ENABLE_SAFE_SEARCHMODE = $1;
	BASE_SEARCH_PATH_PERMANENT              = $8000;
var
	ls_Path             : String;
	lh_Module           : HMODULE;
	l_SetSearchPathMode : TSetSearchPathMode;
	l_SetDllDirectory   : TSetDllDirectory;
begin
	//システムディレクトリを取得
	ls_Path := lfnsSystem32DirGet;

	//完全修飾パスを指定してkernel32.dllをロード
	lh_Module := LoadLibrary(PChar(ls_Path + kernel32));
	if (lh_Module <> 0)
	then begin
		try
			//SetSearchPathModeの関数ポインタを取得
			@l_SetSearchPathMode := GetProcAddress(lh_Module, 'SetSearchPathMode');
			if (@l_SetSearchPathMode <> nil)
			then begin
				//プロセス用の安全なプロセス検索モードを有効にする
				//現在の作業ディレクトリがSearchPath検索一覧で最後の場所に移動する
				l_SetSearchPathMode(BASE_SEARCH_PATH_ENABLE_SAFE_SEARCHMODE or BASE_SEARCH_PATH_PERMANENT);
			end;

			//SetDllDirectoryの関数ポインタを取得
			@l_SetDllDirectory := GetProcAddress(lh_Module, 'SetDllDirectoryW');
			if (@l_SetDllDirectory <> nil)
			then begin
				//現在の作業ディレクトリをDLLの検索順から削除
				l_SetDllDirectory('');
			end;
		finally
			FreeLibrary(lh_Module);
		end;
	end;
end;


initialization
	//unit読み込み時にDLLプリロード攻撃対策を実行
	lpcSafeDllInit;


end.