Существует ли файл в папке Windows\System32 на 64-разрядной ОС (или обход механизма File System Redirector) - VB

Формулировка задачи:

Проведем эксперимент, если Вы владелец 64-разрядной версии ОС Windows: 1. Откройте стандартный поиск, или проводник (если ver. OS > XP). Пишем в строке поиска MSG.exe

Результат:

найден в папке windows\system32 2. Запускаем любой 32-битный файловый менеджер (например, Total Commander) Можем просто пролистать файлы в папке System32, а можем указать во встроенном поиске (ALT+F7) MSG.exe

Результат:

найдено 0 файлов. Вот так

сюрприз.

Кроме того, попытавшись сделать тоже самое

Private Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" _
    (ByVal pszPath As String) As Long
Private Declare Function GetFileAttributes Lib "kernel32.dll" Alias "GetFileAttributesA" _
    (ByVal lpFileName As String) As Long
 
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const INVALID_HANDLE_VALUE = &HFFFFFFFF
 
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
    (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
 
Const MAX_PATH As Long = 260
 
Private Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type
 
Private Type WIN32_FIND_DATA
   dwFileAttributes As Long
   ftCreationTime As FILETIME
   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   nFileSizeHigh As Long
   nFileSizeLow As Long
   dwReserved0 As Long
   dwReserved1 As Long
   cFileName As String * MAX_PATH
   cAlternate As String * 14
End Type
 
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
    (ByVal lpFileName As String, _
    ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, _
    lpSecurityAttributes As SECURITY_ATTRIBUTES, _
    ByVal dwCreationDisposition As Long, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
Const FILE_SHARE_READ = &H1
Const FILE_SHARE_WRITE = &H2
Const FILE_FLAG_SEQUENTIAL_SCAN = &H8000000
Const FILE_FLAG_NO_BUFFERING = &H20000000
Const OPEN_EXISTING = 3
 
Private Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End Type
 
Option Explicit
 
Private Sub Command1_Click()
Dim exe As String, oFSO As Object, ret As Long
 
exe = Environ("windir") & "\system32\msg.exe" 'C:\Windows\System32\MSG.exe
 
'Встроенная функция Dir
If Dir$(exe, vbReadOnly Or vbSystem Or vbHidden) <> vbNullString Then MsgBox "With Dir$ - msg.exe Exists!"
 
'Объект WSH FilesystemObject
Set oFSO = CreateObject("Scripting.FilesystemObject")
If oFSO.FileExists(exe) Then MsgBox "With FSO - msg.exe Exists!"
Set oFSO = Nothing
 
'Встроенная функция проверки атрибутов
On Error Resume Next
ret = GetAttr(exe)
If Err.Number = 0 Then MsgBox "With Attributes Check - msg.exe Exists!"
On Error GoTo 0
 
'API-функция PathFileExists
If PathFileExists(exe) = 1 Then MsgBox "With API PathFileExists - msg.exe Exists!"
 
'API-функция GetFileAttributes
ret = GetFileAttributes(exe)
If ret <> INVALID_HANDLE_VALUE And (0 = (ret And FILE_ATTRIBUTE_DIRECTORY)) Then
    MsgBox "With API GetFileAttributes - msg.exe Exists!"
End If
 
'API-функция FindFirstFile
Dim WFD As WIN32_FIND_DATA, hFile As Long
hFile = FindFirstFile(exe, WFD)
Call FindClose(hFile)
If hFile <> INVALID_HANDLE_VALUE Then MsgBox "With API FindFirstFile - msg.exe Exists!"
 
'API-функция CreateFile
Dim Security As SECURITY_ATTRIBUTES
hFile = CreateFile(exe, 0, FILE_SHARE_READ Or FILE_SHARE_WRITE, Security, OPEN_EXISTING, _
    FILE_FLAG_NO_BUFFERING Or FILE_FLAG_SEQUENTIAL_SCAN, 0)
If hFile <> INVALID_HANDLE_VALUE Then
    CloseHandle (hFile)
    MsgBox "With API CreateFile - msg.exe Exists!"
End If
 
End Sub

мы получим также нулевой результат. На эту удочку я недавно попался при отладке Batch-сценария. Виновником оказался так называемый механизм перенаправления файловых запросов в 64-разрядной версии ОС Windows (File System Redirector), о котором рассказывает Microsoft. То есть на самом деле запросы 32-битных приложений при попытке обратится к системной директории System32 файловая система автоматически переадресовывает в папку SysWOW64. Почему так сделано, можно почитать здесь. Но как же нам обойти систему виртуализации. Вот реализация на VB принципа, указанного в статье MS:

Способ 1.

Временное отключение механизма перенаправления файловых запросов.

Private Declare Function Wow64EnableWow64FsRedirection Lib "kernel32.dll" _
    (ByVal IsEnable As Boolean) As Boolean
 
Option Explicit
 
Sub System32file_Exists()
Dim ret_redir As Boolean
Dim exists As Boolean
Dim exe As String
 
exe = Environ("windir") & "\system32\msg.exe"
 
ret_redir = Wow64EnableWow64FsRedirection(False)
If Dir$(exe, vbReadOnly Or vbSystem Or vbHidden) <> vbNullString Then exists = True
ret_redir = Wow64EnableWow64FsRedirection(True)
 
If exists Then MsgBox exe & " is Exists!"
End Sub

Способ 2

. Обращаемся к папке System32 через алиас "Sysnative".

Option Explicit
 
Sub System32file_Exists()
Dim exe As String
 
exe = Environ("windir") & "\system32\msg.exe"
exe = Replace(exe, "system32", "Sysnative", , vbTextCompare)
 
If Dir$(exe, vbReadOnly Or vbSystem Or vbHidden) <> vbNullString Then
    MsgBox exe & " is Exists!"
End If
End Sub

Недостатки способа № 1

: 1. Относительная небезопасность: реактивацию перенаправления ФС нужно сделать как можно быстрее, чтобы не прервать работу c 64-битными библиотеками в этом потоке. 2. Еще есть информация о предупреждении UAC при попытке снять режим File System Redirection. Запуск примера на ОС Win 7 x64 Ultimate с максимальным уровнем UAC показал, что защита молчит во время этой манипуляции. 3. Также данная API-функция будет работать только на 64-разрядной версии ОС, поэтому разрядность тоже

Public Function Is64system() As Boolean
On Error Resume Next
Is64system = GetAttr(Environ("windir") & "\Sysnative") And vbDirectory
End FunctionPublic Function Is64system() As Boolean
On Error Resume Next 'PROCESSOR_ARCHITEW6432 on x32 is NOT DEFINED
Dim WshShell As Object
Set WshShell = CreateObject("WScript.Shell")
If WshShell.Environment("PROCESS")("PROCESSOR_ARCHITECTURE") = "AMD64" Or _
   WshShell.Environment("PROCESS")("PROCESSOR_ARCHITEW6432") = "AMD64" Then
    Is64system = True
End If
Set WshShell = Nothing
End Function

Стоит добавить, что подобная ситуация также касается ветки реестра HKLM\Software\Wow6432Node Для обхода этого также существует специальный алиас.

Не по теме:

Хотелось бы знать, можно ли заставить систему думать, что запрос к файловой системе исходит от 64-битного приложения?

Комментарии?

Решение задачи: «Существует ли файл в папке Windows\System32 на 64-разрядной ОС (или обход механизма File System Redirector)»

textual
                            Листинг программы 
                        

                            Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
        (ByVal hKey As Long, ByVal lpSubKey As String, _
         ByVal ulOptions As Long, _
         ByVal samDesired As Long, _
         phkResult As Long) As Long
         
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
 
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" _
        (ByVal hKey As Long, _
         ByVal dwIndex As Long, _
         ByVal lpName As String, _
         lpcbName As Long, _
         ByVal lpReserved As Long, _
         ByVal lpClass As String, _
         lpcbClass As Long, _
         lpftLastWriteTime As FILETIME) As Long
         
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
        (ByVal hKey As Long, _
         ByVal lpValueName As String, _
         ByVal lpReserved As Long, _
         lpType As Long, _
         lpData As Any, _
         lpcbData As Long) As Long
 
Private Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" _
        (ByVal hKey As Long, _
        ByVal lpValueName As String, _
        ByVal Reserved As Long, _
        ByVal dwType As Long, _
        ByVal szData As String, _
        ByVal cbData As Long) As Long
 
Public Enum RegTypes
      RegNonee = 0
      RegSZ = 1
      RegExpandSz = 2
      RegBinary = 3
      RegDword = 4
      RegDwordLittleEndian = 4
      RegDwordBigEndian = 5
      RegLink = 6
      RegMultiSz = 7
      RegResourceList = 8
      RegFulResourceDesc = 9
End Enum
 
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const HKEY_PERFORMANCE_DATA = &H80000004
Private Const HKEY_CURRENT_CONFIG = &H80000005
Private Const HKEY_DYN_DATA = &H80000006
 
Private Const KEY_ALL_ACCESS = &HF003F
Private Const KEY_WRITE = &H20006
Private Const KEY_READ = &H20019
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_CREATE_SUB_KEY = &H4
 
'Registry Redirector Subsystem
'http://msdn.microsoft.com/en-us/library/windows/desktop/aa384129(v=vs.85).aspx
Private Const KEY_WOW64_64KEY = &H100 'Access a 64-bit key from either a 32-bit or 64-bit application.
Private Const KEY_WOW64_32KEY = &H200 'Access a 32-bit key from either a 32-bit or 64-bit application.
'Can be used by:
' - RegCreateKeyEx
' - RegDeleteKeyEx
' - RegOpenKeyEx
 
Private Sub Command1_Click()
 
        'Записываем новый ...
        
        Dim badRoot$, Ret_1&, Ret_2&
        
        badRoot = "HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\" & badCLSID & "\TypeLib"
        
        'Записываем ключ в 32-битных ветвях
        
        Ret_1 = WriteKey(badRoot, "", Key2099, False)
        
        'Записываем ключ в 64-битных ветвях
        
        Ret_2 = WriteKey(badRoot, "", Key2099, True)
        
        MsgBox "32-битная ветка - " & IIf(Ret_1, "Успех.", "Ошибка.") & vbCrLf & _
               "64-битная ветка - " & IIf(Ret_2, "Успех.", "Ошибка.")
end sub
 
 
'Самоэлевация прав программы
 
Private Sub Form_Initialize()
    'Exit Sub 'Временно, пока не скомпилирую проект
    With CreateObject("WScript.Shell")
        On Error Resume Next
        .RegWrite "HKLM\isElevated", "", "REG_SZ"
        If Err <> 0 Then
            CreateObject("Shell.Application").ShellExecute App.Path & "\" & App.EXEName & ".exe", "1", "", "runas", 1
            End
          Else
            .RegDelete "HKLM\isElevated"
        End If
    End With
End Sub
 
 
 
Private Function GetMainKeyHandle(MainKeyName As String) As Long 'Получить хендл главного улья
    On Error Resume Next
    Select Case MainKeyName
           Case "HKEY_CLASSES_ROOT"
                GetMainKeyHandle = HKEY_CLASSES_ROOT
           Case "HKEY_CURRENT_USER"
                GetMainKeyHandle = HKEY_CURRENT_USER
           Case "HKEY_LOCAL_MACHINE"
                GetMainKeyHandle = HKEY_LOCAL_MACHINE
           Case "HKEY_USERS"
                GetMainKeyHandle = HKEY_USERS
           Case "HKEY_PERFORMANCE_DATA"
                GetMainKeyHandle = HKEY_PERFORMANCE_DATA
           Case "HKEY_CURRENT_CONFIG"
                GetMainKeyHandle = HKEY_CURRENT_CONFIG
           Case "HKEY_DYN_DATA"
                GetMainKeyHandle = HKEY_DYN_DATA
    End Select
End Function
 
 
Private Function WriteKey(rPath$, ParamName, ParamValue, Optional is64Node As Boolean = False)
 
        'Функция записывает значение в реестр.
        'Возвращает результат выполнения API-функции RegSetValueEx
        'Умеет использовать Registry Redirector SybSystem (в 64 или 32-битную ветку записывать данные)
 
        Dim Ret_1&, Ret_2&, sSubKey$, Hive$, hSubKey&, regAccess&
        
        Hive = Split(rPath, "\")(0)
        sSubKey = IIf(Len(Hive) = Len(rPath), "", Replace(rPath, Hive & "\", ""))
        
        If is64Node Then
            regAccess = KEY_QUERY_VALUE Or KEY_WRITE Or KEY_WOW64_64KEY
        Else
            regAccess = KEY_QUERY_VALUE Or KEY_WRITE Or KEY_WOW64_32KEY
        End If
        
        Ret_1 = RegOpenKeyEx(GetMainKeyHandle(Hive), sSubKey, 0&, regAccess, hSubKey)
 
        Ret_2 = RegSetValueEx(hSubKey, ParamName, 0, RegTypes.RegSZ, ParamValue, Len(ParamValue) + 1)
        
        RegCloseKey hSubKey
    
        WriteKey = Ret_2
 
End Function
                        