怎么样用API复制文件显示进度？

Question

用API COPY文件怎么显示进度呢？
With filecopy
        .hwnd = Me.hwnd
        .wFunc = FO_COPY
        .......
        .fFlags = FOF_SIMPLEPROGRESS <------这里可以显示出系统的进度条
result = SHFileOperation(filecopy)
我现在不想用这个参数~用自己的进度条，用ProgressBar~~~
但总是无法边复制文件进度条边动~~
各位高手能请帮帮忙吧！
用TIMER~~我试过~~但COPY文件一大~50M的文件~~进度条就不动了~而且画面呆死~
用了doevent也没用~~谢谢！

Answer 1

'TextBox:
'Filepath
'Destinationpath'CommonDialog:
'Dialog'CommanButton:
'Browsefile
'Browsedestination
'Copy
'Cancel
Function CopyFile(Src As String, Dst As String) As Single
    Static Buf$
    Dim BTest!, FSize!
    Dim Chunk%, F1%, F2%    Const BUFSIZE = 1024    If Len(Dir(Dst)) Then
        Response = MsgBox(Dst + Chr(10) + Chr(10) + "File already exists. Do you want to overwrite it?", vbYesNo + vbQuestion)
        If Response = vbNo Then
            Exit Function
        Else
            Kill Dst
        End If
    End If
 
    On Error GoTo FileCopyError
    F1 = FreeFile
    Open Src For Binary As F1
    F2 = FreeFile
    Open Dst For Binary As F2
 
    FSize = LOF(F1)
    BTest = FSize - LOF(F2)    Do
        If BTest < BUFSIZE Then
            Chunk = BTest
        Else
            Chunk = BUFSIZE
        End If
      
        Buf = String(Chunk, " ")
        Get F1, , Buf
        Put F2, , Buf
        BTest = FSize - LOF(F2)        ProgressBar.Value = (100 - Int(100 * BTest / FSize))    Loop Until BTest = 0
    Close F1
    Close F2
    CopyFile = FSize
    ProgressBar.Value = 0
    Exit FunctionFileCopyError:
    MsgBox "Copy Error!, Please try again..."
    Close F1
    Close F2
    Exit Function
End FunctionPublic Function ExtractName(SpecIn As String) As String
    Dim i As Integer
    Dim SpecOut As String
   
    On Error Resume Next
    For i = Len(SpecIn) To 1 Step -1
        If Mid(SpecIn, i, 1) = "\" Then
            SpecOut = Mid(SpecIn, i + 1)
            Exit For
        End If
    Next
    ExtractName = SpecOut
End FunctionPrivate Sub Browsedestination_Click()
    Dim bi As BROWSEINFO
    Dim rtn&, pidl&, path$, pos%    bi.hOwner = Me.hWnd
    bi.lpszTitle = "Browse for Destination..."
    bi.ulFlags = BIF_RETURNONLYFSDIRS
    pidl& = SHBrowseForFolder(bi)
  
    path = Space(512)
    T = SHGetPathFromIDList(ByVal pidl&, ByVal path)    pos% = InStr(path$, Chr$(0))
    SpecIn = Left(path$, pos - 1)    If Right$(SpecIn, 1) = "\" Then
        SpecOut = SpecIn
    Else
        SpecOut = SpecIn + "\"
    End If    Destinationpath.Text = SpecOut + ExtractName(Filepath.Text)
End SubPrivate Sub Browsefile_Click()
    Dialog.DialogTitle = "Browse for source..."
    Dialog.ShowOpen
    Filepath.Text = Dialog.FileName
End SubPrivate Sub Cancel_Click()
    Unload Me
End SubPrivate Sub Copy_Click()
    On Error Resume Next
    If Filepath.Text = "" Then
        MsgBox "You must specify a file and path in the text box provided", vbCritical
        Exit Sub
    End If
    If Destinationpath.Text = "" Then
        MsgBox "You must specify a destination path in the text box provided", vbCritical
        Exit Sub
    End If
    ProgressBar.Value = CopyFile(Filepath.Text, Destinationpath.Text)
End SubPrivate Sub filepath_Change()
    Destinationpath.Enabled = True
    Browsedestination.Enabled = True
    Destinationpath.SetFocus
End SubPrivate Sub Form_Load()
    Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
End Sub
'模块Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
    "SHGetPathFromIDListA" (ByVal pidl As Long, _
    ByVal pszPath As String) As Long
Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
    (ByVal hwndOwner As Long, ByVal nFolder As Long, _
    pidl As ITEMIDLIST) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
    "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As LongType SHITEMID
     cb As Long
     abID As Byte
End TypeType ITEMIDLIST
     mkid As SHITEMID
End TypeType 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 TypePublic Const NOERROR = 0Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000

Answer 2

Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As LongPublic 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 Long
End Type
Public Const FO_COPY = &H2&

Answer 3

接上,call这个shfileoperation函数就行了

Answer 4

楼上那位~什么意思~我不明白~我问是的如何控制进度条
不是问怎么用API~~~~COPY~~~

Answer 5

可以是COPY一个文件，就加一点进度~
反正不能让进度条呆死~~可以吗？

Answer 6

那还不是可以用我的那个方法，我的是用shell api函数，直接有标准的系统文件复制窗口。
防呆死的话，在循环中加入doevents语句。

Answer 7

或者，你也可以使用findwindow系列函数找到shell 那个对话框中进度条的hwnd，然后setparent将进度条弄过来……仅供参考。

Answer 8

hNameMappings As Long
lpszProgressTitle As Long
请问这两个什么意思？怎么用？？？
我不知道这两个代表什么~

Answer 9

用 CopyFileEx
hNameMappings As Long
可以是一个文件名映射对象（不知道是不是这么翻译）的句柄。
其实就是一个指向包含 SHNAMEMAPPING 结构的数组的指针。lpszProgressTitle As Long
是包含系统的进度条的窗口的标题。

Answer 10

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form CopyFile 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "文件拷贝"
   ClientHeight    =   3135
   ClientLeft      =   1695
   ClientTop       =   1515
   ClientWidth     =   4830
   Icon            =   "Copy File.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   3135
   ScaleWidth      =   4830
   Begin VB.Frame Frame 
      Height          =   2895
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   4575
      Begin VB.CommandButton cmdCopy 
         Caption         =   "选择..."
         Enabled         =   0   'False
         Height          =   375
         Left            =   3480
         TabIndex        =   6
         Top             =   1080
         Width           =   975
      End
      Begin VB.TextBox txtDest 
         Enabled         =   0   'False
         Height          =   285
         Left            =   120
         TabIndex        =   5
         Top             =   1080
         Width           =   3255
      End
      Begin VB.CommandButton cmdFile 
         Caption         =   "选择..."
         Height          =   375
         Left            =   3480
         TabIndex        =   3
         Top             =   480
         Width           =   975
      End
      Begin VB.TextBox Filepath 
         Height          =   285
         Left            =   120
         TabIndex        =   2
         Top             =   480
         Width           =   3255
      End
      Begin VB.CommandButton Cancel 
         Caption         =   "退出"
         Height          =   375
         Left            =   3480
         TabIndex        =   10
         Top             =   2400
         Width           =   975
      End
      Begin VB.CommandButton Copy 
         Caption         =   "拷贝"
         Height          =   375
         Left            =   2400
         TabIndex        =   9
         Top             =   2400
         Width           =   975
      End
      Begin MSComDlg.CommonDialog Dialog 
         Left            =   0
         Top             =   2400
         _ExtentX        =   847
         _ExtentY        =   847
         _Version        =   393216
         Flags           =   6148
      End
      Begin ComctlLib.ProgressBar ProgressBar 
         Height          =   375
         Left            =   240
         TabIndex        =   8
         Top             =   1800
         Width           =   4095
         _ExtentX        =   7223
         _ExtentY        =   661
         _Version        =   327682
         Appearance      =   1
      End
      Begin VB.Label Destinationlabel 
         Caption         =   "目标文件:"
         Height          =   255
         Left            =   120
         TabIndex        =   4
         Top             =   840
         Width           =   855
      End
      Begin VB.Label Filelabel 
         Caption         =   "源文件:"
         Height          =   255
         Left            =   120
         TabIndex        =   1
         Top             =   240
         Width           =   1335
      End
      Begin VB.Label Percentlabel 
         Caption         =   "拷贝进度:"
         Height          =   255
         Left            =   240
         TabIndex        =   7
         Top             =   1545
         Width           =   1935
      End
   End
End
Attribute VB_Name = "CopyFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False'TextBox文本框:
'Filepath
'txtDest'CommonDialog控件:
'Dialog'CommanButton按钮:
'cmdFile
'cmdCopy
'Copy
'Cancel
Function CopyFile(Src As String, Dst As String) As Single
    Static strBuf As String
    Dim dBTest As Double, dFileSize As Double
    Dim iChunk As Integer, iFile1 As Integer, iFile2 As Integer    Const BUFSIZE = 1024    If Len(Dir(Dst)) Then
        Response = MsgBox(Dst + Chr(10) + Chr(10) + "文件已经存在，是否覆盖？", _
            vbYesNo + vbQuestion, Me.Caption)
        If Response = vbNo Then
            Exit Function
        Else
            Kill Dst
        End If
    End If
 
    On Error GoTo FileCopyError
    iFile1 = FreeFile
    Open Src For Binary As iFile1
    iFile2 = FreeFile
    Open Dst For Binary As iFile2
 
    dFileSize = LOF(iFile1)
    dBTest = dFileSize - LOF(iFile2)    Do
        If dBTest < BUFSIZE Then
            iChunk = dBTest
        Else
            iChunk = BUFSIZE
        End If
      
        strBuf = String(iChunk, " ")
        Get iFile1, , strBuf
        Put iFile2, , strBuf
        dBTest = dFileSize - LOF(iFile2)        ProgressBar.Value = (100 - Int(100 * dBTest / dFileSize))    Loop Until dBTest = 0
    
    Close iFile1
    Close iFile2
    CopyFile = dFileSize
    ProgressBar.Value = 0
    Exit FunctionFileCopyError:
    '这里:文件名过长也可能报错。
    MsgBox "拷贝出错！,请重新尝试..."
    Close iFile1
    Close iFile2
End FunctionPublic Function ExtractName(SpecIn As String) As String
    Dim i As Integer
    Dim SpecOut As String
   
    On Error Resume Next
    For i = Len(SpecIn) To 1 Step -1
        If Mid(SpecIn, i, 1) = "\" Then
            SpecOut = Mid(SpecIn, i + 1)
            Exit For
        End If
    Next
    ExtractName = SpecOut
End FunctionPrivate Sub cmdCopy_Click()
    Dim bi As BROWSEINFO
    Dim logPidl As Long
    Dim strPath As String
    Dim iPos As Integer    bi.hOwner = Me.hWnd
    bi.lpszTitle = "选择目标文件夹..."
    bi.ulFlags = BIF_RETURNONLYFSDIRS
    logPidl = SHBrowseForFolder(bi)
  
    strPath = Space(512)
    T = SHGetPathFromIDList(ByVal logPidl, ByVal strPath)    iPos = InStr(strPath, Chr$(0))
    SpecIn = Left(strPath, iPos - 1)    If Right$(SpecIn, 1) = "\" Then
        SpecOut = SpecIn
    Else
        SpecOut = SpecIn + "\"
    End If    txtDest.Text = SpecOut + ExtractName(Filepath.Text)
End SubPrivate Sub cmdFile_Click()
    Dialog.DialogTitle = "源文件..."
    Dialog.ShowOpen
    Filepath.Text = Dialog.FileName
End SubPrivate Sub Cancel_Click()
    Unload Me
End SubPrivate Sub Copy_Click()
    On Error Resume Next
    If Filepath.Text = "" Then
        MsgBox "你必须指定一个文件！", vbCritical, Me.Caption
        Exit Sub
    End If
    If txtDest.Text = "" Then
        MsgBox "你必须指定一个拷贝目录！", vbCritical, Me.Caption
        Exit Sub
    End If
    ProgressBar.Value = CopyFile(Filepath.Text, txtDest.Text)
End SubPrivate Sub filepath_Change()
    txtDest.Enabled = True
    cmdCopy.Enabled = True
    txtDest.SetFocus
End SubPrivate Sub Form_Load()
    Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
End Sub

Answer 11

Attribute VB_Name = "General"
'模块----------------------------------------------------------Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
    "SHGetPathFromIDListA" (ByVal pidl As Long, _
    ByVal pszPath As String) As Long
Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
    (ByVal hwndOwner As Long, ByVal nFolder As Long, _
    pidl As ITEMIDLIST) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
    "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As LongType SHITEMID
     cb As Long
     abID As Byte
End TypeType ITEMIDLIST
     mkid As SHITEMID
End TypeType 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 TypePublic Const NOERROR = 0Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000

Answer 12

to  sworddx(.:RNPA:. 剑宇潇湘·秋叶原)
[或者，你也可以使用findwindow系列函数找到shell 那个对话框中进度条的hwnd，然后setparent将进度条弄过来……仅供参考。]怎麼用setparent,能不能給個例子,謝謝!!!