复制文件夹时，如何控制进度条？(vb)
复制文件夹时，如何控制进度条？(vb) 问题点数：0、回复次数：3Top
1 楼kissoflife（明月高楼休独倚，酒入愁肠，化作相思泪！）回复于 2003-08-02 13:15:25 得分 0
难，帮你顶一下Top
2 楼ch21st（www.blanksoft.com）回复于 2003-08-05 09:40:04 得分 0
你想或得实际进度百分比得数据还是进度条
如果想得到进度条可以调用系统复制文件时得进度条
如果想活的具体进度(数据),你还不如自己编写一个复制文件函数
一.
果你是使用Win9x/NT的话，你可以使用API函数SHFileOperation，这个函数可以同时拷
贝、删除、改名或移动多个文件，甚至整个目录。如果你愿意，还可以显示相应的动画
对话框，功能十分强大。SHFileOperation的参数是一个SHFILEOPSSTRUCT结构。这个结
构中各成员的含义如下：
- hwnd - 显示文件操作对话框的窗口句柄
- wFunc - 表示要进行的操作，可以取以下值：
- FO_COPY - 拷贝文件。所要拷贝的文件由pFrom成员指定，目的地址有pTo成员
指定。
- FO_DELETE - 删除pFrom指定的文件。(pTo 被忽略。)
- FO_MOVE - 移动文件。所要移动的文件由pFrom成员指定，目的地址有pTo成员
指定。
- FO_RENAME - 改名pFrom指定的文件。
- pFrom - 指定文件名的缓冲区的地址。必须以Chr(0)结尾。如果包括多个文件
以Chr(0)分割。
- pTo - 指定目的文件名或目录的缓冲区的地址。必须以Chr(0)结尾。如果使用
了FOF_MULTIDESTFILES标志，可以包括多个文件名，文件名之间以Chr(0)分割。
- fFlags - 标志：
- FOF_ALLOWUNDO - 允许恢复
- FOF_FILESONLY - 如果使用了*.*，只操作文件。
- FOF_MULTIDESTFILES - pTo成员可以为多个目的文件。
- FOF_NOCONFIRMATION - 不显示确认对话框。
- FOF_NOCONFIRMMKDIR - 不确认是否建立目录。
- FOF_NOERRORUI - 如果有错误，不显示用户界面。
- FOF_RENAMEONCOLLISION - 如果目的文件已经存在，给要处理的文件一个新名
字。
- FOF_SILENT - 不显示进度对话框。
- FOF_SIMPLEPROGRESS - 显示进度框，但不显示文件名。
- fAnyOperationsAborted -如果用户退出，该成员为TRUE，否则为FALSE。
- lpszProgressTitle - 进度框的标题，只有选择了FOF_SIMPLEPROGRESS标志才
有效。
下面是一个例子显示如何拷贝文件：
--------------------
1. 在Visual Basic中启动一个新的EXE工程，其中包括Form1。
2. 添加两个检查框和一个按钮在Form1上。
3. 加入以下代码到Form1的代码窗口:
Option Explicit
Private Const FO_COPY = &H2& 'Copies the files specified
'in the pFrom member to the
'location specified in the
'pTo member.
Private Const FO_DELETE = &H3& 'Deletes the files specified
'in pFrom (pTo is ignored.)
Private Const FO_MOVE = &H1& 'Moves the files specified
'in pFrom to the location
'specified in pTo.
Private Const FO_RENAME = &H4& 'Renames the files
'specified in pFrom.
Private Const FOF_ALLOWUNDO = &H40& 'Preserve Undo information.
Private Const FOF_CONFIRMMOUSE = &H2& 'Not currently implemented.
Private Const FOF_CREATEPROGRESSDLG = &H0& 'handle to the parent
'window for the
'progress dialog box.
Private Const FOF_FILESONLY = &H80& 'Perform the operation
'on files only if a
'wildcard file name
'(*.*) is specified.
Private Const FOF_MULTIDESTFILES = &H1& 'The pTo member
'specifies multiple
'destination files (one
'for each source file)
'rather than one
'directory where all
'source files are
'to be deposited.
Private Const FOF_NOCONFIRMATION = &H10& 'Respond with Yes to
'All for any dialog box
'that is displayed.
Private Const FOF_NOCONFIRMMKDIR = &H200& 'Does not confirm the
'creation of a new
'directory if the
'operation requires one
'to be created.
Private Const FOF_RENAMEONCOLLISION = &H8& 'Give the file being
'operated on a new name
'in a move, copy, or
'rename operation if a
'file with the target
'name already exists.
Private Const FOF_SILENT = &H4& 'Does not display a
'progress dialog box.
Private Const FOF_SIMPLEPROGRESS = &H100& 'Displays a progress
'dialog box but does
'not show the
'file names.
Private Const FOF_WANTMAPPINGHANDLE = &H20&
'If FOF_RENAMEONCOLLISION is specified,
'the hNameMappings member will be filled
'in if any files were renamed.
' The SHFILOPSTRUCT is not double-word aligned. If no steps are
' taken, the last 3 variables will not be passed correctly. This
' has no impact unless the progress title needs to be changed.
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String
End Type
Private Declare Sub CopyMemory Lib "KERNEL32" _
Alias "RtlMoveMemory" _
(hpvDest As Any, _
hpvSource As Any, _
ByVal cbCopy As Long)
Private Declare Function SHFileOperation Lib "Shell32.dll" _
Alias "SHFileOperationA" _
(lpFileOp As Any) As Long
Private Sub Form_Load()
Check1.Caption = "Copy All Files in VB Directory"
Check2.Caption = "Display Custom Message"
Command1.Caption = "Copy Files"
End Sub
Private Sub Command1_Click()
Dim result As Long
Dim lenFileop As Long
Dim foBuf() As Byte
Dim fileop As SHFILEOPSTRUCT
lenFileop = LenB(fileop) ' double word alignment increase
ReDim foBuf(1 To lenFileop) ' the size of the structure.
With fileop
.hwnd = Me.hwnd
.wFunc = FO_COPY
' The files to copy separated by Nulls and terminated by two
' nulls
If Check1.Value = vbChecked Then
.pFrom = Environ("windir") & "\*.exe"
.fFlags = FOF_SIMPLEPROGRESS Or FOF_FILESONLY
Else
.pFrom = Environ("windir") & "\Explorer.exe" _
& vbNullChar _
& Environ("windir") & "\WinHelp.exe" _
& vbNullChar _
& vbNullChar
End If
.pTo = "C:\testfolder\" & vbNullChar & vbNullChar
If Check2.Value = vbChecked Then
.fFlags = FOF_SIMPLEPROGRESS Or FOF_NOCONFIRMATION Or _
FOF_NOCONFIRMMKDIR
.lpszProgressTitle = "Your custom dialog string " & _
"appears here." & vbNullChar _
& vbNullChar
End If
End With
' Now we need to copy the structure into a byte array
Call CopyMemory(foBuf(1), fileop, lenFileop)
' Next we move the last 12 bytes by 2 to byte align the data
Call CopyMemory(foBuf(19), foBuf(21), 12)
result = SHFileOperation(foBuf(1))
If result <> 0 Then ' Operation failed
MsgBox Err.LastDllError 'Show the error returned from
'the API.
Else
If fileop.fAnyOperationsAborted <> 0 Then
MsgBox "Operation Failed"
End If
End If
End Sub
Top
3 楼ch21st（www.blanksoft.com）回复于 2003-08-05 09:40:44 得分 0
二.自己编写得复制文件函数
Private Sub xFileCopy(ByVal i_strSource As String, ByVal i_strTarget As
String, Optional i_objProgress As Object)
' Existence Test
If Dir(i_strSource) = "" Then
MsgBox "Please Provide A Source File"
Exit Sub
End If
If Dir(i_strTarget) <> "" Then
If vbNo = MsgBox("Target File Exists - Delete ?", vbYesNo) Then
MsgBox "Copy Cancelled"
Exit Sub
Else
Kill i_strTarget
End If
End If
' Initialize
Const CHUNK_SIZE = 100000
' Setup Error Trapping
On Error Resume Next
' Open Source File
Dim intFreeGet As Integer: intFreeGet = FreeFile
Open i_strSource For Binary Shared As intFreeGet
If Err.Number <> 0 Then GoTo Tag910_Error_Source_Open
' Open Target File
Dim intFreePut As Integer: intFreePut = FreeFile
Open i_strTarget For Binary As intFreePut
If Err.Number <> 0 Then GoTo Tag930_Error_Target_Open
' Store File Length
Dim lngFileSize As Long: lngFileSize = LOF(intFreeGet)
' Initialize Progress bar
Dim booProgress As Boolean
If Not IsMissing(i_objProgress) Then booProgress = True
If booProgress Then
With i_objProgress
.Min = 0
.Max = 100
End With
End If
' Process File
Dim bytBuffer() As Byte
Dim lngFileRead As Long: lngFileRead = 1
Do Until lngFileRead > lngFileSize
If (lngFileSize - lngFileRead) >= CHUNK_SIZE Then
ReDim bytBuffer(CHUNK_SIZE - 1)
Else
ReDim bytBuffer(lngFileSize - lngFileRead)
End If
Get intFreeGet, lngFileRead, bytBuffer()
If Err.Number <> 0 Then GoTo Tag920_Error_Source_Get
Put intFreePut, lngFileRead, bytBuffer()
If Err.Number <> 0 Then GoTo Tag940_Error_Target_Put
lngFileRead = lngFileRead + UBound(bytBuffer) + 1
If booProgress Then
If i_objProgress.Value <> 100 * (lngFileRead - 1) / lngFileSize
Then
i_objProgress.Value = 100 * (lngFileRead - 1) / lngFileSize
DoEvents
End If
End If
Loop
On Error GoTo 0
GoTo Tag990
' Error Processing
Tag910_Error_Source_Open:
MsgBox "Error Opening File " & i_strSource
GoTo Tag990
Tag920_Error_Source_Get:
MsgBox "Error Reading File " & i_strSource
GoTo Tag990
Tag930_Error_Target_Open:
MsgBox "Error Opening File " & i_strTarget
GoTo Tag990
Tag940_Error_Target_Put:
MsgBox "Error Writing File " & i_strTarget
GoTo Tag990
Tag990:
Close intFreeGet
Close intFreePut
End Sub
Top
