“CreateFileW”是可以打开以Unicode字符命名的文件，但如何将一个Unicode文件名传入参数？

Declare Function CreateFile Lib "kernel32" Alias "CreateFileW" (ByVal lpFileName As long, 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



dim s as string

FileHwnd = CreateFile(strptr(s), GENERIC_READ, FILE_SHARE_READ, SA, OPEN_EXISTING, 0, 0)

这样传进去的就是unicode了根本不用转换,记得原来声明的byval xx as string改为as long就行了

Option Explicit

'枚举指定目录下的文件.

'

'By 嗷嗷叫的老马

'http://www.m5home.com/



Private Const INVALID_HANDLE_VALUE As Long = -1&

Private 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(MAX_PATH - 1) As Byte

    cShortFileName(14 - 1) As Byte

End Type

Public Type byteFileName

    bFileName() As Byte

End Type



Private Declare Function FindClose Lib "kernel32.dll" ( _

     ByVal hFindFile As Long) As Long

Private Declare Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileW" ( _

     ByVal lpFileName As Long, _

     ByRef lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindNextFile Lib "kernel32.dll" Alias "FindNextFileW" ( _

     ByVal hFindFile As Long, _

     ByRef lpFindFileData As WIN32_FIND_DATA) As Long

Private WFD As WIN32_FIND_DATA



Dim m_isSearch As Boolean, isStop As Boolean

Dim m_outFiles() As byteFileName, m_outCount As Long



Public Function ListFileW(ByVal sourceDir As String, ByRef outFiles() As byteFileName, Optional ByVal isCheckSub As Boolean = True) As Long

    '列出指定目录下所有文件

    '

    ReDim m_outFiles(1000)

    m_outCount = 0

    m_isSearch = True

    isStop = False

    

    Call Dir_Api(sourceDir, isCheckSub)

    If m_outCount > 0 Then

        ReDim Preserve m_outFiles(m_outCount - 1)

        outFiles() = m_outFiles()

    End If

    ListFileW = m_outCount

End Function



Public Function isSearch() As Boolean

    '查询是否正在搜索中

    '

    isSearch = m_isSearch

End Function



Public Sub StopSearch()

    '中断搜索过程

    '

    isStop = True

    DoEvents

End Sub



Private Sub Dir_Api(ByVal strPath As String, Optional ByVal isCheckSub As Boolean = True)

    '递归过程

    '

    Dim dirCount As Long, Dirs() As String, hItem As Long

    Dim I As Long, J As Long, K As Long, II As Long, strTmp As String

    Static tmpCount As Long

    

    On Error GoTo errH

    

    If isStop Then Exit Sub

    

    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"

    hItem = FindFirstFile(StrPtr(strPath & "*.*"), WFD)

    If hItem <> INVALID_HANDLE_VALUE Then

        Do

            tmpCount = tmpCount + 1

            If tmpCount Mod 20 = 0 Then DoEvents

            '检查是不是目录

            If (WFD.dwFileAttributes And vbDirectory) Then

                ' 检查是不是  "." or ".."

                If Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1) <> "." And Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1) <> ".." Then

                    ReDim Preserve Dirs(0 To dirCount)

                    Dirs(dirCount) = Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)

                    dirCount = dirCount + 1

                End If

            Else

                For I = 0 To UBound(WFD.cFileName) - 1

                    If WFD.cFileName(I) = 0 And WFD.cFileName(I + 1) = 0 Then

                        m_outFiles(m_outCount).bFileName = strPath        '引发错误

                        m_outFiles(m_outCount).bFileName = strPath

                        

                        K = UBound(m_outFiles(m_outCount).bFileName) + 1

                        ReDim Preserve m_outFiles(m_outCount).bFileName(1000)

                        

                        II = -1

                        

                        For J = K To K + I

                            II = II + 1

                            m_outFiles(m_outCount).bFileName(J) = WFD.cFileName(II)

                        Next

                        ReDim Preserve m_outFiles(m_outCount).bFileName(J)

                        m_outCount = m_outCount + 1

                        Exit For

                    End If

                Next

            End If

        Loop While FindNextFile(hItem, WFD)

        Call FindClose(hItem)

    End If

    If Not isCheckSub Then Exit Sub

    For I = 0 To dirCount - 1

        If isStop Then m_isSearch = False: Exit For

        Dir_Api strPath & Dirs(I) & "\", isCheckSub

    Next

    

    Exit Sub

errH:

    If Err.Number = 9 Then                  '下标越界,则扩大数组.

        ReDim m_outFiles(m_outCount + 1000)

        Resume Next                         '扩大后继续下一句.

    End If

    MsgBox "出现错误:" & Err.Description

    isStop = True

End Sub

Option Explicit

'打开小伙伴指定的游戏.

'

'By 缴社保的老头

'http://www.cug.net/~anonB/dj/djview.cgi?0628#joker2



Dim 文件句柄, 搜索句柄 As Long



Dim 游戏目录 As String



Dim 打比流爱抚弟 As WIN32_FIND_DATA



游戏目录 = "c:\"



搜索句柄 = FindFirstFileW(StrPtr(游戏目录 & "*.nes"), VarPtr(打比流爱抚弟))

      

FindClose 搜索句柄



ReDim 游戏目录缓冲区(512) As Byte



Call StrConvUnicode(游戏目录)

      

CopyMemory 游戏目录缓冲区(Len(游戏目录) * 2), 打比流爱抚弟.cFileName(0), 512 - Len(游戏目录) * 2



文件句柄 = CreateFile(VarPtr(游戏目录缓冲区(0)), GENERIC_READ, FILE_SHARE_READ, SA, OPEN_EXISTING, 0, 0)



DrawTextW Me.hDC, VarPtr(游戏目录缓冲区(0)), UBound(游戏目录缓冲区) / 2, R, DT_CENTER

补充：VB ,  API

上一个：用FTP下载EXE程序、word文档，文件变大，打不开
下一个：vb2010好奇怪的问题，子窗体调dll函数报错