Question

VB 复制文件有进度

设计一程序 要求：
共9个资源文件 资源文件编号（101.102.103........“CUSTOM"）（注：是自定义文件 后缀名.NPK）
有一个 “label” 一个名为 “浏览” 的按钮 一个 “确定” 按钮
点 浏览 弹出 “浏览文件夹” 对话框 选择 路径后
将 路径 显示在 LABEL 中 ，点 确定 将那9个资源文件复制到 label 显示的路径文件夹内 完成后弹出对话框 显示成功与失败

本人VB新手 不懂 求高人指点
程序代码能否解释一下是么意思？？
还有资源文件怎么调用？

Answer 1

懒的写具体代码了，大致思路说下：
1.获得源文件和目标文件夹的路径
2.在目标文件夹中创建一个空文件，和源文件同名
3.用FileLen函数获得源文件长度
4.用一个For循环，从0开始到源文件长度结束，从源文件读取一个Byte，然后将其立刻写入到目标文件，并用Cint（ i / 源文件长度 × 100）的公式计算百分比。

至于如何更新进度条，我个人倾向于用事件。
算了，还是写一个代码吧……

Public Event Progress(percent as integer) ‘这个要得是全局变量
Dim b as Byte

Private Sub Copy(path1 As String, Path2 as String)
'Path1是源文件路径，Path2是目标文件夹（不以“\”结尾！）

Open Path1 For Binary As #1
Open Path2 For Binary As #2

Dim _srcLen As Long
_srcLen = FileLen(#1)

For i = 0 to _srcLen
Get #1， i ， b
Put #2, i, b
RaiseEvent Progress(Int( i / _srcLen * 100))
Next i

End Sub

Private Sub Form1_Progress(percent As Integer)
'在这里刷新界面，percent变量里存储了进度
‘进度的范围是0～100
End Sub

Answer 2

Option Explicit

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pIdl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pIdl As Long, ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)

Private Type SHITEMID
cb As Long
abID() As Byte
End Type

Private Type ITEMIDLIST
mkid As SHITEMID
End Type

Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Const MAX_PATH = 260

Private Type SHFILEINFO
HIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type

Private Const ERROR_SUCCESS = &H0
Private Const SHGFI_PIDL = &H1
Private Const SHGFI_ICON = &H100
Private Const SHGFI_SMALLICON = &H1

Private Function GetPath() As String
Dim bi As BROWSEINFO
Dim IDL As ITEMIDLIST
Dim SHFI As SHFILEINFO
Dim nFolder As Long, pIdl As Long, sPath As String
Dim m_wCurOptIdx As Integer, txtPath As String ', txtDisplayName As String
Dim ret As Long
With bi
.hOwner = Me.hWnd

nFolder = GetFolderValue(m_wCurOptIdx)'确定资料夹类别，比如桌面...
'SHGetSpecialFolderLocation得到指定资料位置
If SHGetSpecialFolderLocation(ByVal Me.hWnd, ByVal nFolder, IDL) = ERROR_SUCCESS Then
.pidlRoot = IDL.mkid.cb
End If
.pszDisplayName = String$(MAX_PATH, 0)
.lpszTitle = "Select a folder"
.pszDisplayName = "d:\"
.ulFlags = 0
End With

pIdl = SHBrowseForFolder(bi)'显示浏览资料夹对话框,pIdl表示选取的资料夹标识
If pIdl = 0 Then Exit Function
sPath = String$(MAX_PATH, 0)
SHGetPathFromIDList ByVal pIdl, ByVal sPath'将资料夹标识转化为系统路径
txtPath = Left(sPath, InStr(sPath, vbNullChar) - 1)
CoTaskMemFree pIdl'释放内存
GetPath = txtPath
End Function

Private Function GetFolderValue(wIdx As Integer) As Long
'wIdx的值对应的含义，CSIDL_**可以声明为常数,在这里我未声明常数，直接使用数值。
' CSIDL_DESKTOP = &H0
' CSIDL_PROGRAMS = &H2
' CSIDL_CONTROLS = &H3
' CSIDL_PRINTERS = &H4
' CSIDL_PERSONAL = &H5
' CSIDL_FAVORITES = &H6
' CSIDL_STARTUP = &H7
' CSIDL_RECENT = &H8
' CSIDL_SENDTO = &H9
' CSIDL_BITBUCKET = &HA
' CSIDL_STARTMENU = &HB
' CSIDL_DESKTOPDIRECTORY = &H10
' CSIDL_DRIVES = &H11
' CSIDL_NETWORK = &H12
' CSIDL_NETHOOD = &H13
' CSIDL_FONTS = &H14
' CSIDL_TEMPLATES = &H15
If wIdx < 2 Then
GetFolderValue = 0
ElseIf wIdx < 12 Then
GetFolderValue = wIdx
Else
GetFolderValue = wIdx + 4
End If
End Function
'前面代码是用来开启Windows中浏览资料夹的对话框

'浏览按钮
Private Sub Command1_Click()
On Error Resume Next
Dim Str_Path As String

Str_Path = GetPath
Label1.Caption = IIf(Str_Path Like "*\", Str_Path, Str_Path & "\")
If Err.Number <> 0 Then MsgBox Err.Description, vbOKOnly + vbExclamation, LoadResString(128)
End Sub
'确定按钮
Private Sub Command2_Click()
On Error Resume Next
FileCopy SourceFilePathandFileName, TargetFilePathandFileName
'Exam:FileCopy "D:\101.NPK",Label1.Caption & "101.NPK"
'你自已写完即可
If Err.Number <> 0 Then MsgBox Err.Description: Err.Clear
End Sub