Comment copier un fichier ouvert en utilisant VB6?

Question

J'ai une application VB6 héritée qui télécharge des pièces jointes à un champ BLOB de base de données. Cela fonctionne correctement, sauf si un utilisateur a le fichier ouvert.

J'ai essayé de créer une copie du fichier, puis de télécharger cette copie, mais à ma grande surprise, la procédure FileCopy reçoit une erreur «permission denied» chaque fois que vous essayez de copier un fichier ouvert par l'utilisateur. Cela m'a surpris, car vous pouvez copier un fichier dans l'Explorateur Windows alors qu'il est ouvert, et je supposais que la méthode FileCopy utilisait le même appel API que l'explorateur.

Quoi qu'il en soit, ma question est: Comment puis-je copier un fichier ouvert dans VB6?

Answer 1

répondre à ma propre question:

Based on this article, la réponse qui a fonctionné pour moi est décrit ci-dessous.

1 - Ajouter cette déclaration au fichier VB:

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

2 - Créer une petite enveloppe pour cette fonction, comme suit:

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 - Remplacer mon précédent appel à FileCopy avec ceci:

CopyFileEvenIfOpen sourceFile, tempFile 

Answer 2

Si vous voulez faire la même chose sans utiliser l'api:

Fonction 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

Si ErrCount> 2000 Puis

SharedFilecopy = False 

Resume exitcopy 

Else

Resume 

End If

End Function

Answer 3

solution Shorter:

1- Projet -> Références. Cochez la case "Microsoft Scripting Runtime"

2- Utilisez ceci:

Dim fso As New FileSystemObject 
fso.CopyFile file1, file2