【VB开源代码栏目提醒】：网学会员在VB开源代码频道为大家收集整理了CopyFile.Frm提供大家参考，希望对大家有所帮助!

    VERSION 5.00
    Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
    Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
    Begin VB.Form CopyFile 
       BorderStyle     =   1  'Fixed Single
       Caption         =   "拷贝文件"
       ClientHeight    =   3135
       ClientLeft      =   1695
       ClientTop       =   1515
       ClientWidth     =   4830
       Icon            =   "CopyFile.frx":0000
       LinkTopic       =   "Form1"
       MaxButton       =   0   'False
       PaletteMode     =   1  'UseZOrder
       ScaleHeight     =   3135
       ScaleWidth      =   4830
       Begin MSComctlLib.ProgressBar copybar 
          Height          =   495
          Left            =   240
          TabIndex        =   6
          Top             =   1800
          Width           =   4335
          _ExtentX        =   7646
          _ExtentY        =   873
          _Version        =   393216
          Appearance      =   1
       End
       Begin VB.CommandButton Copy 
          Caption         =   "复制"
          Height          =   375
          Left            =   2520
          TabIndex        =   5
          Top             =   2400
          Width           =   975
       End
       Begin VB.CommandButton Command1 
          Caption         =   "退出"
          Height          =   375
          Left            =   3600
          TabIndex        =   4
          Top             =   2400
          Width           =   975
       End
       Begin VB.TextBox Filepath 
          Height          =   285
          Left            =   240
          TabIndex        =   3
          Top             =   480
          Width           =   3255
       End
       Begin VB.CommandButton Browsefile 
          Caption         =   "浏览"
          Height          =   375
          Left            =   3600
          TabIndex        =   2
          Top             =   480
          Width           =   975
       End
       Begin VB.TextBox Destinationpath 
          Enabled         =   0   'False
          Height          =   285
          Left            =   240
          TabIndex        =   1
          Top             =   1080
          Width           =   3255
       End
       Begin VB.CommandButton copytopath 
          Caption         =   "浏览"
          Enabled         =   0   'False
          Height          =   375
          Left            =   3600
          TabIndex        =   0
          Top             =   1080
          Width           =   975
       End
       Begin MSComDlg.CommonDialog Dialog 
          Left            =   360
          Top             =   2400
          _ExtentX        =   847
          _ExtentY        =   847
          _Version        =   393216
          Flags           =   6148
       End
       Begin VB.Label Label3 
          AutoSize        =   -1  'True
          Caption         =   "已完成"
          Height          =   180
          Left            =   360
          TabIndex        =   9
          Top             =   1545
          Width           =   540
       End
       Begin VB.Label Label1 
          AutoSize        =   -1  'True
          Caption         =   "源文件："
          Height          =   180
          Left            =   240
          TabIndex        =   8
          Top             =   240
          Width           =   720
       End
       Begin VB.Label Label2 
          AutoSize        =   -1  'True
          Caption         =   "复制到："
          Height          =   180
          Left            =   240
          TabIndex        =   7
          Top             =   840
          Width           =   720
       End
    End
    Attribute VB_Name = "CopyFile"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = False
    Attribute VB_PredeclaredId = True
    Attribute VB_Exposed = False
    Function CopyFile(Src As String, Dst As String) As Single
        Static Buf As String
        Dim needsize, Fizesize As Single
        Dim Chunk, i2, i1 As Integer
    
        Const BUFizesize = 1024
    
        If Len(Dir(Dst)) Then
            Response = MsgBox(Dst + Chr(10) + Chr(10) + "文件已存在，覆盖吗？", vbYesNo + vbQuestion) 'prompt the user with a message box
            If Response = vbNo Then
                Exit Function
            Else
                '如果文件存在，先删除文件
                Kill Dst
            End If
        End If
       ' On Error GoTo FileCopyError
        i1 = FreeFile
        Open Src For Binary As i1
        i2 = FreeFile
        Open Dst For Binary As i2
        
        Fizesize = LOF(i1)
        needsize = Fizesize - LOF(i2)
        Do
            If needsize < BUFizesize Then
                Chunk = needsize
            Else
                Chunk = BUFizesize
            End If
          
            Buf = String(Chunk, " ")
            Get i1, , Buf
            Put i2, , Buf
            needsize = Fizesize - LOF(i2)
            '显示copy进程
            copybar.Value = (100 - Int(100 * needsize / Fizesize))
    
        Loop Until needsize = 0
        Close i1
        Close i2
        CopyFile = Fizesize
        copybar.Value = 0
        Exit Function
    
    FileCopyError:
        MsgBox "拷贝没有完成"
        Close i1
        Close i2
        Exit Function
    
    End Function
    
    
    Public Function getpath(inpath As String) As String
       
        Dim i As Integer
        Dim outpath As String
       
        On Error Resume Next
       
        For i = Len(inpath) To 1 Step -1
            If Mid(inpath, i, 1) = "\" Then
                outpath = Mid(inpath, i + 1)
                Exit For
            End If
        Next i
    
        getpath = outpath
    
    End Function
    
    Private Sub copytopath_Click()
        Dim br As BROWSEINFO
        Dim hhh, ppp As Long
        Dim path As String
        Dim pos As Integer
    
        br.hOwner = Me.hWnd
        br.lpszTitle = "目标路径"
        br.ulFlags = brF_RETURNONLYFSDIRS
        ppp = SHBrowseForFolder(br)
      
        path = Space(512)
        T = SHGetPathFromIDList(ByVal ppp, ByVal path)
    
        pos = InStr(path, Chr$(0))
        inpath = Left(path, pos - 1)
    
        If Right$(inpath, 1) = "\" Then
            outpath = inpath
        Else
            outpath = inpath + "\"
        End If
        Destinationpath.Text = outpath + getpath(Filepath.Text)
    End Sub
    
    Private Sub Browsefile_Click()
        Dialog.DialogTitle = "源文件路径"
        Dialog.ShowOpen
        Filepath.Text = Dialog.FileName
    End Sub
    
    Private Sub Command1_Click()
        End
    End Sub
    
    Private Sub Copy_Click()
        On Error Resume Next
    
        If Filepath.Text =