rudimentärer Schutz vor Binary Planting

[HeikoAdams]

Mit folgendem Code sollte man seine Anwendungen zumindest rudimentär gegen Binary Planting schützen können:

Delphi-Quellcode:

function SetPathsSecure: Cardinal;
var
  Info: TOSVersionInfoEx;
  SetDllDirectory: function (lpPathName:PWideChar):Bool; stdcall;
  SetSearchPathMode: function(Flags: DWord):Bool; stdcall;
  hResult: HINST;
  nResult: Cardinal;
  bIsXPSp1: Boolean;
const
    BASE_SEARCH_PATH_ENABLE_SAFE_SEARCHMODE = 1;
begin 
  Result := S_FALSE;
  ZeroMemory(@Info, SizeOf(TOSVersionInfo));
  Info.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);

  // Abbruch, wenn die Windows-Version nicht ermittelt werden konnte
  if not JclWin32.GetVersionEx(Info) then
  begin
    Result := GetLastError;
    Exit;
  end;

  // Es wird mindestens Windows XP SP1 oder Windows 2003 Server benötigt!
  if ((Info.dwMajorVersion = 5) and (Info.dwMinorVersion = 1) and (Info.wServicePackMajor = 0)
     and (Info.wProductType = VER_NT_WORKSTATION))
    or ((Info.dwMajorVersion = 5) and (Info.dwMinorVersion = 0))
    or (Info.dwMajorVersion <= 4) then
  begin
    Result := ERROR_OLD_WIN_VERSION;
    Exit;
  end;

  // SetDllDirectoryW aufrufen, um das Arbeitsverzeichnis im DLL-Suchpfad
  // an das Ende zu verschieben
  hResult := SafeLoadLibrary('Kernel32.dll', SEM_NOOPENFILEERRORBOX);

  try
    if Succeeded(hResult) then
    begin
      @SetDllDirectory := GetProcAddress(hResult, 'SetDllDirectoryW');

      if not SetDllDirectory('') then
        Result := GetLastError
      else
        Result := S_OK;
    end
    else
      Result := GetLastError;

    // Wenn Windows 7 oder neuer verwendet wird, ...
    if (Result = Cardinal(S_OK))
      and (((Info.dwMajorVersion = 6) and (Info.dwMinorVersion >= 1))
        or ((Info.dwMajorVersion > 6))) then
    begin
      // ... SetSearchPathMode aufrufen, um SearchPath und CreateProcess daran zu hindern,
      // zuerst im aktuellen Verzeichnis zu suchen
      @SetSearchPathMode := GetProcAddress(hResult, 'SetSearchPathMode');

      if not SetSearchPathMode(BASE_SEARCH_PATH_ENABLE_SAFE_SEARCHMODE) then
        Result := GetLastError
      else
        Result := S_OK;
    end;
  finally
    FreeLibrary(hResult);
  end;
end;

PS: Diese Funktion soll selbstverständlich niemanden davon befreien, sauberen Sourcecode zu schreiben