How can I copy an open file using VB6?

问题:

I have a legacy VB6 application that uploads file attachments to a database BLOB field. It works fine unless a user has the file open.

I tried creating a copy of the file, then uploading that copy, but to my surprise, the FileCopy procedure gets a "permission denied" error whenever you try to copy a file that is open by the user.

This suprised me, because you can copy a file in Windows Explorer while it is open, and I was assuming that the FileCopy method used the same API call as explorer.

Anyway, my question is: How can I copy an open file in VB6?

回答1:

Answering my own question:

Based on this article, the answer that worked for me is described below.

1 - Add this declaration to the VB file:

Declare Function apiCopyFile Lib "kernel32" Alias "CopyFileA" _
      (ByVal lpExistingFileName As String, _
      ByVal lpNewFileName As String, _
      ByVal bFailIfExists As Long) As Long

2 - Create a little wrapper for that function, like so:

Sub CopyFileEvenIfOpen(SourceFile As String, DestFile As String)
  Dim Result As Long
   If Dir(SourceFile) = "" Then
     MsgBox Chr(34) & SourceFile & Chr(34) & " is not valid file name."
   Else
     Result = apiCopyFile(SourceFile, DestFile, False)
   End If
End Sub

3 - Replace my previous call to FileCopy with this:

CopyFileEvenIfOpen sourceFile, tempFile

回答2:

If you would like to do the same without using the api:

Function SharedFilecopy(ByVal SourcePath As String, ByVal DestinationPath As String)

Dim FF1 As Long, FF2 As Long
Dim Index As Long
Dim FileLength As Long
Dim LeftOver As Long
Dim NumBlocks As Long
Dim filedata As String
Dim ErrCount As Long
On Error GoTo ErrorCopy
'-------------
'Copy the file
'-------------
Const BlockSize = 32767
FF1 = FreeFile
Open SourcePath$ For Binary Access Read As #FF1
FF2 = FreeFile
Open DestinationPath For Output As #FF2
Close #FF2

Open DestinationPath For Binary As #FF2

Lock #FF1: Lock #FF2

FileLength = LOF(FF1)
NumBlocks = FileLength \ BlockSize
LeftOver = FileLength Mod BlockSize

filedata = String$(LeftOver, 32)

Get #FF1, , filedata
Put #FF2, , filedata
filedata = ""
filedata = String$(BlockSize, 32)

For Index = 1 To NumBlocks
    Get #FF1, , filedata
    Put #FF2, , filedata
Next Index
Unlock #FF1: Unlock #FF2
SharedFilecopy = True

exitcopy:

Close #FF1, #FF2

Exit Function

ErrorCopy: ErrCount = ErrCount + 1

If ErrCount > 2000 Then

SharedFilecopy = False

Resume exitcopy

Else

Resume

End If

End Function

回答3:

Shorter solution:

1- Project -> References. Check "Microsoft Scripting Runtime"

2- Use this:

Dim fso As New FileSystemObject 
fso.CopyFile file1, file2