|
|
采用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
|
|
