Search code examples
windowsdelphidelphi-7

Launch Windows Optimize application (Windows 10) from Delphi


We have a legacy Delphi 7 application that launches the Windows Defrag and On-screen Keyboard applications as follows:

// Defragmentation application
ShellExecute(0, 'open', PChar('C:\Windows\System32\dfrg.msc'), nil, nil, SW_SHOWNORMAL);

// On-screen keyboard
ShellExecute(0, 'open', PChar('C:\Windows\System32\osk.exe'), nil, nil, SW_SHOWNORMAL);

Both work on Windows XP but fail on Windows 10. I spotted that the defragmentation application has had a name change to dfrgui.exe, but updating the code does not help. The On-screen Keyboard is still called osk.exe on Windows 10.

Both applications can be launched manually / directly from the command line or by double-clicking them in Windows Explorer.

My suspicion is that Windows security is preventing my application from launching anything from C:\Windows\System32, because I can launch several other applications from Program Files and from C:\Windows.

Can anyone help?


Solution

  • Delphi 7 produces only 32-bit apps, there is no option to produce 64-bit apps (that was added in XE2).

    Accessing a path under %WINDIR%\System32 from a 32-bit app running on a 64-bit system is subject to WOW64's File System Redirector, which will silently redirect requests for the 64-bit System32 folder to the 32-bit SysWOW64 folder instead.

    Chances are, the apps you are trying to run only exist in the 64-bit System32 folder and not in the 32-bit SysWOW64 folder.

    To avoid redirection, you need to either:

    • replace System32 with the special Sysnative alias in your paths (ie 'C:\Windows\Sysnative\osk.exe'), which only works when running under WOW64, so you have to detect that dynamically at runtime via IsWow64Process():

      function GetSystem32Folder: string;
      var
        Folder: array[0..MAX_PATH] of Char;
        IsWow64: BOOL;
      begin
        Result := '';
        if IsWow64Process(GetCurrentProcess(), @IsWow64) and IsWow64 then
        begin
          SetString(Result, Folder, GetWindowsDirectory(Folder, Length(Folder)));
          if Result <> '' then
            Result := IncludeTrailingPathDelimiter(Result) + 'Sysnative' + PathDelim;
        end else
        begin
          SetString(Result, Folder, GetSystemDirectory(Folder, Length(Folder)));
          if Result <> '' then
            Result := IncludeTrailingPathDelimiter(Result);
        end;
      end;
      
      function RunDefrag: Boolean;
      var
        SysFolder: string;
        Res: Integer;
      begin
        SysFolder := GetSystem32Folder;
        Res := Integer(ShellExecute(0, nil, PChar(SysFolder + 'dfrgui.exe'), nil, nil, SW_SHOWNORMAL));
        if Res = ERROR_FILE_NOT_FOUND then
          Res := Integer(ShellExecute(0, nil, PChar(SysFolder + 'dfrg.msc'), nil, nil, SW_SHOWNORMAL));
        Result := (Res = 0);
      end;
      
      function RunOnScreenKeyboard: Boolean;
      begin
        Result := (ShellExecute(0, nil, PChar(GetSystem32Folder + 'osk.exe'), nil, nil, SW_SHOWNORMAL) = 0);
      end;
      
    • temporarily disable the Redirector via Wow64DisableWow64FsRedirection(), and then re-enable it via Wow64RevertWow64FsRedirection() when done:

      function GetSystem32Folder: string
      var
        Folder: array[0..MAX_PATH] of Char;
      begin
        SetString(Result, Folder, GetSystemDirectory(Folder, Length(Folder)));
        if Result <> '' then
          Result := IncludeTrailingPathDelimiter(Result);
      end;
      
      function RunDefrag: Boolean;
      var
        SysFolder: string;
        OldState: Pointer;
        Res: Integer;
      begin    
        Wow64DisableWow64FsRedirection(@OldState);
        try
          SysFolder := GetSystem32Folder;
          Res := Integer(ShellExecute(0, nil, PChar(SysFolder + 'dfrgui.exe'), nil, nil, SW_SHOWNORMAL));
          if Res = ERROR_FILE_NOT_FOUND then
            Res := Integer(ShellExecute(0, nil, PChar(SysFolder + 'dfrg.msc'), nil, nil, SW_SHOWNORMAL));
          Result := Res = 0;
        finally
          Wow64RevertWow64FsRedirection(OldState);
        end;
      end;
      
      function RunOnScreenKeyboard: Boolean;
      var
        OldState: Pointer;
      begin
        Wow64DisableWow64FsRedirection(@OldState);
        try
          Result := (ShellExecute(0, nil, PChar(GetSystem32Folder + 'osk.exe'), nil, nil, SW_SHOWNORMAL) = 0);
        finally
          Wow64RevertWow64FsRedirection(OldState);
        end;
      end;
      

    Update: that being said, it turns out that a 32-bit process running under WOW64 is not allowed to run osk.exe when UAC is enabled:

    Delphi - On Screen Keyboard (osk.exe) works on Win32 but fails on Win64

    So, you will have to create a helper 64-bit process to launch osk.exe on your app's behalf when it is running under WOW64.