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系列的函数的
其实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”
就那样,算了当我什么都没说
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”。
而不是“传入一个变量如何转为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)
但还有一个小细节,除了这样赋值外还有什么好方法?
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文件名:
这代码本来以前是返回String的,现在改成byteFileName类型了,直接是字节数组,防止VB自作主张地转换.
剩下打开并读写之类的,这个好象你已经用CreateFileW搞定了,那就没啥问题了.
那先要找一个支持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
抽了几行有用的出来,其余的我删掉了。
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系列的函数的
其实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”
就那样,算了当我什么都没说
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”。
而不是“传入一个变量如何转为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)
但还有一个小细节,除了这样赋值外还有什么好方法?
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文件名:
这代码本来以前是返回String的,现在改成byteFileName类型了,直接是字节数组,防止VB自作主张地转换.
剩下打开并读写之类的,这个好象你已经用CreateFileW搞定了,那就没啥问题了.
那先要找一个支持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
抽了几行有用的出来,其余的我删掉了。
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数组.
你这么一改,难道是只需要加载一个么.
你这么一改,难道是只需要加载一个么.