Inno-Setup-issrc/Projects/Src/SetupLdrAndSetup.RedirFunc.pas

unit SetupLdrAndSetup.RedirFunc;

{
  Inno Setup
  Copyright (C) 1997-2025 Jordan Russell
  Portions by Martijn Laan
  For conditions of distribution and use, see LICENSE.TXT.

  Functions for dealing with WOW64 file system redirection.
  Used only by the Setup and SetupLdr projects.

  The *Redir functions are counterparts to common functions that offer
  built-in support for disabling FS redirection.
}

interface

uses
  Windows, SysUtils, Shared.FileClass, Shared.VerInfoFunc;

type
  TPreviousFsRedirectionState = record
    DidDisable: Boolean;
    OldValue: Pointer;
  end;

function AreFsRedirectionFunctionsAvailable: Boolean;
function DisableFsRedirectionIf(const Disable: Boolean;
  var PreviousState: TPreviousFsRedirectionState): Boolean;
procedure RestoreFsRedirection(const PreviousState: TPreviousFsRedirectionState);

function CreateFileRedir(const DisableFsRedir: Boolean; const FileName: String;
  const DesiredAccess, ShareMode: DWORD; const SecurityAttributes: PSecurityAttributes;
  const CreationDisposition, FlagsAndAttributes: DWORD; TemplateFile: THandle): THandle;
function CreateDirectoryRedir(const DisableFsRedir: Boolean; const Filename: String;
  const SecurityAttributes: PSecurityAttributes = nil): BOOL;
function CreateProcessRedir(const DisableFsRedir: Boolean;
  const lpApplicationName: PChar; const lpCommandLine: PChar;
  const lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
  const bInheritHandles: BOOL; const dwCreationFlags: DWORD;
  const lpEnvironment: Pointer; const lpCurrentDirectory: PChar;
  const lpStartupInfo: TStartupInfo;
  var lpProcessInformation: TProcessInformation): BOOL;
function CopyFileRedir(const DisableFsRedir: Boolean;
  const ExistingFilename, NewFilename: String; const FailIfExists: BOOL): BOOL;
function DeleteFileRedir(const DisableFsRedir: Boolean; const Filename: String): BOOL;
function DirExistsRedir(const DisableFsRedir: Boolean; const Filename: String): Boolean;
function FileOrDirExistsRedir(const DisableFsRedir: Boolean; const Filename: String): Boolean;
function FindFirstFileRedir(const DisableFsRedir: Boolean; const Filename: String;
  var FindData: TWin32FindData): THandle;
function GetFileAttributesRedir(const DisableFsRedir: Boolean; const Filename: String): DWORD;
function GetShortNameRedir(const DisableFsRedir: Boolean; const Filename: String): String;
function GetVersionNumbersRedir(const DisableFsRedir: Boolean; const Filename: String;
  var VersionNumbers: TFileVersionNumbers): Boolean;
function IsDirectoryAndNotReparsePointRedir(const DisableFsRedir: Boolean;
  const Name: String): Boolean;
function MoveFileRedir(const DisableFsRedir: Boolean;
  const ExistingFilename, NewFilename: String): BOOL;
function MoveFileExRedir(const DisableFsRedir: Boolean;
  const ExistingFilename, NewFilename: String; const Flags: DWORD): BOOL;
function NewFileExistsRedir(const DisableFsRedir: Boolean; const Filename: String): Boolean;
function RemoveDirectoryRedir(const DisableFsRedir: Boolean; const Filename: String): BOOL;
function SetFileAttributesRedir(const DisableFsRedir: Boolean; const Filename: String;
  const Attrib: DWORD): BOOL;
function SetNTFSCompressionRedir(const DisableFsRedir: Boolean; const FileOrDir: String; Compress: Boolean): Boolean;

type
  TFileRedir = class(TFile)
  private
    FDisableFsRedir: Boolean;
  protected
    function CreateHandle(const AFilename: String;
      ACreateDisposition: TFileCreateDisposition; AAccess: TFileAccess;
      ASharing: TFileSharing): THandle; override;
  public
    constructor Create(const DisableFsRedir: Boolean; const AFilename: String;
      ACreateDisposition: TFileCreateDisposition; AAccess: TFileAccess;
      ASharing: TFileSharing);
  end;

  TTextFileReaderRedir = class(TTextFileReader)
  private
    FDisableFsRedir: Boolean;
  protected
    function CreateHandle(const AFilename: String;
      ACreateDisposition: TFileCreateDisposition; AAccess: TFileAccess;
      ASharing: TFileSharing): THandle; override;
  public
    constructor Create(const DisableFsRedir: Boolean; const AFilename: String;
      ACreateDisposition: TFileCreateDisposition; AAccess: TFileAccess;
      ASharing: TFileSharing);
  end;

  TTextFileWriterRedir = class(TTextFileWriter)
  private
    FDisableFsRedir: Boolean;
  protected
    function CreateHandle(const AFilename: String;
      ACreateDisposition: TFileCreateDisposition; AAccess: TFileAccess;
      ASharing: TFileSharing): THandle; override;
  public
    constructor Create(const DisableFsRedir: Boolean; const AFilename: String;
      ACreateDisposition: TFileCreateDisposition; AAccess: TFileAccess;
      ASharing: TFileSharing);
  end;

implementation

uses
  Shared.CommonFunc, PathFunc;

var
  Wow64DisableWow64FsRedirectionFunc: function(var OldValue: Pointer): BOOL; stdcall;
  Wow64RevertWow64FsRedirectionFunc: function(OldValue: Pointer): BOOL; stdcall;
  FsRedirectionFunctionsAvailable: Boolean;

function AreFsRedirectionFunctionsAvailable: Boolean;
begin
  Result := FsRedirectionFunctionsAvailable;
end;

function DisableFsRedirectionIf(const Disable: Boolean;
  var PreviousState: TPreviousFsRedirectionState): Boolean;
{ If Disable is False, the function does not change the redirection state and
  always returns True.
  If Disable is True, the function attempts to disable WOW64 file system
  redirection, so that c:\windows\system32 goes to the 64-bit System directory
  instead of the 32-bit one.
  Returns True if successful, False if not. For extended error information when
  False is returned, call GetLastError. }
begin
  PreviousState.DidDisable := False;
  if not Disable then
    Result := True
  else begin
    if FsRedirectionFunctionsAvailable then begin
      { Note: Disassembling Wow64DisableWow64FsRedirection and the Rtl function
        it calls, it doesn't appear as if it can ever actually fail on 64-bit
        Windows. But it always fails on the 32-bit version of Windows Server
        2003 SP1 (with error code 1 - ERROR_INVALID_FUNCTION). }
      Result := Wow64DisableWow64FsRedirectionFunc(PreviousState.OldValue);
      if Result then
        PreviousState.DidDisable := True;
    end
    else begin
      { Should never happen }
      SetLastError(ERROR_INVALID_FUNCTION);
      Result := False;
    end;
  end;
end;

procedure RestoreFsRedirection(const PreviousState: TPreviousFsRedirectionState);
{ Restores the previous WOW64 file system redirection state after a call to
  DisableFsRedirectionIf. There is no indication of failure (which is
  extremely unlikely). }
begin
  if PreviousState.DidDisable then
    Wow64RevertWow64FsRedirectionFunc(PreviousState.OldValue);
end;

{ *Redir functions }

function CreateFileRedir(const DisableFsRedir: Boolean; const FileName: String;
  const DesiredAccess, ShareMode: DWORD; const SecurityAttributes: PSecurityAttributes;
  const CreationDisposition, FlagsAndAttributes: DWORD; TemplateFile: THandle): THandle;
var
  PrevState: TPreviousFsRedirectionState;
  ErrorCode: DWORD;
begin
  if not DisableFsRedirectionIf(DisableFsRedir, PrevState) then begin
    Result := INVALID_HANDLE_VALUE;
    Exit;
  end;
  try
    Result := CreateFile(PChar(Filename), DesiredAccess, ShareMode, SecurityAttributes,
      CreationDisposition, FlagsAndAttributes, TemplateFile);
    ErrorCode := GetLastError;
  finally
    RestoreFsRedirection(PrevState);
  end;
  SetLastError(ErrorCode);
end;

function CreateDirectoryRedir(const DisableFsRedir: Boolean; const Filename: String;
  const SecurityAttributes: PSecurityAttributes): BOOL;
var
  PrevState: TPreviousFsRedirectionState;
  ErrorCode: DWORD;
begin
  if not DisableFsRedirectionIf(DisableFsRedir, PrevState) then begin
    Result := False;
    Exit;
  end;
  try
    Result := CreateDirectory(PChar(Filename), SecurityAttributes);
    ErrorCode := GetLastError;
  finally
    RestoreFsRedirection(PrevState);
  end;
  SetLastError(ErrorCode);
end;

function CreateProcessRedir(const DisableFsRedir: Boolean;
  const lpApplicationName: PChar; const lpCommandLine: PChar;
  const lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
  const bInheritHandles: BOOL; const dwCreationFlags: DWORD;
  const lpEnvironment: Pointer; const lpCurrentDirectory: PChar;
  const lpStartupInfo: TStartupInfo;
  var lpProcessInformation: TProcessInformation): BOOL;
var
  PrevState: TPreviousFsRedirectionState;
  ErrorCode: DWORD;
begin
  if not DisableFsRedirectionIf(DisableFsRedir, PrevState) then begin
    Result := False;
    Exit;
  end;
  try
    Result := CreateProcess(lpApplicationName, lpCommandLine,
      lpProcessAttributes, lpThreadAttributes,
      bInheritHandles, dwCreationFlags, lpEnvironment,
      lpCurrentDirectory, lpStartupInfo, lpProcessInformation);
    ErrorCode := GetLastError;
  finally
    RestoreFsRedirection(PrevState);
  end;
  SetLastError(ErrorCode);
end;

function CopyFileRedir(const DisableFsRedir: Boolean;
  const ExistingFilename, NewFilename: String; const FailIfExists: BOOL): BOOL;
var
  PrevState: TPreviousFsRedirectionState;
  ErrorCode: DWORD;
begin
  if not DisableFsRedirectionIf(DisableFsRedir, PrevState) then begin
    Result := False;
    Exit;
  end;
  try
    Result := CopyFile(PChar(ExistingFilename), PChar(NewFilename), FailIfExists);
    ErrorCode := GetLastError;
  finally
    RestoreFsRedirection(PrevState);
  end;
  SetLastError(ErrorCode);
end;

function DeleteFileRedir(const DisableFsRedir: Boolean; const Filename: String): BOOL;
var
  PrevState: TPreviousFsRedirectionState;
  ErrorCode: DWORD;
begin
  if not DisableFsRedirectionIf(DisableFsRedir, PrevState) then begin
    Result := False;
    Exit;
  end;
  try
    Result := Windows.DeleteFile(PChar(Filename));
    ErrorCode := GetLastError;
  finally
    RestoreFsRedirection(PrevState);
  end;
  SetLastError(ErrorCode);
end;

function DirExistsRedir(const DisableFsRedir: Boolean; const Filename: String): Boolean;
var
  PrevState: TPreviousFsRedirectionState;
  ErrorCode: DWORD;
begin
  if not DisableFsRedirectionIf(DisableFsRedir, PrevState) then begin
    Result := False;
    Exit;
  end;
  try
    Result := DirExists(Filename);
    ErrorCode := GetLastError;
  finally
    RestoreFsRedirection(PrevState);
  end;
  SetLastError(ErrorCode);
end;

function FileOrDirExistsRedir(const DisableFsRedir: Boolean; const Filename: String): Boolean;
var
  PrevState: TPreviousFsRedirectionState;
  ErrorCode: DWORD;
begin
  if not DisableFsRedirectionIf(DisableFsRedir, PrevState) then begin
    Result := False;
    Exit;
  end;
  try
    Result := FileOrDirExists(Filename);
    ErrorCode := GetLastError;
  finally
    RestoreFsRedirection(PrevState);
  end;
  SetLastError(ErrorCode);
end;

function FindFirstFileRedir(const DisableFsRedir: Boolean; const Filename: String;
  var FindData: TWin32FindData): THandle;
var
  PrevState: TPreviousFsRedirectionState;
  ErrorCode: DWORD;
begin
  if not DisableFsRedirectionIf(DisableFsRedir, PrevState) then begin
    Result := INVALID_HANDLE_VALUE;
    Exit;
  end;
  try
    Result := FindFirstFile(PChar(Filename), FindData);
    ErrorCode := GetLastError;
  finally
    RestoreFsRedirection(PrevState);
  end;
  SetLastError(ErrorCode);
end;

function GetFileAttributesRedir(const DisableFsRedir: Boolean; const Filename: String): DWORD;
var
  PrevState: TPreviousFsRedirectionState;
  ErrorCode: DWORD;
begin
  if not DisableFsRedirectionIf(DisableFsRedir, PrevState) then begin
    Result := INVALID_FILE_ATTRIBUTES;
    Exit;
  end;
  try
    Result := GetFileAttributes(PChar(Filename));
    ErrorCode := GetLastError;
  finally
    RestoreFsRedirection(PrevState);
  end;
  SetLastError(ErrorCode);
end;

function GetShortNameRedir(const DisableFsRedir: Boolean; const Filename: String): String;
var
  PrevState: TPreviousFsRedirectionState;
begin
  if not DisableFsRedirectionIf(DisableFsRedir, PrevState) then begin
    Result := Filename;
    Exit;
  end;
  try
    Result := GetShortName(Filename);
  finally
    RestoreFsRedirection(PrevState);
  end;
end;

function GetVersionNumbersRedir(const DisableFsRedir: Boolean; const Filename: String;
  var VersionNumbers: TFileVersionNumbers): Boolean;
var
  PrevState: TPreviousFsRedirectionState;
begin
  if not DisableFsRedirectionIf(DisableFsRedir, PrevState) then begin
    Result := False;
    Exit;
  end;
  try
    Result := GetVersionNumbers(Filename, VersionNumbers);
  finally
    RestoreFsRedirection(PrevState);
  end;
end;

function IsDirectoryAndNotReparsePointRedir(const DisableFsRedir: Boolean;
  const Name: String): Boolean;
var
  PrevState: TPreviousFsRedirectionState;
begin
  if not DisableFsRedirectionIf(DisableFsRedir, PrevState) then begin
    Result := False;
    Exit;
  end;
  try
    Result := IsDirectoryAndNotReparsePoint(Name);
  finally
    RestoreFsRedirection(PrevState);
  end;
end;

function MoveFileRedir(const DisableFsRedir: Boolean;
  const ExistingFilename, NewFilename: String): BOOL;
var
  PrevState: TPreviousFsRedirectionState;
  ErrorCode: DWORD;
begin
  if not DisableFsRedirectionIf(DisableFsRedir, PrevState) then begin
    Result := False;
    Exit;
  end;
  try
    Result := MoveFile(PChar(ExistingFilename), PChar(NewFilename));
    ErrorCode := GetLastError;
  finally
    RestoreFsRedirection(PrevState);
  end;
  SetLastError(ErrorCode);
end;

function MoveFileExRedir(const DisableFsRedir: Boolean;
  const ExistingFilename, NewFilename: String; const Flags: DWORD): BOOL;
var
  NewFilenameP: PChar;
  PrevState: TPreviousFsRedirectionState;
  ErrorCode: DWORD;
begin
  if (NewFilename = '') and (Flags and MOVEFILE_DELAY_UNTIL_REBOOT <> 0) then
    NewFilenameP := nil
  else
    NewFilenameP := PChar(NewFilename);
  if not DisableFsRedirectionIf(DisableFsRedir, PrevState) then begin
    Result := False;
    Exit;
  end;
  try
    Result := MoveFileEx(PChar(ExistingFilename), NewFilenameP, Flags);
    ErrorCode := GetLastError;
  finally
    RestoreFsRedirection(PrevState);
  end;
  SetLastError(ErrorCode);
end;

function NewFileExistsRedir(const DisableFsRedir: Boolean; const Filename: String): Boolean;
var
  PrevState: TPreviousFsRedirectionState;
  ErrorCode: DWORD;
begin
  if not DisableFsRedirectionIf(DisableFsRedir, PrevState) then begin
    Result := False;
    Exit;
  end;
  try
    Result := NewFileExists(Filename);
    ErrorCode := GetLastError;
  finally
    RestoreFsRedirection(PrevState);
  end;
  SetLastError(ErrorCode);
end;

function RemoveDirectoryRedir(const DisableFsRedir: Boolean; const Filename: String): BOOL;
var
  PrevState: TPreviousFsRedirectionState;
  ErrorCode: DWORD;
begin
  if not DisableFsRedirectionIf(DisableFsRedir, PrevState) then begin
    Result := False;
    Exit;
  end;
  try
    Result := RemoveDirectory(PChar(Filename));
    ErrorCode := GetLastError;
  finally
    RestoreFsRedirection(PrevState);
  end;
  SetLastError(ErrorCode);
end;

function SetFileAttributesRedir(const DisableFsRedir: Boolean; const Filename: String;
  const Attrib: DWORD): BOOL;
var
  PrevState: TPreviousFsRedirectionState;
  ErrorCode: DWORD;
begin
  if not DisableFsRedirectionIf(DisableFsRedir, PrevState) then begin
    Result := False;
    Exit;
  end;
  try
    Result := SetFileAttributes(PChar(Filename), Attrib);
    ErrorCode := GetLastError;
  finally
    RestoreFsRedirection(PrevState);
  end;
  SetLastError(ErrorCode);
end;

function SetNTFSCompressionRedir(const DisableFsRedir: Boolean; const FileOrDir: String; Compress: Boolean): Boolean;
var
  PrevState: TPreviousFsRedirectionState;
  ErrorCode: DWORD;
begin
  if not DisableFsRedirectionIf(DisableFsRedir, PrevState) then begin
    Result := False;
    Exit;
  end;
  try
    Result := SetNTFSCompression(FileOrDir, Compress);
    ErrorCode := GetLastError;
  finally
    RestoreFsRedirection(PrevState);
  end;
  SetLastError(ErrorCode);
end;

{ TFileRedir }

constructor TFileRedir.Create(const DisableFsRedir: Boolean; const AFilename: String;
  ACreateDisposition: TFileCreateDisposition; AAccess: TFileAccess;
  ASharing: TFileSharing);
begin
  FDisableFsRedir := DisableFsRedir; 
  inherited Create(AFilename, ACreateDisposition, AAccess, ASharing);
end;

function TFileRedir.CreateHandle(const AFilename: String;
  ACreateDisposition: TFileCreateDisposition; AAccess: TFileAccess;
  ASharing: TFileSharing): THandle;
var
  PrevState: TPreviousFsRedirectionState;
  ErrorCode: DWORD;
begin
  if not DisableFsRedirectionIf(FDisableFsRedir, PrevState) then begin
    Result := INVALID_HANDLE_VALUE;
    Exit;
  end;
  try
    Result := inherited CreateHandle(AFilename, ACreateDisposition, AAccess,
      ASharing);
    ErrorCode := GetLastError;
  finally
    RestoreFsRedirection(PrevState);
  end;
  SetLastError(ErrorCode);
end;

{ TTextFileReaderRedir }

constructor TTextFileReaderRedir.Create(const DisableFsRedir: Boolean; const AFilename: String;
  ACreateDisposition: TFileCreateDisposition; AAccess: TFileAccess;
  ASharing: TFileSharing);
begin
  FDisableFsRedir := DisableFsRedir; 
  inherited Create(AFilename, ACreateDisposition, AAccess, ASharing);
end;

function TTextFileReaderRedir.CreateHandle(const AFilename: String;
  ACreateDisposition: TFileCreateDisposition; AAccess: TFileAccess;
  ASharing: TFileSharing): THandle;
var
  PrevState: TPreviousFsRedirectionState;
  ErrorCode: DWORD;
begin
  if not DisableFsRedirectionIf(FDisableFsRedir, PrevState) then begin
    Result := INVALID_HANDLE_VALUE;
    Exit;
  end;
  try
    Result := inherited CreateHandle(AFilename, ACreateDisposition, AAccess,
      ASharing);
    ErrorCode := GetLastError;
  finally
    RestoreFsRedirection(PrevState);
  end;
  SetLastError(ErrorCode);
end;

{ TTextFileWriterRedir }

constructor TTextFileWriterRedir.Create(const DisableFsRedir: Boolean; const AFilename: String;
  ACreateDisposition: TFileCreateDisposition; AAccess: TFileAccess;
  ASharing: TFileSharing);
begin
  FDisableFsRedir := DisableFsRedir; 
  inherited Create(AFilename, ACreateDisposition, AAccess, ASharing);
end;

function TTextFileWriterRedir.CreateHandle(const AFilename: String;
  ACreateDisposition: TFileCreateDisposition; AAccess: TFileAccess;
  ASharing: TFileSharing): THandle;
var
  PrevState: TPreviousFsRedirectionState;
  ErrorCode: DWORD;
begin
  if not DisableFsRedirectionIf(FDisableFsRedir, PrevState) then begin
    Result := INVALID_HANDLE_VALUE;
    Exit;
  end;
  try
    Result := inherited CreateHandle(AFilename, ACreateDisposition, AAccess,
      ASharing);
    ErrorCode := GetLastError;
  finally
    RestoreFsRedirection(PrevState);
  end;
  SetLastError(ErrorCode);
end;

initialization
  Wow64DisableWow64FsRedirectionFunc := GetProcAddress(GetModuleHandle(kernel32),
    'Wow64DisableWow64FsRedirection');
  Wow64RevertWow64FsRedirectionFunc := GetProcAddress(GetModuleHandle(kernel32),
    'Wow64RevertWow64FsRedirection');
  FsRedirectionFunctionsAvailable := Assigned(Wow64DisableWow64FsRedirectionFunc) and
    Assigned(Wow64RevertWow64FsRedirectionFunc);

  { For GetVersionNumbersRedir: Pre-load shell32.dll since GetFileVersionInfo
    and GetFileVersionInfoSize will try to load it when reading version info
    on 16-bit files. We can't allow the DLL be loaded for the first time while
    FS redirection is disabled. }
  SafeLoadLibrary(AddBackslash(GetSystemDir) + 'shell32.dll', SEM_NOOPENFILEERRORBOX);

  { FormatMessage might be called with FS redirection disabled, so ensure
    that all the DLLs FormatMessage searches in for messages (e.g. netmsg.dll,
    ws03res.dll) are pre-loaded by calling it now with a randomly-chosen
    message ID -- one that won't result in a match and cause the function to
    return early.
    (Note: Presently, FormatMessage loads the DLLs as "data files" so it
    actually may not matter whether it gets 32- or 64-bit versions. But let's
    be on the safe side.) }
  Win32ErrorString($4C783AFB);
end.