Probleme von ShellExecute unter Win2003 Server 64 Bit

[nicodex]

Man kann versuchen die File System Redirection des WOW64-"Emulators" für den Aufruf zu deaktivieren.

Delphi-Quellcode:

function Wow64DisableWow64FsRedirection(out AOldValue: Pointer): BOOL; stdcall;
type
  TFNRealApiProc = function(out AOldValue: Pointer): BOOL; stdcall;
const
  RealApiName = 'Wow64DisableWow64FsRedirection';
{$WRITEABLECONST ON}
const
  Initialized: Integer = 0;
  RealApiProc: TFNRealApiProc = nil;
{$WRITEABLECONST OFF}
begin
  if Initialized = 0 then
  begin
    RealApiProc := TFNRealApiProc(GetProcAddress(GetModuleHandle(kernel32),
      RealApiName));
    InterlockedIncrement(Initialized);
  end;
  if Assigned(RealApiProc) then
    Result := RealApiProc(AOldValue)
  else
  begin
    SetLastError(ERROR_CALL_NOT_IMPLEMENTED);
    Result := False;
  end;
end;

function Wow64RevertWow64FsRedirection(AOldValue: Pointer): BOOL; stdcall;
type
  TFNRealApiProc = function(AOldValue: Pointer): BOOL; stdcall;
const
  RealApiName = 'Wow64RevertWow64FsRedirection';
{$WRITEABLECONST ON}
const
  Initialized: Integer = 0;
  RealApiProc: TFNRealApiProc = nil;
{$WRITEABLECONST OFF}
begin
  if Initialized = 0 then
  begin
    RealApiProc := TFNRealApiProc(GetProcAddress(GetModuleHandle(kernel32),
      RealApiName));
    InterlockedIncrement(Initialized);
  end;
  if Assigned(RealApiProc) then
    Result := RealApiProc(AOldValue)
  else
  begin
    SetLastError(ERROR_CALL_NOT_IMPLEMENTED);
    Result := False;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
const
  FileName = 'sigverif.exe';
var
  ExecCode: Integer;
  RevertFs: BOOL;
  OldValue: Pointer;
  MsgText: string;
begin
  ExecCode := E_UNEXPECTED;
  RevertFs := False;
  try
    ExecCode := Integer(ShellExecute(Handle, nil, FileName, nil, nil, SW_SHOW));
    case ExecCode of
      ERROR_FILE_NOT_FOUND,
      ERROR_PATH_NOT_FOUND,
      SE_ERR_DLLNOTFOUND:
        begin
          RevertFs := Wow64DisableWow64FsRedirection(OldValue);
          if RevertFs then
            ExecCode := Integer(
              ShellExecute(Handle, nil, FileName, nil, nil, SW_SHOW));
        end;
    end;
  finally
    if RevertFs then
      Wow64RevertWow64FsRedirection(OldValue);
  end;
  MsgText :=
    'ShellExecute: $' + IntToHex(ExecCode, 8) + ' (' + IntToStr(ExecCode) +
    ')'#13#10'FsRedirected: ' + BoolToStr(RevertFs, True);
  if ExecCode <= 32 then
    MsgText := MsgText + #13#10#13#10 + SysErrorMessage(ExecCode);
  ShowMessage(MsgText);
end;

Allerdings kann es diverse Probleme geben (Falls die API intern einen neuen Thread erzeugt, dann 'erbt' dieser nicht den Status der File System Redirection. Und falls die API intern DLLs laden muss (32-bit), dann wird dies fehlschlagen, da die 64-Bit DLLs gefunden werden).

Wie Luckie bereits erwähnte, besteht die 'saubere' Lösung aus einer nativen (64-Bit) Version deines Programms (oder der Nutzung eines nativen out-of-process (COM-)Objekts).