|
|
采用CopyFileEx這個(gè)API進(jìn)行文件復(fù)制時(shí)，為了能夠動(dòng)態(tài)的顯示文件的復(fù)制進(jìn)度百分比，用戶可以自定義回調(diào)函數(shù)，采用進(jìn)度條和標(biāo)簽來(lái)顯示復(fù)制進(jìn)度。這2個(gè)回調(diào)函數(shù)的格式如下：
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
其中，現(xiàn)有文件名lpExistingFileName，新建的文件名lpNewFileName。而lpProgressRoutine則是系統(tǒng)的回調(diào)函數(shù)指針。其定義如下：
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
可以看出這個(gè)回調(diào)函數(shù)的格式很復(fù)雜，好處是其中的大部分參數(shù)都是由Windows提供給用戶使用的，如TotalFileSize 為文件的大小, TotalBytesTransferred 為已經(jīng)傳送的大小，這樣用戶就可以計(jì)算出實(shí)際進(jìn)度，從而用控件在用戶界面中反映出來(lái)。
但是可以看出，這里面沒(méi)有給出文件名稱，而是給了源文件和目標(biāo)文件的文件句柄指針，不便在用戶控件中給出“正在復(fù)制xxx文件，進(jìn)度 25%”類似的信息，因此就涉及到了怎樣從文件句柄反查實(shí)際文件路徑的問(wèn)題。
從網(wǎng)上的開(kāi)發(fā)者的反饋來(lái)看，微軟并沒(méi)有直接提供能夠從文件句柄獲得文件名稱的開(kāi)發(fā)接口，只是在核心態(tài)的操作中，有一個(gè)NTQueryObject的函數(shù)，可以取得NT物理路徑名，即\DEVICE\HARDDISK0\Test\myfile.dat這樣的名稱。而如何將NT物理設(shè)備路徑與DOS路徑名對(duì)應(yīng)起來(lái)，只有再次采用QueryDosDevice這樣的函數(shù)，將系統(tǒng)中所有的可能驅(qū)動(dòng)器的NT物理設(shè)備路徑列舉出來(lái)進(jìn)行比對(duì)，將能夠匹配的設(shè)備進(jìn)行匹配替換，從而獲得Dos路徑。
因?yàn)镹TQueryObject函數(shù)屬于系統(tǒng)核心操作函數(shù)，需要有管理員權(quán)限才能運(yùn)行，因此這樣的做法并不很好用。但是目前未看到更好的做法，暫時(shí)這樣處理。
下面是具體的實(shí)現(xiàn)過(guò)程：
' 主要操作過(guò)程, hFile是要查找的文件句柄
Private Function GetFileNameFromHandle(ByVal hFile As Long) As String
Dim hFileMapping As Long, pMemMap As Long
'這個(gè)操作過(guò)程有點(diǎn)煩雜。因?yàn)镹TQueryObject屬于核心函數(shù)，而FileObject是NT系統(tǒng)的核心構(gòu)建，對(duì)其直接訪問(wèn)會(huì)導(dǎo)致系統(tǒng)不穩(wěn)定，死機(jī)的機(jī)會(huì)很大。因此只有建立要訪問(wèn)的對(duì)象的映像后，對(duì)映像進(jìn)行訪問(wèn)，確保安全性。
' hFileMapping，pMemeMap都是內(nèi)存映像句柄
Dim sFilename As String
Dim sa As SECURITY_Attributes '這是文件訪問(wèn)的安全屬性結(jié)構(gòu)，后面介紹
'對(duì)安全訪問(wèn)作初始設(shè)置，一般可以使用 ByVal 0&的方式提供Null指針，但是這里VB編譯器一直報(bào)告錯(cuò)誤，只好設(shè)置一個(gè)初始值后，直接提供給函數(shù)使用。
sa.bInheritHandle = 1
sa.lpSecurityDescriptor = 0
sa.nLength = Len(sa)
Const PAGE_READONLY = 2
Const MAX_PATH = 260
'創(chuàng)建映像文件
hFileMapping = CreateFileMapping(hFile, sa, PAGE_READONLY, 0&, 0&, vbNullString)
'創(chuàng)建內(nèi)存映像
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轉(zhuǎn)化為BSTR，VB String。如果是Unicode 字串，有必要調(diào)用 StrConv轉(zhuǎn)換。
sFilename = TrimNull(sFilename) '此處得到的是 \DEVICE\Harddisk0\Test\Testdat.dat
GetFileNameFromHandle = FindDosName(sFilename) '比對(duì)Dos路徑并替換
End Function
'將 NT 路徑替換為DOS設(shè)備路徑，邏輯盤符
' 此處是開(kāi)始創(chuàng)建了一個(gè)從 A-Z的NT路徑表 NTDriverNames(0 to 25)，全局變量
' 并使用 InitDosName 對(duì)其進(jìn)行初始化。
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 一次對(duì)應(yīng)每個(gè)設(shè)備的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設(shè)備名， 如C：
ret = QueryDosDeviceA(sC, sBuffer, 520) '查詢?cè)O(shè)備名
'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的轉(zhuǎn)換
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
'以可讀?可寫(xiě)方式打開(kāi)映射
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
'創(chuàng)建一個(gè)文件映射對(duì)象
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
|
|
