unit my_safedll;

interface

implementation
uses
	Windows,
	SysUtils;

function lfnbIsNtOS: Boolean;
//OSがNT系ならTrueを返す
var
	lr_Info: TOSVersionInfo;
begin
	Result := False;
	FillChar(lr_Info, SizeOf(lr_Info), 0);
	lr_Info.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);;
	if (GetVersionEx(lr_Info)) then begin
		Result := (lr_Info.dwPlatformId = VER_PLATFORM_WIN32_NT);
	end;
end;

function lfnsSystem32DirGet: WideString;
var
	li_Size:  UINT;
	lp_WBuff: PWideChar;
	lp_ABuff: PAnsiChar;
begin
	Result := '';

	if (lfnbIsNtOS) then begin
		li_Size := GetSystemDirectoryW(nil, 0);
		if (li_Size > 0) then begin
			lp_WBuff := AllocMem(li_Size * 2);
			try
				li_Size := GetSystemDirectoryW(lp_WBuff, li_Size);
				if (li_Size > 0) then begin
					Result := WideString(lp_WBuff) + '\';
				end;
			finally
				FreeMem(lp_WBuff);
			end;
		end;
	end else begin
		li_Size := GetSystemDirectoryA(nil, 0);
		if (li_Size > 0) then begin
			lp_ABuff := AllocMem(li_Size);
			try
				li_Size := GetSystemDirectoryA(lp_ABuff, li_Size);
				if (li_Size > 0) then begin
					Result := AnsiString(lp_ABuff) + '\';
				end;
			finally
				FreeMem(lp_ABuff);
			end;
		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
	ls_Path:   WideString;
	lh_Module: HMODULE;
	l_SetSearchPathMode: TSetSearchPathMode;
	l_SetDllDirectory:   TSetDllDirectory;
begin
	ls_Path := lfnsSystem32DirGet;

	lh_Module := LoadLibraryW(PWideChar(ls_Path + 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.