%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.

[gore]

Auch wenn die Frage schon älter ist, werden sicherlich einige noch noch der Lösung suchen (und auf diesen Thread stoßen). Deshalb hier eine einfache Lösung:

Delphi-Quellcode:

RegReadString64(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows\CurrentVersion','ProgramFilesDir','');


function RegReadString64(MainKey:HKey; SubKey,ValueName,sDefault:string):string;
const KEY_WOW64_64KEY = $0100;
var DType: Integer;
    BSize: Integer;
    Key:HKey;
    a2,a:array[0..MAX_PATH]of char;
    p:PChar;
begin
  result:=sDefault;
  DType := REG_SZ;
  BSize:=sizeof(a);
  p:=a;
  if RegOpenKeyEx(MainKey, PChar(SubKey), 0, KEY_READ or KEY_WOW64_64KEY , Key)<>ERROR_SUCCESS then exit;
  if RegQueryValueEx(key,PChar(ValueName),nil,@DType, PByte(p), @BSize) <> ERROR_SUCCESS then begin RegCloseKey(Key); exit; end;
  RegCloseKey(Key);
  a[BSize]:=#0; //sonst Fehler beim lesen von ''
  if DType=REG_EXPAND_SZ then if ExpandEnvironmentStrings(a,a2,sizeof(a2))>0 then StrCopy(a,a2);
  result:=StrPas(a);
end;

Tschuldigung für den furchtbaren Code, aber hauptsache es klappt erstmal unter Delphi.

Anmerkung: Der Code klappt erst ab Win7, siehe http://msdn.microsoft.com/en-us/libr...(v=VS.85).aspx :
Either KEY_WOW64_32KEY or KEY_WOW64_64KEY can be specified. If both flags are specified, the function fails with ERROR_INVALID_PARAMETER.
Windows Server 2008, Windows Vista, Windows Server 2003, and Windows XP: If both flags are specified, the function’s behavior is undefined.