关于文件复制的问题

Question

Function CopyFile(Src As String, Dst As String) As SingleStatic Buf$
Dim BTest!, FSize! 'declare the needed variables
Dim Chunk%, F1%, F2%Const BUFSIZE = 1024 'set the buffer sizeIf Len(Dir(Dst)) Then 'check to see if the destination file already exists
             'otherwise
      Kill Dst      'delete the already found file, and carryon with the code
  
End If
 
On Error GoTo FileCopyError 'incase of error goto this label
F1 = FreeFile 'returns file number available
Open Src For Binary As F1 'open the source file
F2 = FreeFile 'returns file number available
Open Dst For Binary As F2 'open the destination file
 
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)ProcBar.value = (100 - Int(100 * BTest / FSize)) 'advance the progress bar as the file is copiedLoop Until BTest = 0
Close F1 'closes the source file
Close F2 'closes the destination file
CopyFile = FSize
ProcBar.value = 0 'returns the progress bar to zero
Exit Function 'exit the procedureFileCopyError: 'file copy error label
MsgBox "更新错误，请再试...." 'display message box with error
Close F1 'closes the source file
Close F2 'closes the destination file
Exit Function 'exit the procedureEnd Function
请大家指教，通过上述办法，我复制的文件大小没有问题，而且如果是文档也没问题，可是就是可执行程序，就不行了，复制完之后就不能执行了，实在搞不明白拉，请大家帮帮忙拉，另外还有别的办法么，比如API ，FILECOPY肯定不行的，我希望能返回个值好显示进度。

Answer 1

Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, _
    ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
    
Private Sub Command1_Click()CopyFile "a.exe", "c:\a.exe", 0End Sub

Answer 2

自动有进度条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 TypePrivate Declare Function SHFileOperation Lib _
        "shell32" _
        (lpFileOp As SHFILEOPSTRUCT) As LongConst FO_COPY = &H2
Const FO_DELETE = &H3
Const FO_MOVE = &H1
Const FO_RENAME = &H4
Const FOF_ALLOWUNDO = &H40
Const FOF_NOCONFIRMATION = &H10Private Sub Command1_Click()
    Dim xFile As SHFILEOPSTRUCT
        
    '复制
    xFile.pFrom = "c:\bbb\*.*"
    xFile.pTo = "c:\aaa"
    xFile.fFlags = FOF_NOCONFIRMATION
    xFile.wFunc = FO_COPY
    xFile.hwnd = Me.hwnd
    If SHFileOperation(xFile) Then
    End If
    
End Sub

Answer 3

Visual Basic 提供了过时的FileCopy语句.问题是使用该函数时并不显示文件复制对话框,也就是说,当拷贝一个大文件时,用户看不到Windows的标准 
文件复制对话框,无法从进度条上判断当前复制的进度.那么,如何做到这一点呢?请看下面: 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

Answer 4

http://www.sijiqing.com/vbgood/experience/index.asp?action=read&id=2357

Answer 5

用API
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long