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

时间:2022-12-29 20:19:17
使用windows的GetOpenFileNameW是可以解决问题,但前提是手动一个一个文件去选择

 FileHwnd = CreateFile(VarPtr(UnicodeFileName(0)), GENERIC_READ, FILE_SHARE_READ, SA, OPEN_EXISTING, 0, 0)

得到句柄后再用ReadFile吸出任天堂红白机ROM文件里的游戏数据,然后就可以玩魂斗罗了。

但现在我目录里有3000多个游戏,我要做个CRC校验,不能每个游戏去选择一次然后点击。VB的内置函数全线崩溃,DIR、OPEN、这些都不支持Unicode。

看到过论坛有篇文章引用对象“Fso”转短文件名去解决的,这个可以使用,但这样我的代码要重写了。因为在我的代码中,扫描文件、打开文件、校验CRC,三个功能全写在了一个Function上,加上有些游戏是破解过的,我还手动写了一种算法,抽取魂斗罗里面的部份数据作特征码验证,所以这个Function要改起来工程很大。

我现在只能想到的方法只能是改动扫描文件那部份代码,将原来的DIR扫描换成FindFirstFileW,但我找个不到关于这个API的任何示例,外国人很牛逼的,他们反映FindFirstFileA不行,然后回贴那提示一下改成FindFirstFileW可以,然后那人就自己去改了,很牛逼,但我不牛逼啊,我只想让我的小伙伴们快活地活下去而已,如何修改达到目的?我不是程序员啊,不要给我太高深的暗示,给我一点明示。我一会还得上社保局交社保。

8 个解决方案

#1


看你说了这么一大堆回答一下吧
其实vb是很适合用w系列的函数的

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就行了

#2


很感激在我说了这么一大堆之后会有人看,但就是看了个标题

D盘有个文件“ビデオゲームミュージック.txt”

dim s as string

s=dir("d:\")

你觉得这时候s变量的值是什么?答案是"????????????????????????????????
.txt"

于是乎我再用strptr("????????????????????????????????
".txt)得出变量的指针,传进去参数

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

虽然我现在没条件测试,但我觉得FileHwnd一定会等于“-1”

就那样,算了当我什么都没说

#3


请大家尝试着耐心一次,看完我的贴子,然后想想“如何将一个Unicode文件名传入参数/变量”,

而不是“传入一个变量如何转为Unicode”,更加不会是“传入一个变量需不需要转为Unicode”。

#4


先用 W 系列api获取这个文件的 unicode 文件名,然后再传给 createfileW 就行了

#5


自己搞定了,CopyMemory

但还有一个小细节,除了这样赋值外还有什么好方法?

dim buff(512) as byte

游戏目录 = "C:\"
    
    buff(0) = &H43&
    buff(1) = &H0&
    buff(2) = &H3A&
    buff(3) = &H0&
    buff(4) = &H5C&
    buff(5) = &H0&

我想达到的效果是,根据不同的目录,赋入数组相应的十六进制数值。(要对应unicode,每个字符占两个Byte)

#6


楼主这个问题,无非就是列举与读取UNICODE文件.

那先要找一个支持UNICODE的DIR,这个的话就要API自己写了,或使用VB.NET.

API方面正好我有一个ANSI版本的,改一下就可以列举出UNICODE文件名:

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


这代码本来以前是返回String的,现在改成byteFileName类型了,直接是字节数组,防止VB自作主张地转换.

剩下打开并读写之类的,这个好象你已经用CreateFileW搞定了,那就没啥问题了.

#7


引用 6 楼 myjian 的回复:
楼主这个问题,无非就是列举与读取UNICODE文件.

那先要找一个支持UNICODE的DIR,这个的话就要API自己写了,或使用VB.NET.

API方面正好我有一个ANSI版本的,改一下就可以列举出UNICODE文件名:

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


这代码本来以前是返回String的,现在改成byteFileName类型了,直接是字节数组,防止VB自作主张地转换.

剩下打开并读写之类的,这个好象你已经用CreateFileW搞定了,那就没啥问题了.


抽了几行有用的出来,其余的我删掉了。


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


整出来才想起win98不支持unicode,我需要花点时间说服我的老伙伴们转用win2000

#8


我上面给你的函数是取指定路径下所有文件名的,能支持子目录,调用后就会返回一个UNICODE格式的BYTE数组.

你这么一改,难道是只需要加载一个么.

#1


看你说了这么一大堆回答一下吧
其实vb是很适合用w系列的函数的

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就行了

#2


很感激在我说了这么一大堆之后会有人看,但就是看了个标题

D盘有个文件“ビデオゲームミュージック.txt”

dim s as string

s=dir("d:\")

你觉得这时候s变量的值是什么?答案是"????????????????????????????????
.txt"

于是乎我再用strptr("????????????????????????????????
".txt)得出变量的指针,传进去参数

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

虽然我现在没条件测试,但我觉得FileHwnd一定会等于“-1”

就那样,算了当我什么都没说

#3


请大家尝试着耐心一次,看完我的贴子,然后想想“如何将一个Unicode文件名传入参数/变量”,

而不是“传入一个变量如何转为Unicode”,更加不会是“传入一个变量需不需要转为Unicode”。

#4


先用 W 系列api获取这个文件的 unicode 文件名,然后再传给 createfileW 就行了

#5


自己搞定了,CopyMemory

但还有一个小细节,除了这样赋值外还有什么好方法?

dim buff(512) as byte

游戏目录 = "C:\"
    
    buff(0) = &H43&
    buff(1) = &H0&
    buff(2) = &H3A&
    buff(3) = &H0&
    buff(4) = &H5C&
    buff(5) = &H0&

我想达到的效果是,根据不同的目录,赋入数组相应的十六进制数值。(要对应unicode,每个字符占两个Byte)

#6


楼主这个问题,无非就是列举与读取UNICODE文件.

那先要找一个支持UNICODE的DIR,这个的话就要API自己写了,或使用VB.NET.

API方面正好我有一个ANSI版本的,改一下就可以列举出UNICODE文件名:

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


这代码本来以前是返回String的,现在改成byteFileName类型了,直接是字节数组,防止VB自作主张地转换.

剩下打开并读写之类的,这个好象你已经用CreateFileW搞定了,那就没啥问题了.

#7


引用 6 楼 myjian 的回复:
楼主这个问题,无非就是列举与读取UNICODE文件.

那先要找一个支持UNICODE的DIR,这个的话就要API自己写了,或使用VB.NET.

API方面正好我有一个ANSI版本的,改一下就可以列举出UNICODE文件名:

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


这代码本来以前是返回String的,现在改成byteFileName类型了,直接是字节数组,防止VB自作主张地转换.

剩下打开并读写之类的,这个好象你已经用CreateFileW搞定了,那就没啥问题了.


抽了几行有用的出来,其余的我删掉了。


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


整出来才想起win98不支持unicode,我需要花点时间说服我的老伙伴们转用win2000

#8


我上面给你的函数是取指定路径下所有文件名的,能支持子目录,调用后就会返回一个UNICODE格式的BYTE数组.

你这么一改,难道是只需要加载一个么.