FindFirstFile не корректно определяет имена файлов с диакритическими знаками

    Dim bstFileName As String
    Dim lngFileCount As Long
    Dim lngAPIReturn As Long
    Dim bstPath As String
    Dim bstCinteria As String
    Dim abstFileNames() As String
    Dim lngHSearch As Long
    Dim udtWFD As WIN32_FIND_DATA
   
    bstCinteria = iCinteria
    bstPath = iPath
    
    lngHSearch = INVALID_HANDLE_VALUE
    lngHSearch = FindFirstFile(bstPath & iCinteria, udtWFD)
    lngFileCount = -1&
       
    If lngHSearch <> INVALID_HANDLE_VALUE Then
        Do
            bstFileName = Left(udtWFD.cFileName, VBA.InStr(1, udtWFD.cFileName, Chr(0)) - 1) ', vbNullString)
            Stop
            If (bstFileName <> ".") And (bstFileName <> "..") Then
                lngFileCount = lngFileCount + 1
                ReDim Preserve abstFileNames(0& To lngFileCount) As String
                abstFileNames(lngFileCount) = bstFileName
            End If
            lngAPIReturn = FindNextFile(lngHSearch, udtWFD)
        Loop Until lngAPIReturn = 0&
        FindClose lngHSearch
    End If
 
    oFileNames = abstFileNames
    oMaxIdx = lngFileCount

Private Function IsInputTextUnicode( _
                 ByVal pData As Long, _
                 ByVal lSize As Long, _
                 ByRef bIsBigEndian As Boolean) As Boolean
    Dim lFlags  As Long
    
    lFlags = -1
    
    If IsTextUnicode(ByVal pData, lSize, lFlags) Then
        If lSize < 100 And lFlags = IS_TEXT_UNICODE_STATISTICS Then
            IsInputTextUnicode = False
        Else
        
            If lFlags = IS_TEXT_UNICODE_REVERSE_STATISTICS Then
                bIsBigEndian = True
            Else
                bIsBigEndian = False
            End If
            
            IsInputTextUnicode = True
            
        End If
    End If
    
End Function

Option Explicit
Private Declare Function GetFileAttributesEx Lib "kernel32" Alias "GetFileAttributesExW" (ByVal lpFileName As Long, ByVal fInfoLevelId As Long, ByVal lpFileInformation As Long) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (ByVal lpFileTime As Long, ByVal lpLocalFileTime As Long) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (ByVal lpFileTime As Long, ByVal lpSystemTime As Long) As Long
 
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
 
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
 
Private Type WIN32_FILE_ATTRIBUTE_DATA
dwFileAttributes As Long
FTCreationTime As FILETIME
FTLastAccessTime As FILETIME
FTLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
End Type
 
' (VB-Overwrite)
Public Function FileDateTime(ByVal PathName As String) As Date
Dim FAD As WIN32_FILE_ATTRIBUTE_DATA
If Left$(PathName, 2) = "\\" Then PathName = "UNC\" & Mid$(PathName, 3)
If GetFileAttributesEx(StrPtr("\\?\" & PathName), 0, VarPtr(FAD)) <> 0 Then
    Dim FT As FILETIME, ST As SYSTEMTIME
    FileTimeToLocalFileTime VarPtr(FAD.FTLastWriteTime), VarPtr(FT)
    FileTimeToSystemTime VarPtr(FT), VarPtr(ST)
    FileDateTime = DateSerial(ST.wYear, ST.wMonth, ST.wDay) + TimeSerial(ST.wHour, ST.wMinute, ST.wSecond)
Else
    Err.Raise Number:=53, Description:="File not found: '" & PathName & "'"
End If
End Function

Option Explicit
'////////////////////////////////////////////////////////
'// Модуль поиска файлов на винчестере                 //
'// Copyright (c) 04.09.2021, 05.09.2023 by HackerVlad //
'// e-mail: vladislavpeshkov@ya.ru                     //
'// Версия 2.2                                         //
'////////////////////////////////////////////////////////
Private Declare Function FindFirstFileW Lib "kernel32" (ByVal lpFileName As Long, lpFindFileData As WIN32_FIND_DATA_UNICODE) As Long
Private Declare Function FindNextFileW Lib "kernel32" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA_UNICODE) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Private Declare Function SysAllocStringLen Lib "oleaut32" (ByVal olestr As Long, ByVal BLen As Long) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal ptr As Long, ByVal Value As Long)
Private Declare Function PathRemoveExtensionW Lib "shlwapi" (ByVal pszPath As Long) As Long
 
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
 
Dim add_cnt As Long
Dim all_cnt As Long
Dim Masks() As String
 
Private Type WIN32_FIND_DATA_UNICODE
    dwFileAttributes As Long
    ftCreationTime As Currency
    ftLastAccessTime As Currency
    ftLastWriteTime As Currency
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName(MAX_PATH) As Integer
    cAlternate(14) As Integer
End Type
 
Public Type PathsFileName
    PathDirName As String
    PathFileOrDirName As String
    PathFileSize As Currency
    PathDateTime As Currency
End Type
 
' Вручную сравниваем маски типов файлов
Private Function IsStrMaskEquivalentFileName(ByVal MaskStr As String, ByVal FileName As String) As Boolean
    Dim lNullPos As Long
    Dim StrMask As String
    Dim PathFileName As String
    Dim SearchExtension As String
    
    StrMask = Trim$(MaskStr)
    
    If StrMask <> "*.*" And StrMask <> "*" Then
        If Mid$(StrMask, 1, 1) = "*" Then ' Любое имя файла
            If Mid$(StrMask, 2, 1) = "." Then
                SearchExtension = Mid$(StrMask, 3)
                
                If Right$(FileName, Len(SearchExtension)) = SearchExtension Then
                    IsStrMaskEquivalentFileName = True
                End If
            End If
        Else ' Конкретное имя файла
            If Right$(StrMask, 2) = ".*" Then ' Любое расширение
                ' Получить имя файла до точки
                PathRemoveExtensionW StrPtr(StrMask)
                lNullPos = InStr(1, StrMask, vbNullChar)
                If lNullPos Then StrMask = Left$(StrMask, lNullPos - 1)
                
                PathFileName = FileName
                PathRemoveExtensionW StrPtr(PathFileName)
                lNullPos = InStr(1, PathFileName, vbNullChar)
                If lNullPos Then PathFileName = Left$(PathFileName, lNullPos - 1)
                
                If StrMask = PathFileName Then
                    IsStrMaskEquivalentFileName = True
                End If
            Else ' Конкретное имя файла и конкретное расширение
                If StrMask = FileName Then
                    IsStrMaskEquivalentFileName = True
                End If
            End If
        End If
    Else
        IsStrMaskEquivalentFileName = True
    End If
End Function
 
' Поиск файлов на винчестере
Public Function FindFilesAPI(path As String, FilesArray() As PathsFileName, Optional MaskStr As String, Optional AddDateAndSizeFiles As Boolean = True, Optional IncludeDirectories As Boolean = True, Optional Interrupt As Boolean, Optional FileCount As Long, Optional DirCount As Long) As Currency
    Dim lpStr As Long
    Dim FileName As String
    Dim dirNames() As String
    Dim nDir As Long
    Dim i As Long
    Dim hSearch As Long
    Dim WFD As WIN32_FIND_DATA_UNICODE
    Dim Cont As Long
    Dim cntMask As Byte
    Dim AddFileOrDir As Boolean
    Dim FileSize As Currency
    
    If FileCount = 0 Then ' Первый раз
        add_cnt = 0
        all_cnt = 0
        Erase Masks
    End If
    
    If Right(path, 1) <> "\" Then path = path & "\"
    nDir = 0
    ReDim dirNames(nDir)
    Cont = True
    hSearch = FindFirstFileW(StrPtr(path & "*"), WFD)
    
    If hSearch <> INVALID_HANDLE_VALUE Then
        Do While Cont
            lpStr = VarPtr(WFD.dwReserved1) + 4
            PutMem4 VarPtr(FileName), SysAllocStringLen(0, lstrlen(lpStr)) ' Мгновенно выделить память для строки
            lstrcpy StrPtr(FileName), lpStr ' Копирование строк
            
            all_cnt = all_cnt + 1
            If Right$(Trim$(Str$(all_cnt)), 3) = "000" Then ' Каждая тысяча строк
                If Interrupt = True Then
                    DoEvents ' Прерывание
                End If
            End If
            
            If FileName <> "." And FileName <> ".." Then
                AddFileOrDir = False
                FileSize = 0
                
                If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> 0 Then ' Если это каталог
                    dirNames(nDir) = FileName
                    DirCount = DirCount + 1
                    nDir = nDir + 1
                    ReDim Preserve dirNames(nDir)
                    
                    If IncludeDirectories = True Then
                        AddFileOrDir = True
                    End If
                Else ' Если это файл
                    If Len(MaskStr) > 0 Then
                        If InStr(1, MaskStr, ";") > 0 Then ' Маска содержит несколько типов файлов
                            If FileCount = 0 Then ' Первый раз
                                Masks = Split(MaskStr, ";") ' Расщепить строку на массив только один раз
                            End If
                            
                            For cntMask = 0 To UBound(Masks)
                                If IsStrMaskEquivalentFileName(Masks(cntMask), FileName) = True Then
                                    AddFileOrDir = True
                                End If
                            Next
                        Else
                            AddFileOrDir = IsStrMaskEquivalentFileName(MaskStr, FileName)
                        End If
                    Else
                        AddFileOrDir = True
                    End If
                    
                    If AddFileOrDir = True Then
                        Long2Size WFD.nFileSizeLow, WFD.nFileSizeHigh, FileSize ' Вычислить размер файла, с поддержкой файлов > 2 Гб
                        
                        FindFilesAPI = FindFilesAPI + FileSize
                        FileCount = FileCount + 1
                    End If
                End If
                
                ' Добавление строки
                If AddFileOrDir = True Then
                    ReDim Preserve FilesArray(add_cnt)
                    FilesArray(add_cnt).PathDirName = path
                    FilesArray(add_cnt).PathFileOrDirName = FileName
                    
                    If AddDateAndSizeFiles = True Then
                        FilesArray(add_cnt).PathFileSize = FileSize
                        FilesArray(add_cnt).PathDateTime = WFD.ftLastWriteTime
                    End If
                    
                    add_cnt = add_cnt + 1
                End If
            End If
            
            Cont = FindNextFileW(hSearch, WFD)
        Loop
        
        Cont = FindClose(hSearch)
    End If
    
    If nDir > 0 Then
        For i = 0 To nDir - 1
            FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) & "\", FilesArray, MaskStr, AddDateAndSizeFiles, IncludeDirectories, Interrupt, FileCount, DirCount)
        Next i
    End If
End Function
 
Private Sub Long2Size(ByVal LongLow As Long, ByVal LongHigh As Long, ByRef FileSize As Currency)
    '&HFFFFFFFF unsigned = 4294967295
    Dim Cutoff As Currency
    Cutoff = 2147483647
    Cutoff = Cutoff + 2147483647
    Cutoff = Cutoff + 1 ' now we hold the value of 4294967295 and not -1
    FileSize = Cutoff * LongHigh
    If LongLow < 0 Then
        FileSize = FileSize + (Cutoff + (LongLow + 1))
    Else
        FileSize = FileSize + LongLow
    End If
End Sub