How to copy an open file using VB6?

Question

I have an outdated VB6 application that uploads file attachments to a database BLOB field. It works fine if the user does not have a file.

I tried to create a copy of the file and then download this copy, but, to my surprise, when I try to copy a file opened by the user, the FileCopy procedure receives an access permission error.

This surprised me because you could copy a file in Windows Explorer when it is open, and I assumed that the FileCopy method used the same API call as Explorer.

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

Answer 1

Answering my own question:

, , .

1 - VB:

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

2 - , :

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 - FileCopy :

CopyFileEvenIfOpen sourceFile, tempFile

Answer 2

, api:

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

ErrorCopy: ErrCount = ErrCount + 1

ErrCount > 2000 Then

SharedFilecopy = False

Resume exitcopy

Else

Resume

Answer 3

:

1- → . " Microsoft"

2- :

Dim fso As New FileSystemObject 
fso.CopyFile file1, file2