Compatibilité avec XP ! [Résolu]

[cincap]

Bonjour à toutes et à tous,

Dans mon application, j'utilise la fonction "Function Wow64DisableWow64FsRedirection" comme elle tourne sous Seven 64bits.

Cette application ne me sert que pour afficher "msconfig.exe" afin de gérer le démarrage.

Cette application devrait fonctionner sous XP à condition d'indiquer le chemin de "msconfig.exe" qui n'est pas le même que sous Seven.

A ce stade les deux applications fonctionnent séparément sous Seven et sous XP.

Ma question, si je ne fais qu'une seule application, sous Seven cela fonctionne correctement mais sur Xp, j'ai le message concernant la fonction "Function Wow64DisableWow64FsRedirection" qui n'existe pas, logique.

Y aurait t'il une astuce pour éviter ce message lorsque je suis sous XP ?

Merci d'avance,

@+,

Cincap

[tourlourou]

Il suffit donc de tester la version de Windows, le mode 64 Bits, et de traiter chaque cas de manière différenciée.

[cincap]

@ Tourlourou, merci de ta suggestion, ce n'est pas autour du code qui charge "msconfig.exe" qu'il y a le message d'erreur mais directement au lancement, soit autour de la fonction déclarée, hors cette fonction doit être déclarée après "implementation".

Je vais quand même faire le test.

@+,

Cincap

[Andnotor]

ShellExecute(Ex) sait retrouver les chemins dans la base des registres contrairement à CreateProcess. Tu n'aurais pas ce problème si tu l'utilisais

Avec un Delphi récent, il est possible de déclarer les fonctions statiques en delayed pour en retarder le chargement au premier appel. Donc comme dit Tourlourou un test de version avant d'invoquer la fonction suffit. Sinon, à l'ancienne, LoadLibrary, GetProcAdress et test sur nil.

[cincap]

@ Andnotor, merci de ta réponse, en effet j'utilise bien "ShellExecute".

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
var
wd, dir : string;
 
begin
wd := Path[CSIDL_SYSTEM] ;   //GetSystemDossier= C:\Windows\System32
dir := 'C:\WINDOWS\PCHealth\HelpCtr\Binaries\';
 
 if ckxp.checked then begin
 If not FileExists(dir + 'msconfig.exe') Then ShowMessage('Sous XP, ce fichier "msconfig.exe" devrait exister dans le dossier "C:\Windows\PCHealth\HelpCtr\Binaries\" !');
 
 ShellExecute(Handle,'Open', PChar(dir + 'msconfig.exe'),nil,nil,SW_SHOWDEFAULT)  //ShellExecute(0, nil, PChar(dir +'msconfig.exe'), nil, nil, 0)else
 end
 else
 
  try
   Wow64DisableWow64FsRedirection(Wow64FsEnableRedirection);
   If not FileExists(wd + 'msconfig.exe') Then ShowMessage('Sous Seven, ce fichier "msconfig.exe" devrait exister dans le dossier "C:\Windows\System32\" !');
   ShellExecute(0, nil, PChar(wd + 'msconfig.exe'), nil, nil, 0);
   Wow64EnableWow64FsRedirection(Wow64FsEnableRedirection);
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;

Seulement avec Seven 64bits, il faut toujours l'enrober avec la fonction "Wow64" à cause du dossier "System32" et de l'Uac.

A moins qu'il existe une autre méthode ?

@+,

Cincap

[Linkin]

Il faut utiliser des liaisons dynamiques:
Par exemple:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
 
procedure ChangeFSRedirection(bDisable: Boolean);
Type
  TWow64DisableWow64FsRedirection = Function(
      Var Wow64FsEnableRedirection: LongBool): LongBool; StdCall;
  TWow64EnableWow64FsRedirection = Function(var Wow64FsEnableRedirection: LongBool): LongBool;
    StdCall;
Var
  hHandle: THandle;
  Wow64DisableWow64FsRedirection: TWow64DisableWow64FsRedirection;
  Wow64EnableWow64FsRedirection: TWow64EnableWow64FsRedirection;
  Wow64FsEnableRedirection: LongBool;
begin
    hHandle := GetModuleHandle(kernel32);
    @Wow64EnableWow64FsRedirection :=
      GetProcAddress(hHandle, 'Wow64EnableWow64FsRedirection');
    @Wow64DisableWow64FsRedirection := GetProcAddress(hHandle, 'Wow64DisableWow64FsRedirection');
 
    if ((hHandle<>0) and (@Wow64EnableWow64FsRedirection<>nil) and
      (@Wow64DisableWow64FsRedirection<>nil)) then
    begin
      if bDisable then
      begin
        Wow64DisableWow64FsRedirection(Wow64FsEnableRedirection);
      end
      else
      begin
        Wow64EnableWow64FsRedirection(Wow64FsEnableRedirection);
      end;
    end;
end;

[cincap]

@ Linkin, merci de ta suggestion (que je connaissai et que je n'ai pas utilisé dans ce cas), en fait j'avais deux façons de procéder,

La 1ère :

Code :

1
2
3
4
5
 
Function Wow64DisableWow64FsRedirection(Var Wow64FsEnableRedirection: LongBool): LongBool; StdCall;
  External 'Kernel32.dll' Name 'Wow64DisableWow64FsRedirection';
Function Wow64EnableWow64FsRedirection(Wow64FsEnableRedirection: LongBool): LongBool; StdCall;
  External 'Kernel32.dll' Name 'Wow64EnableWow64FsRedirection';

Utilisation :

Code :

1
2
3
4
5
 
Wow64DisableWow64FsRedirection(Wow64FsEnableRedirection);
   If not FileExists(wd + 'msconfig.exe') Then ShowMessage('Sous Seven, ce fichier "msconfig.exe" devrait exister dans le dossier "C:\Windows\System32\" !');
   ShellExecute(0, nil, PChar(wd + 'msconfig.exe'), nil, nil, 0);
Wow64EnableWow64FsRedirection(Wow64FsEnableRedirection);

La 2ième comme ta suggestion :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
 
Function ChangeFSRedirection(bDisable: Boolean): Boolean;
 
Type TWow64DisableWow64FsRedirection = Function(Var Wow64FsEnableRedirection: LongBool): LongBool; StdCall; 
      TWow64EnableWow64FsRedirection  = Function(var Wow64FsEnableRedirection: LongBool): LongBool; StdCall;
 
  Var
    hHandle: THandle;
    Wow64DisableWow64FsRedirection: TWow64DisableWow64FsRedirection;
    Wow64EnableWow64FsRedirection:  TWow64EnableWow64FsRedirection;
    Wow64FsEnableRedirection:       LongBool;
 
begin
 
Result := True;
 
try
    hHandle := GetModuleHandle('kernel32.dll');
    @Wow64EnableWow64FsRedirection  := GetProcAddress(hHandle, 'Wow64EnableWow64FsRedirection');
    @Wow64DisableWow64FsRedirection := GetProcAddress(hHandle, 'Wow64DisableWow64FsRedirection');
 
    if bDisAble then begin
     If ((hHandle <> 0) and (@Wow64EnableWow64FsRedirection <> nil) and (@Wow64DisableWow64FsRedirection <> nil)) 
 
Then
      Wow64DisableWow64FsRedirection(Wow64FsEnableRedirection);
    end;
 
    if not bDisAble then
    If ((hHandle <> 0) and (@Wow64EnableWow64FsRedirection <> nil) and (@Wow64DisableWow64FsRedirection <> nil)) 
 
Then
      Wow64EnableWow64FsRedirection(Wow64FsEnableRedirection);
 
Except Result := False;
end; 
end;

Utilisation :

Code :

1
2
3
4
5
 
ChangeFSRedirection(True);
   If not FileExists(wd + 'msconfig.exe') Then ShowMessage('Sous Seven, ce fichier "msconfig.exe" devrait exister dans le dossier "C:\Windows\System32\" !');
   ShellExecute(0, nil, PChar(wd + 'msconfig.exe'), nil, nil, 0);
ChangeFSRedirection(False);

Apparemment il y aurait une distinction entre les deux utilisations !

Pourtant ce n'est pas à l'appui du code de "ShellExecute" que le problème se fait mais au démarrage !

@+,

Cincap

[Andnotor]

Tester la validité de hHandle après GetProcAddress ne sert pas à grand chose

J'ai fait un essai en XE3 qui passe par la redirection de la base des registres et du système de fichiers.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
function Wow64DisableWow64FsRedirection(aOldValue :pointer) :Bool; stdcall; external Kernel32 delayed;
function Wow64RevertWow64FsRedirection(aOldValue :pointer) :Bool; stdcall; external Kernel32 delayed;
 
procedure ShellExecute64(aWnd :hWnd; aVerb, aFileName, aParams, aDir :string; aShow :integer);
var
  Wow64 :LongBool;
  Key   :HKey;
  OldFs :pointer;
 
begin
  IsWow64Process(GetCurrentProcess, Wow64);
 
  if Wow64 then
  begin
    RegOpenKeyEx(HKEY_LOCAL_MACHINE, nil, 0, KEY_QUERY_VALUE or KEY_WOW64_64KEY, Key);
    Wow64DisableWow64FsRedirection(OldFs);
  end;
 
  ShellExecute(aWnd, PChar(aVerb), PChar(aFileName), PChar(aParams), PChar(aDir), aShow);
 
  if Wow64 then
  begin
    Wow64RevertWow64FsRedirection(OldFs);
    RegCloseKey(Key);
  end;
end;

Quelque soit l'OS, l'appel devient simplement:

Code :

ShellExecute64(0, 'open', 'msconfig.exe', '', '', SW_SHOWDEFAULT);

[cincap]

@ Andnotor, merci pour ton explication, si j'ai bien compris, j'execute mon application sur XP et "msconfig.exe" s'affichera sans problème et sans me soucier de son répertoire ou il se trouve et forcément sous Seven.

Edit : je viens de tester et j'ai le message :"Directive inconnue" "Delayed" sous Seven et ce soir je testerai sous XP

@+,

Cincap

[Andnotor]

C'est ça !
Testé sous XP 32, Seven 32 et 64, 8 32.

[cincap]

@ Andnotor, après test sous Seven 64bits et D6, voici le message :

[Erreur] UDemarrage.pas(45): Directive inconnue : 'delayed'
[Erreur] UDemarrage.pas(46): Directive inconnue : 'delayed'
[Erreur] UDemarrage.pas(100): Identificateur non déclaré : 'IsWow64Process'
[Erreur] UDemarrage.pas(104): Identificateur non déclaré : 'KEY_WOW64_64KEY'
[Erreur fatale] CDemarrage.dpr(5): Impossible de compiler l'unité utilisée 'UDemarrage.pas'

@+,

Cincap

[Andnotor]

Delayed a été introduit sous D2010. Donc GetProcAddress obligatoire en D6.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
procedure ShellExecute64(aWnd :hWnd; aVerb, aFileName, aParams, aDir :string; aShow :integer);
var
  DLL   :THandle;
  Wow64 :Bool;
  Key   :HKey;
  OldFs :pointer;
 
  IsWow64Process                 :function(aProcess: THandle; var aWow64Process: Bool): Bool; stdcall;
  Wow64DisableWow64FsRedirection :function(aOldValue :pointer) :Bool; stdcall;
  Wow64RevertWow64FsRedirection  :function(aOldValue :pointer) :Bool; stdcall;
 
const
  KEY_WOW64_64KEY = $0100;
 
begin
  DLL := GetModuleHandle(Kernel32);
  IsWow64Process := GetProcAddress(DLL, 'IsWow64Process');
 
  if Assigned(IsWow64Process)
  then IsWow64Process(GetCurrentProcess, Wow64)
  else Wow64 := FALSE;
 
  if Wow64 then
  begin
    RegOpenKeyEx(HKEY_LOCAL_MACHINE, nil, 0, KEY_QUERY_VALUE or KEY_WOW64_64KEY, Key);
    Wow64DisableWow64FsRedirection := GetProcAddress(DLL, 'Wow64DisableWow64FsRedirection');
    Wow64DisableWow64FsRedirection(OldFs);
  end;
 
  ShellExecute(aWnd, PChar(aVerb), PChar(aFileName), PChar(aParams), PChar(aDir), aShow);
 
  if Wow64 then
  begin
    Wow64RevertWow64FsRedirection := GetProcAddress(DLL, 'Wow64RevertWow64FsRedirection');
    Wow64RevertWow64FsRedirection(OldFs);
    RegCloseKey(Key);
  end;
end;

[Linkin]

@Andnotor: pour la vérification, je n'ai pas fait attention.

[cincap]

@ Andnotor, je viens de tester, cela compile bien mais "msconfig" ne s'affiche pas sous Seven, je testerai avec XP tantôt.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
 
procedure ShellExecute64(aWnd :hWnd; aVerb, aFileName, aParams, aDir :string; aShow :integer);
var
  DLL   :THandle;
  Wow64 :Bool;
  Key   :HKey;
  OldFs :pointer;
 
  IsWow64Process                 :function(aProcess: THandle; var aWow64Process: Bool): Bool; stdcall;
  Wow64DisableWow64FsRedirection :function(aOldValue :pointer) :Bool; stdcall;
  Wow64RevertWow64FsRedirection  :function(aOldValue :pointer) :Bool; stdcall;
 
const
  KEY_WOW64_64KEY = $0100;
 
begin
 
@+,
 
Cincap
  DLL := GetModuleHandle(Kernel32);
  IsWow64Process := GetProcAddress(DLL, 'IsWow64Process');
 
  if Assigned(IsWow64Process)
  then IsWow64Process(GetCurrentProcess, Wow64)
  else Wow64 := FALSE;
 
  if Wow64 then
  begin
    RegOpenKeyEx(HKEY_LOCAL_MACHINE, nil, 0, KEY_QUERY_VALUE or KEY_WOW64_64KEY, Key);
    Wow64DisableWow64FsRedirection := GetProcAddress(DLL, 'Wow64DisableWow64FsRedirection');
    Wow64DisableWow64FsRedirection(OldFs);
  end;
 end;
 
procedure TFDemarrage.BDemarreClick(Sender: TObject);
begin
ShellExecute64(0, 'open', 'msconfig.exe', '', '', SW_SHOWDEFAULT);
end;

[Andnotor]

Si tu ne copie que la moitié de la procédure, c'est sûr que ça va pas marcher

[cincap]

@ Andnotor :

Si tu ne copie que la moitié de la procédure, c'est sûr que ça va pas marcher

J'ai tout copié me semble t'il car cette fonction bloque avec "delayed"

Code :

1
2
3
 
function Wow64DisableWow64FsRedirection(aOldValue :pointer) :Bool; stdcall; external Kernel32 delayed;
function Wow64RevertWow64FsRedirection(aOldValue :pointer) :Bool; stdcall; external Kernel32 delayed;

J'ai loupé un passage, je revérifie.

Edit : ok c'est bon, décidément tu mérites bien ton titre, grand merci à toi.

@+,

Cincap