unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 =
class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
TWow64DisableWow64FsRedirection =
function(
var Wow64FsEnableRedirection: LongBool): LongBool;
stdcall;
TWow64EnableWow64FsRedirection =
function(
var Wow64FsEnableRedirection: LongBool): LongBool;
stdcall;
var
//64bit umleitung
Wow64DisableWow64FsRedirection: TWow64DisableWow64FsRedirection;
Wow64EnableWow64FsRedirection: TWow64EnableWow64FsRedirection;
Wow64FsEnableRedirection: LongBool;
KernelHandle: THandle;
Form1: TForm1;
implementation
{$R *.dfm}
uses ShlObj;
function ExpandEnvStr(
const szInput:
String):
String;
const MAXSIZE = 32768;
begin
SetLength(Result,MAXSIZE);
SetLength(Result,ExpandEnvironmentStrings(pchar(szInput),
@Result[1],length(Result)));
//unnötige #0 zeichen am ende entfernen
Result := Trim(Result);
end;
function GetSpecialFolder(Folder: Integer):
String;
var
Path:
array[0..MAX_PATH-1]
of Char;
begin
Result := '
';
if SHGetSpecialFolderPath(Application.Handle, @Path, Folder, False)
then Result := Path;
end;
function ChangeFSRedirection(
const DisableIT: Boolean): Cardinal;
begin
if DisableIT
then
begin
if (@Wow64EnableWow64FsRedirection <>
nil)
and (@Wow64DisableWow64FsRedirection <>
nil)
then
Wow64DisableWow64FsRedirection(Wow64FsEnableRedirection);
end else
begin
if (@Wow64EnableWow64FsRedirection <>
nil)
and (@Wow64DisableWow64FsRedirection <>
nil)
then
Wow64EnableWow64FsRedirection(Wow64FsEnableRedirection);
end;
Result := GetLastError;
end;
procedure Init64BitRedir;
begin
if (KernelHandle = 0)
then KernelHandle := LoadLibrary(kernel32);
if (KernelHandle <> 0)
then
begin
@Wow64DisableWow64FsRedirection := GetProcAddress(KernelHandle, '
Wow64RevertWow64FsRedirection');
@Wow64EnableWow64FsRedirection := GetProcAddress(KernelHandle, '
Wow64EnableWow64FsRedirection');
end;
end;
procedure Close64BitRedir;
begin
if (KernelHandle <> 0)
then
begin
FreeLibrary(KernelHandle);
KernelHandle := 0;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Dir1,Dir2,Dir3,Dir4:
String;
Err1, Err2: Cardinal;
const
CSIDL_PROGRAM_FILES = '
$26';
CSIDL_PROGRAM_FILESX86 = '
$2A';
CRLF = #13#10;
begin
Err1 := ChangeFSRedirection(True);
Dir1 := '
x64: ' + ExpandEnvStr('
%programfiles%');
Dir2 := '
x86: ' + ExpandEnvStr('
%programfiles(x86)%');
Dir3 := '
x64: ' + GetSpecialFolder(StrToInt(CSIDL_PROGRAM_FILES));
Dir4 := '
x86: ' + GetSpecialFolder(StrToInt(CSIDL_PROGRAM_FILESX86));
Err2 := ChangeFSRedirection(False);
Showmessage('
Disable-Return: ' + IntToStr(Err1) + CRLF + Dir1 + CRLF + Dir2 + CRLF + Dir3 + CRLF + Dir4 + CRLF+ '
Enable-Return: ' + IntToStr(Err2));
Showmessage(SyserrorMessage(Err1));
end;
initialization
Init64BitRedir;
finalization
Close64BitRedir;
end.