Не правильно воспринимается путь Comdlg32.dll

Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
 
Public Type OPENFILENAME
   lStructSize As Long
   hwndOwner As Long
   hInstance As Long
   lpstrFilter As String
   lpstrCustomFilter As String
   nMaxCustFilter As Long
   nFilterIndex As Long
   lpstrFile As String
   nMaxFile As Long
   lpstrFileTitle As String
   nMaxFileTitle As Long
   lpstrInitialDir As String
   lpstrTitle As String
   flags As Long
   nFileOffset As Integer
   nFileExtension As Integer
   lpstrDefExt As String
   lCustData As Long
   lpfnHook As Long
   lpTemplateName As String
End Type
 
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_DONTADDTORECENT = &H2000000
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLEINCLUDENOTIFY = &H400000
Public Const OFN_ENABLESIZING = &H800000
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_EXPLORER = &H80000
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_FORCESHOWHIDDEN = &H10000000
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_LONGNAMES = &H200000
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_NOLONGNAMES = &H40000
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NOVALIDATE = &H1000
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_READONLY = &H1
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_SHOWHELP = &H10

Prvate Sub Form_Load()
   Dim OpenFile As OPENFILENAME
   Dim lReturn As Long
   Dim sFilter As String
   
   OpenFile.lStructSize = Len(OpenFile)
   OpenFile.hwndOwner = Me.HWND
   OpenFile.hInstance = App.hInstance
   sFilter = "ALL Files (*.*)" & Chr(0) & "*.*" & Chr(0)
   OpenFile.lpstrFilter = sFilter
   OpenFile.nFilterIndex = 1
   OpenFile.lpstrFile = String(65536, 0)
   OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
   OpenFile.lpstrFileTitle = OpenFile.lpstrFile
   OpenFile.nMaxFileTitle = OpenFile.nMaxFile
   OpenFile.lpstrInitialDir = App.Path
   OpenFile.lpstrTitle = "Выберите путь..."
 
   OpenFile.flags = &H80000 + &H4
   lReturn = GetOpenFileName(OpenFile)
   MsgBox OpenFile.lpstrFileName
End Sub

Option Explicit
Option Base 0
 
Public Const INVALID_HANDLE_VALUE = -1
Private Const GENERIC_WRITE = &H40000000
Private Const GENERIC_READ = &H80000000
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const CREATE_NEW = 1
Private Const CREATE_ALWAYS = 2
Private Const OPEN_EXISTING = 3
Private Const OPEN_ALWAYS = 4
Private Const TRUNCATE_EXISTING = 5
 
Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, _
   lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, _
   lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
 
Public Declare Function CloseHandle Lib "kernel32" ( _
  ByVal hObject As Long) As Long
 
Private Declare Function WriteFile Lib "kernel32" ( _
  ByVal hFile As Long, lpBuffer As Any, _
  ByVal nNumberOfBytesToWrite As Long, _
  lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
 
Private Declare Function CreateFile Lib "kernel32" _
  Alias "CreateFileA" (ByVal lpFileName As String, _
  ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
  ByVal lpSecurityAttributes As Long, _
  ByVal dwCreationDisposition As Long, _
  ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) _
  As Long
 
Declare Function FlushFileBuffers Lib "kernel32" ( _
  ByVal hFile As Long) As Long
 
Public Function ap_OpenFileReadOnly(sFileName As String) As Long
' Wrapper around Windows API fn to open a file for read only
' Returns INVALID_HANDLE_VALUE (-1) if it fails.
   ap_OpenFileReadOnly = CreateFile(sFileName, GENERIC_READ, _
                        0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
End Function
 
Public Function ap_OpenFileWrite(sFileName As String) As Long
' Wrapper around Windows API fn to open a file for writing
' Returns INVALID_HANDLE_VALUE (-1) if it fails.
' Warning: Will overwrite existing file, if it exists
   ap_OpenFileWrite = CreateFile(sFileName, GENERIC_WRITE, _
                        0, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
End Function
 
Public Function ap_CloseFile(fHandle As Long) As Boolean
' Flush the file buffers to force writing of the data.
    Dim fSuccess As Long
    fSuccess = FlushFileBuffers(fHandle)
    fSuccess = CloseHandle(fHandle)
    ap_CloseFile = (fSuccess <> 0)
End Function
 
Public Function ap_PutByte(fHandle As Long, byt As Byte) As Boolean
' Writes a single byte to an open file with handle <fHandle>
' Returns True if successful; false if fails
    Dim fSuccess As Long
    Dim lBytesToWrite As Long
    Dim lBytesWritten As Long
    lBytesToWrite = 1
    fSuccess = WriteFile(fHandle, byt, lBytesToWrite, lBytesWritten, 0)
    'Check to see if successful writing the data
    ap_PutByte = (fSuccess <> 0)
End Function
 
Public Function ap_GetBytes(fHandle As Long, aBytes() As Byte, _
    lBytesToRead As Long) As Boolean
' Reads n bytes from open file
    Dim fSuccess As Long
    Dim lBytesRead As Long
    fSuccess = ReadFile(fHandle, aBytes(0), lBytesToRead, lBytesRead, 0)
    ap_GetBytes = (fSuccess <> 0)
End Function
 
Public Function ap_PutBytes(fHandle As Long, aBytes() As Byte, _
    lBytesToWrite As Long) As Boolean
' Writes n bytes to open file
    Dim fSuccess As Long
    Dim lBytesWritten As Long
    fSuccess = WriteFile(fHandle, aBytes(0), lBytesToWrite, lBytesWritten, 0)
    ap_PutBytes = (fSuccess <> 0)
End Function

Option Base 1
Option Explicit
 
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As Long
    lpstrCustomFilter As Long
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As Long
    nMaxFile As Long
    lpstrFileTitle As Long
    nMaxFileTitle As Long
    lpstrInitialDir As Long
    lpstrTitle As Long
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As Long
End Type
 
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameW" (pOpenfilename As OPENFILENAME) As Long
 
Private Sub Form_Load()
    Dim sFileIn$
    Dim sFileOut$
    
    Me.Show
    sFileIn$ = GetFile(Me.hwnd, App.Path)
    sFileOut$ = sFileIn$ & "_"
    
    If ap_OpenFileReadOnly(sFileIn$) < 0 Then MsgBox "Не могу открыть.": End
    If ap_OpenFileWrite(sFileOut$) < 0 Then MsgBox "Не могу записать.": End
End Sub
 
Public Function GetFile(ByVal hwnd As Long, Optional InitDir As String) As String
    On Error Resume Next
    Dim ofn As OPENFILENAME
    Dim Title As String, out As String, tmp$
    Dim Filter As String, i As Long, m As Long
    InitDir = "C:\Users\Acid\Desktop\BlowFish"
    Dim Arr() As String
    
    ofn.nMaxFile = 260
    out = String(260, 0)
    Title = "Введите путь..."
    Filter = "Все файлы" & vbNullChar & "*.*" & vbNullChar
    ofn.hwndOwner = hwnd
    ofn.lpstrTitle = StrPtr(Title)
    ofn.lpstrFile = StrPtr(out)
    ofn.lStructSize = Len(ofn)
    ofn.lpstrFilter = StrPtr(Filter)
    ofn.lpstrInitialDir = StrPtr(InitDir)
    
    ReDim Arr(Len(out))
    If GetOpenFileName(ofn) Then
        For m = 1 To Len(out) - 1
            Arr(m) = AscW(Mid$(out, m, 1))
            tmp$ = tmp$ + ChrW$(Arr(m))
        Next m
        i = InStr(1, out, vbNullChar, vbBinaryCompare)
        If i Then GetFile = Left$(out, i - 1)
    End If
End Function

'
' modFile module by Alex Dragokas
'
 
Option Explicit
 
Const MAX_PATH As Long = 260&
Const MAX_FILE_SIZE As Currency = 104857600@
 
Enum VB_FILE_ACCESS_MODE
    FOR_READ = 1
    FOR_READ_WRITE = 2
    FOR_OVERWRITE_CREATE = 4
End Enum
 
Enum CACHE_TYPE
    USE_CACHE
    NO_CACHE
End Enum
 
Private Type LARGE_INTEGER
    LowPart As Long
    HighPart As Long
End Type
 
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
    lpszFileName(MAX_PATH) As Integer
    lpszAlternate(14) As Integer
End Type
 
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type
 
Private Type VS_FIXEDFILEINFO
    dwSignature As Long
    dwStrucVersionl As Integer
    dwStrucVersionh As Integer
    dwFileVersionMSl As Integer
    dwFileVersionMSh As Integer
    dwFileVersionLSl As Integer
    dwFileVersionLSh As Integer
    dwProductVersionMSl As Integer
    dwProductVersionMSh As Integer
    dwProductVersionLSl As Integer
    dwProductVersionLSh As Integer
    dwFileFlagsMask As Long
    dwFileFlags As Long
    dwFileOS As Long
    dwFileType As Long
    dwFileSubtype As Long
    dwFileDateMS As Long
    dwFileDateLS As Long
End Type
 
Private Declare Function PathFileExists Lib "Shlwapi.dll" Alias "PathFileExistsW" (ByVal pszPath As Long) As Long
Private Declare Function GetFileAttributes Lib "kernel32.dll" Alias "GetFileAttributesW" (ByVal lpFileName As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileW" (ByVal lpFileName As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32.dll" Alias "FindNextFileW" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32.dll" (ByVal hFindFile As Long) As Long
Private Declare Function CreateFile Lib "kernel32.dll" Alias "CreateFileW" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
'Private Declare Function SHFileExists Lib "shell32.dll" Alias "#45" (ByVal szPath As String) As Long
Private Declare Function Wow64DisableWow64FsRedirection Lib "kernel32.dll" (OldValue As Long) As Long
Private Declare Function Wow64RevertWow64FsRedirection Lib "kernel32.dll" (ByVal OldValue As Long) As Long
Private Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeW" (ByVal nDrive As Long) As Long
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long
Private Declare Function GetFileSizeEx Lib "kernel32.dll" (ByVal hFile As Long, lpFileSize As Any) As Long
Private Declare Function SetFilePointer Lib "kernel32.dll" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToRead As Long, lpNumberOfByConstesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExW" (ByVal hKey As Long, ByVal lpSubKey As Long, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExW" (ByVal hKey As Long, ByVal lpValueName As Long, ByVal lpReserved As Long, ByRef lpType As Long, szData As Long, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function memcpy Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32.dll" Alias "GetWindowsDirectoryW" (ByVal lpBuffer As Long, ByVal uSize As Long) As Long
Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpStringDest As Long, ByVal lpStringSrc As Long) As Long
Private Declare Function GetLongPathNameW Lib "kernel32" (ByVal lpszShortPath As Long, ByVal lpszLongPath As Long, ByVal cchBuffer As Long) As Long
Private Declare Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoW" (ByVal lptstrFilename As Long, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeW" (ByVal lptstrFilename As Long, lpdwHandle As Long) As Long
Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueW" (pBlock As Any, ByVal lpSubBlock As Long, lplpBuffer As Long, puLen As Long) As Long
 
 
Const FILE_SHARE_READ           As Long = &H1&
Const FILE_SHARE_WRITE          As Long = &H2&
Const FILE_SHARE_DELETE         As Long = 4&
Const FILE_READ_ATTRIBUTES      As Long = &H80&
Const OPEN_EXISTING             As Long = 3&
Const CREATE_ALWAYS             As Long = 2&
Const GENERIC_READ              As Long = &H80000000
Const GENERIC_WRITE             As Long = &H40000000
Const FILE_ATTRIBUTE_DIRECTORY  As Long = &H10&
Const INVALID_HANDLE_VALUE      As Long = &HFFFFFFFF
Const ERROR_SUCCESS             As Long = 0&
Const INVALID_FILE_ATTRIBUTES   As Long = -1&
Const NO_ERROR                  As Long = 0&
Const FILE_BEGIN                As Long = 0&
Const FILE_CURRENT              As Long = 1&
Const FILE_END                  As Long = 2&
Const INVALID_SET_FILE_POINTER  As Long = &HFFFFFFFF
 
Const DRIVE_FIXED               As Long = 3&
Const DRIVE_RAMDISK             As Long = 6&
 
Const HKEY_LOCAL_MACHINE        As Long = &H80000002
Const KEY_QUERY_VALUE           As Long = &H1&
Const RegType_DWord             As Long = 4&
 
Const ch_Dot                    As String = "."
Const ch_DotDot                 As String = ".."
Const ch_Slash                  As String = ""
Const ch_SlashAsterisk          As String = "\*"
 
Private lWow64Old               As Long
Private DriveTypeName           As New Collection
Private arrPathFolders()        As String
Private arrPathFiles()          As String
Private Total_Folders           As Long
Private Total_Files             As Long
 
 
 
Public Function FileExists(ByVal sFile$, Optional bUseWow64 As Boolean) As Boolean
    On Error GoTo ErrorHandler:
    Dim Redirect As Boolean
    
    sFile = Trim$(sFile)
    If Len(sFile) = 0 Then Exit Function
    If Left$(sFile, 2) = "" Then Exit Function 'DriveType = "REMOTE"
    
    ' use 2 methods for reliability reason (both supported unicode pathes)
    Dim Ex(1) As Boolean
    Dim ret As Long
    
    Dim WFD     As WIN32_FIND_DATA
    Dim hFile   As Long
    
    If Not bUseWow64 Then Redirect = ToggleWow64FSRedirection(False, sFile)
    
    ret = GetFileAttributes(StrPtr(sFile))
    If ret <> INVALID_HANDLE_VALUE And (0 = (ret And FILE_ATTRIBUTE_DIRECTORY)) Then Ex(0) = True
 
    hFile = FindFirstFile(StrPtr(sFile), WFD)
    Ex(1) = (hFile <> INVALID_HANDLE_VALUE) And Not CBool(WFD.dwFileAttributes And vbDirectory)
    FindClose hFile
 
    ' // here must be enabling of FS redirector
    If Redirect Then Call ToggleWow64FSRedirection(True)
 
    FileExists = Ex(0) Or Ex(1)
    Exit Function
ErrorHandler:
    ErrorMsg Err, "modFile.FileExists", "File:", sFile$
    If inIDE Then Stop: Resume Next
End Function
 
Public Function FolderExists(ByVal sFolder$, Optional ForceUnderRedirection As Boolean) As Boolean
    On Error GoTo ErrorHandler:
    
    Dim ret As Long
    sFolder = Trim$(sFolder)
    If Len(sFolder) = 0 Then Exit Function
    If Left$(sFolder, 2) = "" Then Exit Function 'network path
    
    '// FS redirection checking
    
    ret = GetFileAttributes(StrPtr(sFolder))
    FolderExists = CBool(ret And vbDirectory) And (ret <> INVALID_FILE_ATTRIBUTES)
    
    '// FS redirection enambling
    
    Exit Function
ErrorHandler:
    ErrorMsg Err, "modFile.FolderExists", "Folder:", sFolder$, "Redirection: ", ForceUnderRedirection
    If inIDE Then Stop: Resume Next
End Function
 
 
Public Sub GetDriveTypeNames()
    On Error GoTo ErrorHandler
    Dim lr As Long
    Dim i  As Long
    Dim DT As String
 
    For i = 65& To 90&
 
      lr = GetDriveType(StrPtr(Chr$(i) & ":"))
 
      Select Case lr
        Case 3&
            DT = "FIXED"
        Case 2&
            DT = "REMOVABLE"
        Case 5&
            DT = "CDROM"
        Case 4&
            DT = "REMOTE"
        Case 0&
            DT = "UNKNOWN"
        Case 1&
            DT = "DISCONNECTED" '"NO_ROOT_DIR"
        Case 6&
            DT = "RAMDISK"
        Case Else
            DT = "UNKNOWN"
      End Select
 
      DriveTypeName.Add DT, Chr$(i)
 
    Next
 
    Exit Sub
ErrorHandler:
    ErrorMsg Err, "modFile.GetDriveTypeNames", "Drive:", Chr$(i)
End Sub
 
 
Function FileLenW(Path As String) As Currency ', Optional DoNotUseCache As Boolean
    On Error GoTo ErrorHandler
    
    Dim lr          As Long
    Dim hFile       As Long
    Dim FileSize    As Currency
 
    hFile = CreateFile(StrPtr(Path), FILE_READ_ATTRIBUTES, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, ByVal 0&, ByVal 0&)
    
    If hFile Then
        lr = GetFileSizeEx(hFile, FileSize)
        If lr Then
            If FileSize < 10000000000@ Then FileLenW = FileSize * 10000&
        End If
        CloseHandle hFile: hFile = 0&
    End If
    Exit Function
ErrorHandler:
    ErrorMsg Err, "modFile.FileLenW", "File:", Path, "hFile:", hFile, "FileSize:", FileSize, "Return:", lr
End Function

Public Function OpenW(FileName As String, Access As VB_FILE_ACCESS_MODE, retHandle As Long, Optional MountToMemory As Boolean) As Boolean '// TODO: MountToMemory
    
    Dim FSize As Currency
 
    If Access And (FOR_READ Or FOR_READ_WRITE) Then
        If Not FileExists(FileName) Then
            retHandle = INVALID_HANDLE_VALUE
            Exit Function
        End If
    End If
        
    If Access = FOR_READ Then
        retHandle = CreateFile(StrPtr(FileName), GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE Or FILE_SHARE_DELETE, ByVal 0&, OPEN_EXISTING, ByVal 0&, ByVal 0&)
    ElseIf Access = FOR_OVERWRITE_CREATE Then
        retHandle = CreateFile(StrPtr(FileName), GENERIC_WRITE, FILE_SHARE_READ, ByVal 0&, CREATE_ALWAYS, ByVal 0&, ByVal 0&)
    ElseIf Access = FOR_READ_WRITE Then
        retHandle = CreateFile(StrPtr(FileName), GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, ByVal 0&, ByVal 0&)
    Else
        'WriteCon "Wrong access mode!", cErr
    End If
 
    OpenW = (INVALID_HANDLE_VALUE <> retHandle)
    
    ' ограничение на максимально возможный файл для открытия ( > 100 МБ )
    If OpenW Then
        If Access And (FOR_READ Or FOR_READ_WRITE) Then
            FSize = LOFW(retHandle)
            If FSize > MAX_FILE_SIZE Then
                CloseHandle retHandle
                retHandle = INVALID_HANDLE_VALUE
                OpenW = False
                '"Не хочу и не буду открывать этот файл, потому что его размер превышает безопасный максимум"
                Err.Clear: ErrorMsg Err, "modFile.OpenW: " & "Trying to open too big file" & ": (" & (FSize \ 1024 \ 1024) & " MB.) " & FileName
            End If
        End If
    Else
        ErrorMsg Err, "modFile.OpenW: Cannot open file: " & FileName
        Err.Raise 75 ' Path/File Access error
    End If
 
End Function
 
                                                                  'do not change Variant type at all or you will die ^_^
Public Function GetW(hFile As Long, pos As Long, Optional vOut As Variant, Optional vOutPtr As Long, Optional cbToRead As Long) As Boolean
                                                                  
    'On Error GoTo ErrorHandler
    
    Dim lBytesRead  As Long
    Dim lr          As Long
    Dim ptr         As Long
    Dim vType       As Long
    Dim UnknType    As Boolean
    
    pos = pos - 1   ' VB's Get & SetFilePointer difference correction
    
    If INVALID_SET_FILE_POINTER <> SetFilePointer(hFile, pos, ByVal 0&, FILE_BEGIN) Then
        If NO_ERROR = Err.LastDllError Then
            vType = VarType(vOut)
            
            If 0 <> cbToRead Then   'vbError = vType
                lr = ReadFile(hFile, vOutPtr, cbToRead, lBytesRead, 0&)
                
            ElseIf vbString = vType Then
                lr = ReadFile(hFile, StrPtr(vOut), Len(vOut), lBytesRead, 0&)
                If Err.LastDllError <> 0 Or lr = 0 Then Err.Raise 52
                
                vOut = StrConv(vOut, vbUnicode)
                If Len(vOut) <> 0 Then vOut = Left$(vOut, Len(vOut) \ 2)
            Else
                'do a bit of magik :)
                memcpy ptr, ByVal VarPtr(vOut) + 8, 4& 'VT_BYREF
                Select Case vType
                Case vbByte
                    lr = ReadFile(hFile, ptr, 1&, lBytesRead, 0&)
                Case vbInteger
                    lr = ReadFile(hFile, ptr, 2&, lBytesRead, 0&)
                Case vbLong
                    lr = ReadFile(hFile, ptr, 4&, lBytesRead, 0&)
                Case vbCurrency
                    lr = ReadFile(hFile, ptr, 8&, lBytesRead, 0&)
                Case Else
                    UnknType = True
                    Err.Clear: ErrorMsg Err, "modFile.GetW. type #" & VarType(vOut) & " of buffer is not supported.": Err.Raise 52
                End Select
            End If
            GetW = (0 <> lr)
            If 0 = lr And Not UnknType Then Err.Clear: ErrorMsg Err, "Cannot read file!": Err.Raise 52
        Else
            Err.Clear: ErrorMsg Err, "Cannot set file pointer!": Err.Raise 52
        End If
    Else
        Err.Clear: ErrorMsg Err, "Cannot set file pointer!": Err.Raise 52
    End If
    
'    Exit Function
'ErrorHandler:
'    AppendErrorLogFormat Now, err, "modFile.GetW"
'    Resume Next
End Function
 
Public Function PutW(hFile As Long, pos As Long, vInPtr As Long, cbToWrite As Long, Optional doAppend As Boolean) As Boolean
    On Error GoTo ErrorHandler
    
    Dim lBytesWrote  As Long
    
    pos = pos - 1   ' VB's Get & SetFilePointer difference correction
    
    If doAppend Then
        If INVALID_SET_FILE_POINTER = SetFilePointer(hFile, 0&, ByVal 0&, FILE_END) Then Exit Function
    Else
        If INVALID_SET_FILE_POINTER = SetFilePointer(hFile, pos, ByVal 0&, FILE_BEGIN) Then Exit Function
    End If
    
    If NO_ERROR = Err.LastDllError Then
    
        If WriteFile(hFile, vInPtr, cbToWrite, lBytesWrote, 0&) Then PutW = True
        
    End If
    
    Exit Function
ErrorHandler:
    ErrorMsg Err, "modFile.PutW"
End Function
 
Public Function LOFW(hFile As Long) As Currency
    On Error GoTo ErrorHandler
    Dim lr          As Long
    Dim FileSize    As Currency
    
    If hFile Then
        lr = GetFileSizeEx(hFile, FileSize)
        If lr Then
            If FileSize < 10000000000@ Then
                LOFW = FileSize * 10000&
            Else
                Err.Clear
                ErrorMsg Now, "File is too big. Size: " & FileSize
            End If
        End If
    End If
ErrorHandler:
End Function
 
Public Function CloseW(hFile As Long) As Long
    CloseW = CloseHandle(hFile)
End Function
 
Public Function ToggleWow64FSRedirection(bEnable As Boolean, Optional PathNecessity As String, Optional OldStatus As Boolean) As Boolean
    'Static lWow64Old        As Long    'Warning: do not use initialized variables for this API !
                                        'Static variables is not allowed !
                                        'lWow64Old is now declared globally
    'True - enable redirector
    'False - disable redirector
 
    'OldStatus: current state of redirection
    'True - redirector was enabled
    'False - redirector was disabled
 
    'Return value is:
    'true if success
 
    Static IsNotRedirected  As Boolean
    Dim lr                  As Long
 
    OldStatus = Not IsNotRedirected
 
    If Not bIsWin64 Then Exit Function
 
    If Len(PathNecessity) <> 0 Then
        If StrComp(Left$(PathNecessity, Len(sWinDir)), sWinDir, vbTextCompare) <> 0 Then Exit Function
    End If
 
    If bEnable Then
        If IsNotRedirected Then
            lr = Wow64RevertWow64FsRedirection(lWow64Old)
            ToggleWow64FSRedirection = (lr <> 0)
            IsNotRedirected = False
        End If
    Else
        If Not IsNotRedirected Then
            lr = Wow64DisableWow64FsRedirection(lWow64Old)
            ToggleWow64FSRedirection = (lr <> 0)
            IsNotRedirected = True
        End If
    End If
End Function
 
 
Public Function GetExtensionName(Path As String) As String  'вернет .ext
    Dim pos As Long
    pos = InStrRev(Path, ".")
    If pos <> 0 Then GetExtensionName = Mid$(Path, pos)
End Function
 
' Является ли файл форматом PE EXE
Public Function isPE_EXE(Optional FileName As String, Optional FileHandle As Long) As Boolean
    On Error GoTo ErrorHandler
 
    Dim hFile          As Long
    Dim PE_offset      As Long
    Dim MZ(1)          As Byte
    Dim pe(3)          As Byte
    Dim FSize          As Currency
  
    If FileHandle = 0& Then
        OpenW FileName, FOR_READ, hFile
    Else
        hFile = FileHandle
    End If
    If hFile <> INVALID_HANDLE_VALUE Then
        FSize = LOFW(hFile)
        If FSize >= &H3C& + 4& Then
            GetW hFile, 1&, , VarPtr(MZ(0)), ((UBound(MZ) + 1&) * CLng(LenB(MZ(0))))
            If (MZ(0) = 77& And MZ(1) = 90&) Or (MZ(1) = 77& And MZ(0) = 90&) Then  'MZ or ZM
                GetW hFile, &H3C& + 1&, PE_offset
                If PE_offset And FSize >= PE_offset + 4 Then
                    GetW hFile, PE_offset + 1&, , VarPtr(pe(0)), ((UBound(pe) + 1&) * CLng(LenB(pe(0))))
                    If pe(0) = 80& And pe(1) = 69& And pe(2) = 0& And pe(3) = 0& Then isPE_EXE = True   'PE NUL NUL
                End If
            End If
        End If
        If FileHandle = 0& Then CloseW hFile: hFile = 0&
    End If
    
    'If Len(FileName) <> 0& Then PE_EXE_Cache.Add FileName, isPE_EXE
    Exit Function
    
ErrorHandler:
    ErrorMsg Err, "Parser.isPE_EXE", "File:", FileName
    'On Error Resume Next
    'If Len(FileName) <> 0& Then PE_EXE_Cache.Add FileName, isPE_EXE
    If FileHandle = 0& Then
        If hFile <> 0 Then CloseW hFile: hFile = 0&
    End If
End Function

'main function to list folders
 
' Возвращает массив путей.
' Если ничего не найдено - возвращается неинициализированный массив. Используйте SafeArrayGetDim()
Public Function ListSubfolders(Path As String, Optional Recursively As Boolean = False) As String()
    Dim bRedirected As Boolean
    'прежде, чем использовать ListSubfolders_Ex, нужно инициализировать глобальные массивы.
    ReDim arrPathFolders(100) As String
    'при каждом вызове ListSubfolders_Ex следует обнулить глобальный счетчик файлов
    Total_Folders = 0&
    
    If bIsWin64 Then
        If StrBeginWith(Path, sWinDir) Then
            ToggleWow64FSRedirection False
            bRedirected = True
        End If
    End If
    
    'вызов тушки
    Call ListSubfolders_Ex(Path, Recursively)
    If Total_Folders > 0 Then
        Total_Folders = Total_Folders - 1
        ReDim Preserve arrPathFolders(Total_Folders)      '0 to Max -1
        ListSubfolders = arrPathFolders
    End If
    
    If bRedirected Then ToggleWow64FSRedirection True
End Function
 
 
Private Sub ListSubfolders_Ex(Path As String, Optional Recursively As Boolean = False)
    On Error GoTo ErrorHandler
    'On Error Resume Next
    Dim SubPathName     As String
    Dim PathName        As String
    Dim hFind           As Long
    Dim l               As Long
    Dim lpSTR           As Long
    Dim fd              As WIN32_FIND_DATA
    
    'Local module variables:
    '
    ' Total_Folders as long
    ' arrPathFolders() as string
    
    Do
        If hFind <> 0& Then
            If FindNextFile(hFind, fd) = 0& Then FindClose hFind: Exit Do
        Else
            hFind = FindFirstFile(StrPtr(Path & ch_SlashAsterisk), fd)  '"\*"
            If hFind = INVALID_HANDLE_VALUE Then Exit Do
        End If
        
        l = fd.dwFileAttributes And &H600& ' мимо симлинков
        Do While l <> 0&
            If FindNextFile(hFind, fd) = 0& Then FindClose hFind: hFind = 0: Exit Do
            l = fd.dwFileAttributes And &H600&
        Loop
    
        If hFind <> 0& Then
            lpSTR = VarPtr(fd.dwReserved1) + 4&
            PathName = Space(lstrlen(lpSTR))
            lstrcpy StrPtr(PathName), lpSTR
        
            If fd.dwFileAttributes And vbDirectory Then
                If PathName <> ch_Dot Then  '"."
                    If PathName <> ch_DotDot Then '".."
                        SubPathName = Path & "" & PathName
                        If UBound(arrPathFolders) < Total_Folders Then ReDim Preserve arrPathFolders(UBound(arrPathFolders) + 100&) As String
                        arrPathFolders(Total_Folders) = SubPathName
                        Total_Folders = Total_Folders + 1&
                        If Recursively Then
                            Call ListSubfolders_Ex(SubPathName, Recursively)
                        End If
                    End If
                End If
            End If
        End If
        
    Loop While hFind
    
    Exit Sub
ErrorHandler:
    ErrorMsg Err, "modFile.ListSubfolders", "Folder:", Path
    Resume Next
End Sub
 
'main function to list files
 
Public Function ListFiles(Path As String, Optional Extension As String = "", Optional Recursively As Boolean = False) As String()
    Dim bRedirected As Boolean
    'прежде, чем использовать ListFiles_Ex, нужно инициализировать глобальные массивы.
    ReDim arrPathFiles(100) As String
    'при каждом вызове ListFiles_Ex следует обнулить глобальный счетчик файлов
    Total_Files = 0&
    
    If bIsWin64 Then
        If StrBeginWith(Path, sWinDir) Then
            ToggleWow64FSRedirection False
            bRedirected = True
        End If
    End If
    
    'вызов тушки
    Call ListFiles_Ex(Path, Extension, Recursively)
    If Total_Files > 0 Then
        Total_Files = Total_Files - 1
        ReDim Preserve arrPathFiles(Total_Files)      '0 to Max -1
        ListFiles = arrPathFiles
    End If
    
    If bRedirected Then ToggleWow64FSRedirection True
End Function
 
 
Private Sub ListFiles_Ex(Path As String, Optional Extension As String = "", Optional Recursively As Boolean = False)
    'Example of Extension:
    '".txt" - txt files
    'empty line - all files (by default)
 
    On Error GoTo ErrorHandler
    'On Error Resume Next
    Dim SubPathName     As String
    Dim PathName        As String
    Dim hFind           As Long
    Dim l               As Long
    Dim lpSTR           As Long
    Dim fd              As WIN32_FIND_DATA
    
    'Local module variables:
    '
    ' Total_Files as long
    ' arrPathFiles() as string
    
    Do
        If hFind <> 0& Then
            If FindNextFile(hFind, fd) = 0& Then FindClose hFind: Exit Do
        Else
            hFind = FindFirstFile(StrPtr(Path & ch_SlashAsterisk), fd)  '"\*"
            If hFind = INVALID_HANDLE_VALUE Then Exit Do
        End If
        
        l = fd.dwFileAttributes And &H600& ' мимо симлинков
        Do While l <> 0&
            If FindNextFile(hFind, fd) = 0& Then FindClose hFind: hFind = 0: Exit Do
            l = fd.dwFileAttributes And &H600&
        Loop
    
        If hFind <> 0& Then
            lpSTR = VarPtr(fd.dwReserved1) + 4&
            PathName = Space(lstrlen(lpSTR))
            lstrcpy StrPtr(PathName), lpSTR
        
            If fd.dwFileAttributes And vbDirectory Then
                If PathName <> ch_Dot Then  '"."
                    If PathName <> ch_DotDot Then '".."
                        SubPathName = Path & "" & PathName
                        If Recursively Then
                            Call ListFiles_Ex(SubPathName, Extension, Recursively)
                        End If
                    End If
                End If
            Else
                If inArray(GetExtensionName(PathName), SplitSafe(Extension, ";"), , , 1) Or Len(Extension) = 0 Then
                    SubPathName = Path & "" & PathName
                    If UBound(arrPathFiles) < Total_Files Then ReDim Preserve arrPathFiles(UBound(arrPathFiles) + 100&) As String
                    arrPathFiles(Total_Files) = SubPathName
                    Total_Files = Total_Files + 1&
                End If
            End If
        End If
    Loop While hFind
    
    Exit Sub
ErrorHandler:
    ErrorMsg Err, "modFile.ListFiles_Ex", "File:", Path
    Resume Next
End Sub
 
Public Function GetLocalDisks$()
    Dim lDrives&, i&, sDrive$, sLocalDrives$
    lDrives = GetLogicalDrives()
    For i = 0 To 26
        If (lDrives And 2 ^ i) Then
            sDrive = Chr$(Asc("A") + i) & ":"
            Select Case GetDriveType(StrPtr(sDrive))
                Case DRIVE_FIXED, DRIVE_RAMDISK: sLocalDrives = sLocalDrives & Chr$(Asc("A") + i) & " "
            End Select
        End If
    Next i
    GetLocalDisks = Trim$(sLocalDrives)
End Function

dim FileName As String
Dim hFile          As Long
 
FileName = "c:\temp\test.txt"
 
if OpenW (FileName, FOR_READ, hFile) then
 
  sBuf = String(10, 0)
 
  GetW hFile, 1&, sBuf
 
  CloseW hFile
 
end if

GetW hFile, 1&, , указатель на 0-й элемент массива, размер массива в байтах
 
например,
 
Dim aBuf(1) as byte
...
GetW hFile, 1&, , varptr(aBuf(0)), (UBound(aBuf) + 1&) * CLng(LenB(aBuf(0)))

dim FileName As String
Dim hFile          As Long
Dim sText as string
Dim sBOM as string
Dim b()     As Byte
 
FileName = "c:\temp\test.txt"
sBOM = ChrW$(-257)
sText = "Пример"
 
b() = sBOM & sText
 
if OpenW (FileName, FOR_WRITE, hFile) then
 
  PutW hFile, 1&, VarPtr(b(0)), UBound(b) + 1
 
  CloseW hFile
 
end if