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;