|
|
采用CopyFileEx这个API进行文件复制时，为了能够动态的显示文件的复制进度百分比，用户可以自定义回调函数，采用进度条和标签来显示复制进度。这2个回调函数的格式如下：
Declare Function CopyFileEx Lib "kernel32.dll" Alias "CopyFileExA" (ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, ByVal lpProgressRoutine As Long, _
lpData As Any, ByRef pbCancel As Long, ByVal dwCopyFlags As Long) As Long
其中，现有文件名lpExistingFileName，新建的文件名lpNewFileName。而lpProgressRoutine则是系统的回调函数指针。其定义如下：
Public Function CopyProgressRoutine(ByVal TotalFileSize As Currency, ByVal TotalBytesTransferred As Currency, ByVal StreamSize As Currency, ByVal StreamBytesTransferred As Currency, _
ByVal dwStreamNumber As Long, ByVal dwCallbackReason As Long, _
ByVal hSourceFile As Long, ByVal hDestinationFile As Long, ByVal lpData As Long) As Long
可以看出这个回调函数的格式很复杂，好处是其中的大部分参数都是由Windows提供给用户使用的，如TotalFileSize 为文件的大小, TotalBytesTransferred 为已经传送的大小，这样用户就可以计算出实际进度，从而用控件在用户界面中反映出来。
但是可以看出，这里面没有给出文件名称，而是给了源文件和目标文件的文件句柄指针，不便在用户控件中给出“正在复制xxx文件，进度 25%”类似的信息，因此就涉及到了怎样从文件句柄反查实际文件路径的问题。
从网上的开发者的反馈来看，微软并没有直接提供能够从文件句柄获得文件名称的开发接口，只是在核心态的操作中，有一个NTQueryObject的函数，可以取得NT物理路径名，即\DEVICE\HARDDISK0\Test\myfile.dat这样的名称。而如何将NT物理设备路径与DOS路径名对应起来，只有再次采用QueryDosDevice这样的函数，将系统中所有的可能驱动器的NT物理设备路径列举出来进行比对，将能够匹配的设备进行匹配替换，从而获得Dos路径。
因为NTQueryObject函数属于系统核心操作函数，需要有管理员权限才能运行，因此这样的做法并不很好用。但是目前未看到更好的做法，暂时这样处理。
下面是具体的实现过程：
' 主要操作过程, hFile是要查找的文件句柄
Private Function GetFileNameFromHandle(ByVal hFile As Long) As String
Dim hFileMapping As Long, pMemMap As Long
'这个操作过程有点烦杂。因为NTQueryObject属于核心函数，而FileObject是NT系统的核心构建，对其直接访问会导致系统不稳定，死机的机会很大。因此只有建立要访问的对象的映像后，对映像进行访问，确保安全性。
' hFileMapping，pMemeMap都是内存映像句柄
Dim sFilename As String
Dim sa As SECURITY_Attributes '这是文件访问的安全属性结构，后面介绍
'对安全访问作初始设置，一般可以使用 ByVal 0&的方式提供Null指针，但是这里VB编译器一直报告错误，只好设置一个初始值后，直接提供给函数使用。
sa.bInheritHandle = 1
sa.lpSecurityDescriptor = 0
sa.nLength = Len(sa)
Const PAGE_READONLY = 2
Const MAX_PATH = 260
'创建映像文件
hFileMapping = CreateFileMapping(hFile, sa, PAGE_READONLY, 0&, 0&, vbNullString)
'创建内存映像
pMemMap = MapViewOfFile(hFileMapping, FILE_MAP_READ, 0&, 0&, 0&)
sFilename = String$(MAX_PATH, 0)
Call GetMappedFileName(GetCurrentProcess(), ByVal pMemMap, sFilename, MAX_PATH)
'获取Mapped文件名
'后面消除映像文件
Call UnmapViewOfFile(ByVal pMemMap)
Call CloseHandle(hFileMapping)
'将ASCIIZ转化为BSTR，VB String。如果是Unicode 字串，有必要调用 StrConv转换。
sFilename = TrimNull(sFilename) '此处得到的是 \DEVICE\Harddisk0\Test\Testdat.dat
GetFileNameFromHandle = FindDosName(sFilename) '比对Dos路径并替换
End Function
'将 NT 路径替换为DOS设备路径，逻辑盘符
' 此处是开始创建了一个从 A-Z的NT路径表 NTDriverNames(0 to 25)，全局变量
' 并使用 InitDosName 对其进行初始化。
Function FindDosName(lpNTDevice As String) As String
Dim i As Integer
Dim lpName As String
'Dim sC As String
Dim sBuffer As String * 520
Dim ret As Long
For i = 0 To 25
lpName = NTDriverNames(i)
If Len(lpName) > 0 Then
sBuffer = Mid(lpNTDevice, Len(lpName) + 1)
If Left(lpNTDevice, Len(lpName)) = lpName And Left(sBuffer, 1) = "\" Then
FindDosName = Chr(&H41 + i) & sBuffer
Exit For
End If
End If
Next
'If sC > "Z" Then FindDosName = vbNullString
End Function
'从 0 -25 一次对应每个设备的NTDriverName: \DEVICE\HARDDISKVOLUME7-->DOSName E:\
Sub InitDosName()
Dim i As Integer
Dim sC As String
Dim sBuffer As String * 520
Dim ret As Long
For i = 0 To 25
sBuffer = String$(520, 0)
sC = Chr(&H41 + i) & ":" '形成DOS设备名， 如C：
ret = QueryDosDeviceA(sC, sBuffer, 520) '查询设备名
'If ret = 0 Then
' MsgBox GetLastError
'End If
ret = InStr(sBuffer, Chr$(0))
NTDriverNames(i) = Trim(IIf(ret > 0, Left(sBuffer, ret - 1), sBuffer))
Next
End Sub
'完成 ASCIIZ 到 DOS String的转换
Private Function TrimNull(item As String) As String
Dim pos As Integer
pos = InStr(item, Chr$(0))
If pos Then
TrimNull = Left$(item, pos - 1)
Else
TrimNull = item
End If
End Function
' 前面的操作中所涉及到的 API 及 Types。
Type SECURITY_Attributes
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Const PAGE_READWRITE = 1
'以可读?可写方式打开映射
Const ERROR_ALREADY_EXISTS = 183
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const SECTION_MAP_READ As Long = &H4
Private Const FILE_MAP_READ As Long = SECTION_MAP_READ
Private Const FILE_SHARE_READ As Long = &H1
Private Const GENERIC_READ As Long = &H80000000
Private Const OPEN_EXISTING As Long = 3
Private Const PAGE_EXECUTE_READWRITE As Long = &H40
Private Const PAGE_READONLY As Long = &H2
Private Const SEC_IMAGE As Long = &H1000000
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Declare Function CreateFileMapping Lib "kernel32 " Alias "CreateFileMappingA" (ByVal hFile As Long, lpFileMappingAttributes As SECURITY_Attributes, ByVal flProtect As Long, ByVal dwMaximumSizeHigh As Long, ByVal dwMaximumSizeLow As Long, ByVal lpName As String) As Long
'创建一个文件映射对象
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetMappedFileName Lib "psapi" Alias "GetMappedFileNameA" (ByVal hProcess As Long, lpv As Any, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Declare Function QueryDosDevice Lib "kernel32" Alias "QueryDosDeviceA" (ByVal lpDeviceName As String, ByVal lpTargetPath As String, ByVal ucchMax As Long) As Long
Private Declare Function MapViewOfFile Lib "kernel32.dll" (ByVal hFileMappingObject As Long, ByVal dwDesiredAccess As Long, ByVal dwFileOffsetHigh As Long, ByVal dwFileOffsetLow As Long, ByVal dwNumberOfBytesToMap As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function UnmapViewOfFile Lib "kernel32.dll" (ByRef lpBaseAddress As Any) As Long
|
|
QQ好友和群
QQ空间
腾讯微博
腾讯朋友
收藏
淘帖
顶
踩
