unit my_safedll;

interface

implementation
uses
	Windows,
	SysUtils;

function _GetSystem32Dir: WideString;
var
	li_Size : UINT;
	lp_Buff : PWideChar;
begin
	Result := '';

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


procedure lpcSafeDllInit;
//http://drupal.cre.jp/node/3281
// SetSearchPathMode や SetSearchPathMode を持たないバージョンのOSでも
// 動作するように動的に読み込んで実行する
type
	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
	lh_Module           : HMODULE;
	l_SetSearchPathMode : TSetSearchPathMode;
	l_SetDllDirectory   : TSetDllDirectory;
begin
	lh_Module := LoadLibraryW(PWideChar(_GetSystem32Dir + kernel32));
	if (lh_Module <> 0)
	then begin
		try
			// SetSearchPathMode の関数ポインタを取得
			@l_SetSearchPathMode := GetProcAddress(lh_Module, 'SetSearchPathMode');
			if (@l_SetSearchPathMode <> nil)
			then begin
				l_SetSearchPathMode(BASE_SEARCH_PATH_ENABLE_SAFE_SEARCHMODE or BASE_SEARCH_PATH_PERMANENT);
			end;

			// SetDllDirectory の関数ポインタを取得
			// 今回はカレントディレクトリを削除するだけなので、
			// SetDllDirectoryA で十分。必要があれば SetDllDirectoryW で。
			@l_SetDllDirectory := GetProcAddress(lh_Module, 'SetDllDirectory');
			if (@l_SetDllDirectory <> nil)
			then begin
				l_SetDllDirectory('');
			end;
		finally
			FreeLibrary(lh_Module);
		end;
	end;
end;


initialization
	lpcSafeDllInit;


end.