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

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
    //NT系OS
    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
    //9x系OS
    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
//http://support.microsoft.com/kb/2389418/ja
//http://msdn.microsoft.com/en-us/library/dd266735(v=vs.85).aspx
//SetSearchPathModeやSetDllDirectory APIがないバージョンの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;

  //完全修飾パスを指定してkernel32.dllをロード
  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
        //プロセス用の安全なプロセス検索モードを有効にする
        //現在の作業ディレクトリがSearchPath検索一覧で最後の場所に移動する
        l_SetSearchPathMode(BASE_SEARCH_PATH_ENABLE_SAFE_SEARCHMODE or BASE_SEARCH_PATH_PERMANENT);
      end;

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


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


end.

program Project1;

uses
  my_safedll, //一番最初に指定
  Forms,
  main in 'main.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.