%programfiles% unter Windows 7 x64

[Sereby]

dein wunsch sei mir befehl :

Delphi-Quellcode:

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.