%programfiles% unter Windows 7 x64

[Sereby]

hi

ich versuche gerade die ganze zeit vergeblich auf das "C:\Program files" verzeichnis zuzugreifen, vergeblich :(
%programfiles% in einer CMD ergebit das gewünschte ergebnis. wenn ich es jedoch in Delphi versuche scheitert es und ich weiss nicht warum

habe ein Testprojekt angehängt.
- Delphi 2009 U3
- W7 RTM x64

[Bernhard Geyer]

Zitat:

Zitat von Sereby

- W7 RTM x64

Darum!

Du bekommt bei einem 32-Bit Prozess "C:\Program Files (x86)" und beim Aufruf von einem 64-Bit Prozess "C:\Program Files".

[Sereby]

wenn du in mein project gucken würdest hättest du auch bemerkt, dass ich es z.B. mit Wow64DisableWow64FsRedirection versucht habe wo diese umleitung deaktiviert werden sollte sowie mit SHGetSpecialFolderPath bei der das absolut keine rolle spielen sollte!

[markus5766h]

Hallo, bei mir funktionierts :
Win 7 Enterprise Build 7600 64bit

[Sereby]

also bei mir zeigen alle 4 pfade in der Messagebox den pfad zu den 32bit programmen an..
ich denke auch nicht dass es an der windows version oder ähnlichem liegt! muss unter "enterprise" genauso sein wie unter Ultimate

[Luckie]

Zitat:

Zitat von Sereby

wenn du in mein project gucken würdest hättest du auch bemerkt, dass ich es z.B. mit Wow64DisableWow64FsRedirection versucht habe wo diese umleitung deaktiviert werden sollte sowie mit SHGetSpecialFolderPath bei der das absolut keine rolle spielen sollte!

Funktioniert das denn? Was gibt GetLastError zurück?

[Sereby]

siehe anhang

edit: deine signatur is gut.. entspricht leider auch der wahrheit :-/

[Luckie]

Ich meine nicht die Programmausgabe, sondern den Rückgabewert von Wow64DisableWow64FsRedirection.

[Sereby]

siehe bild..
die erste zeile ist ChangeFSRedirection(True); und die letzte ist ChangeFSRedirection(False);

Also Disable ist Returncode 0 und Enable 1008

edit: da der return-code 0 ist scheint die funktion zu scheitern.. aber warum?

[Luckie]

Ach so. das sind die Rückgabewerte.

Zitat:

If the function succeeds, the return value is a nonzero value.

If the function fails, the return value is zero. To get extended error information, call GetLastError.

Wenn der Rückgabewert 0 ist, schlägt der Aufruf fehl.

mach mal:

Delphi-Quellcode:

if not Wow64DisableWow64FsRedirection(...) then
  SyserrorMessage(GetLastError);

dann solltest du den Grund wissen.

[Sereby]

das funzt nicht weil 0 = True :) also wird der das niemals machen und eine Fehlermeldung für Feherlcode 0 gibts meines wissens nach nicht aber ich kanns iwie nicht prüfen da der keine Messageboxen mehr zeigen möchte :)?
der geht da zwar hin aber ignoriert das einfach.. überpringt den code sozusagen!

edit.. so ka was ich gemacht hab aber nu gehts aber "Der Vorgang wurde erfolgreich beendet" ist wohl nicht der Fehler :)

[himitsu]

http://msdn.microsoft.com/en-us/library/aa365743.aspx

Du hast dir auch schonmal den Abschnitt mit den Erläuterungen angesehn?
Da steht ein "wichtiger" Punkt, welchen ich in deinem Testprogramm nicht entdecken konnte.

oder erstellt dein Delphi außschließlich WinNT-Programme?
( PE-Flags + WIN32_WINNT )

[Luckie]

Zitat:

Zitat von Sereby

das funzt nicht weil 0 = True :) also wird der das niemals machen

Wie kommst du denn darauf?

Zitat:

f the function fails, the return value is zero.

[Sereby]

meinst du das mit "_WIN32_WINNT"?
wenn ja dann bitte ich dich mir zu erklären wie und wo ich das definieren muss ^^

wenn du das mit Revert meinst, dann habe ich das auch schon probiert ändert aber nichts an der tatsache, dass die umschaltung dann trotzdem funktionieren müsste!

@luckie:
aber errorcode 0 entspricht doch True wenn ich mich nich total irre.. zumindest dann bei LongBool

[Luckie]

Nein. Null ist false und lies doch endlich mal die Dokumentation:

Zitat:

if the function fails, the return value is zero.

Wenn der Rückgabewert Null ist, ist die Funktion fehlgeschlagen.

[Sereby]

ja das weiss ich doch :)
meine frage ist schon seit heut mittag warum das nicht funktioniert ;)

ich sehe keinen grund ausser dieses komische _WIN32_WINNT dingens was ich nicht weiss wo/wie das hin muss/darf

[Luckie]

Was gibt denn jetzt GetLastError zurück? dann hast du doch die Erklärung.

[Sereby]

wie bereits vorhin erwähnt gibt GetLastError den Wert 0 zurück und SyserrorMessage macht daraus ein "Die Vorgang wurde erfolgreich beendet"

[Luckie]

Das kann doch nicht sein. Zeig mal Code.

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

[Luckie]

Du testest ja auf nil. Mach es mal so, wie ich es geschrieben habe.

[Sereby]

die prüfung auf nil ist dafür gedacht dass das programm auch auf 32bit systemen laufen soll und die diese funktion nicht haben!
und er geht ja in die funktion rein das is ja nicht das problem

[Luckie]

Sorry, das ist ja nur der test, ob die Funktion geladen wurde. Aber hier hast du keine fehlerüberprüfung:

Delphi-Quellcode:

Wow64DisableWow64FsRedirection(Wow64FsEnableRedirection);

Das will ich doch die ganze zeit wissen. Da sollst du meinen Code reinschreiben.

Bzw. hier:

Delphi-Quellcode:

Wow64EnableWow64FsRedirection(Wow64FsEnableRedirection);

[Sereby]

am ende der funktion wird GetLastError aufgerufen und als rückgabewert gesetzt.
diesen speichere ich und ist wie bereits mehrfach erwähnt 0!

wenn ich daraus das mache wie du beschrieben hast macht er absolut nichts weil "if not Wow64DisableWow64FsRedirection(Wow64FsEnableRedire ction) then ..." nicht zutrifft weil 0 bei LongBool nunmal True ist

[himitsu]

GetLastError liefert "nur" den letzen Fehler ... bei OK muß dessen Wert also nicht stimmen.

Delphi-Quellcode:

function ChangeFSRedirection(const DisableIT: Boolean): Cardinal;
begin
  if (@Wow64EnableWow64FsRedirection <> nil) and (@Wow64DisableWow64FsRedirection <> nil) then
  begin
    if DisableIT then
    begin
      if Wow64DisableWow64FsRedirection(Wow64FsEnableRedirection) then
        Result := S_OK
      else
        Result := GetLastError;
    end
    else
    begin
      if Wow64EnableWow64FsRedirection(Wow64FsEnableRedirection) then
        Result := S_OK
      else
        Result := GetLastError;
    end;
  end else
    Result := {hier einen Fehlercode für "nicht aktiv" einsetzen};
end;

und in kurz

Delphi-Quellcode:

function ChangeFSRedirection(const DisableIT: Boolean): Cardinal;
begin
  if Assigned(Wow64EnableWow64FsRedirection) and Assigned(Wow64DisableWow64FsRedirection) then
  begin
    if (DisableIT and Wow64DisableWow64FsRedirection(Wow64FsEnableRedirection))
        or (not DisableIT and Wow64EnableWow64FsRedirection(Wow64FsEnableRedirection)) then
      Result := S_OK
    else
      Result := GetLastError;
  end else
    Result := {hier einen fehlercode für "nicht aktiv" einsetzen};
end;

[Luckie]

Definier es mal als BOOL wie es auch in der Doku steht und frag GetLastError sofort ab, wer weiß, was da nach noch für Funktionsaufrufe kommen, die nicht fehlschlagen.

[Sereby]

jetzt liefern beide Funktionen S_OK als Rückgabewert
rückgabewert geändert auf Bool und die Kurze Variante von unten samt nor = not änderung

aber die pfade sind weiterhin alle auf Programfiles x86

[Luckie]

Und das bei himitsus Code?

[Sereby]

ja, das bei seinem Code :)

[Luckie]

Jetzt wird es komisch. Welche Rechte hat das Programm? Ist ein Manifest eingebunden?

[himitsu]

Welche Delphi-Version nutzt du eigentlich?

bei den Neueren kann man in den Projektoptionen die PE-Flags setzen

[Sereby]

- Delphi 2009 Update 3
bds.exe starte ich immer mit Admin rechten damit ich überhaupt debuggen kann und somit wird das kompilierte programm ebenfalls mit admin-rechten gesatrtet. auch ein manuelles ausführen der kompilierten .exe mit admin rechten liefert das selbe ergebnis


edit: was muss ich da denn nun genau setzen? zwischen C und Delphi sind ja doch nen paar unterschiede

[Luckie]

Zum Debuggen braucht man keine Adminrechte.

[Sereby]

dann hast du wohl noch nie unter NT6 x64 versucht zu debuggen

edit:
wenn ich bei den projekt-optionen "Zusätzliche PE-Header Flags setzen" auf 0501 bzw 501 setze funzt es trotzdem nicht

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