如何对正在复制的文件实现进度条??
解决方案 »
- VB 怎么得到文件夹里所有的TXT文件的文件名?并保存在数组中?
- 求助!vb中combobox模拟qq用户名输入框
- 请一段简单的代码。。。实在不知道怎么写
- vb 如何获取任意一台电脑的用户名
- 求助自定义打印纸张的问题。
- 新手问题!!!!!麻烦帮一下忙!!
- 数据库关闭问题(问题解决就给分)
- 已经用treeview读出了几个Access表,如何实现TreeView1_NodeClick??
- 一个初学者的问题!!!很菜,在线等!!!!1
- 进行业务流程分析,用什么工具最好?
- 一个vb列表框数据变化的问题,很急!请帮忙。
- 请问,在vb6中如何调用MS-DOS命令,比如dir 0*.pdg,可得到这种文件0*.pdg的数量,但vb6就没有这样的功能,必须通过编程才能实现,不爽!
Dim BTest!, FSize!
Dim F1%, F2%
Dim sArray() As Byte
Dim buff As Integer
Const BUFSIZE = 1024
buff = 1024
F1 = FreeFile
Open Src For Binary As F1
F2 = FreeFile
Open Dst For Binary As F2
FSize = LOF(F1)
BTest = FSize - LOF(F2)
ReDim sArray(BUFSIZE) As Byte
Do
If BTest < BUFSIZE Then
buff = BTest
ReDim sArray(buff) As Byte
End If
Get F1, , sArray
Put F2, , sArray
BTest = FSize - LOF(F2)
If BTest < 0 Then
ProgressBar.Value = 100
Else
ProgressBar.Value = (100 - Int(100 * BTest / FSize))
End If
Loop Until BTest <= 0
Close F1
Close F2
CopyFile = FSize
End sub
文件复制对话框,无法从进度条上判断当前复制的进度.那么,如何做到这一点呢?请看下面: Public Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type Public Declare Function SHFileOperation Lib "shell32.dll" Alias
_
"SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Public Const FO_COPY = &H2
Public Const FOF_ALLOWUNDO = &H40 Public Sub ShellCopyFile(Source As String, Dest As String)
Dim result As Long
Dim fileop As SHFILEOPSTRUCT
With fileop
.hwnd = 0
.wFunc = FO_COPY
'The files to copy separated by Nulls and terminated by 2 nulls
.pFrom = Source & vbNullChar & vbNullChar
'or to copy all files use this line
'.pFrom = "C:\*.*" & vbNullChar & vbNullChar
'The directory or filename(s) to copy into terminated in 2 nulls
.pTo = Dest & vbNullChar & vbNullChar
.fFlags = FOF_ALLOWUNDO
End With
result = SHFileOperation(fileop)
If result <> 0 Then 'Operation failed
'Msgbox the error that occurred in the API.
MsgBox Err.LastDllError, vbCritical Or vbOKOnly
Else
If fileop.fAnyOperationsAborted <> 0 Then
MsgBox "Operation Failed", vbCritical Or vbOKOnly
End If
End If
End Sub 只需调用ShellCopyFile FileA, FileACopy
Private Sub Command1_Click()
Set shl = CreateObject("Shell.application")
Set fd = shl.NameSpace("d:\")
fd.CopyHere "c:\xxxxxx\要复制的文件"
End Sub