Как я могу скопировать открытый файл с помощью VB6?

У меня есть устаревшее приложение VB6, которое загружает вложения файлов в BLOB-поле базы данных. Он отлично работает, если у пользователя нет открытого файла.

Я попытался создать копию файла, а затем загрузить эту копию, но, к моему удивлению, процедура FileCopy выдает ошибку «Отказано в разрешении» всякий раз, когда вы пытаетесь скопировать файл, открытый пользователем.

Это меня удивило, потому что вы можете скопировать файл в проводнике Windows, пока он открыт, и я предполагал, что метод FileCopy использует тот же вызов API, что и проводник.

В любом случае, мой вопрос: Как я могу скопировать открытый файл в VB6?


vb6
person JosephStyons    schedule 11.05.2009    source источник

Ответы (3)


arrow_upward
6
arrow_downward

Отвечая на свой вопрос:

На основании этой статьи ответ, который помог мне, описан ниже.

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
person JosephStyons    schedule 11.05.2009
comment
Мне нравится, когда эти маленькие подпрограммы-оболочки действуют как собственные подпрограммы VB6. Я бы вызвал ошибку, если исходный файл не существует, а не отобразил бы окно сообщения. Также я бы проверил, есть ли Результат ‹› 0 (который указывает, что копирование не удалось), и в этом случае тоже вызвал бы ошибку. - person MarkJ; 11.05.2009

arrow_upward
2
arrow_downward

Если вы хотите сделать то же самое без использования api:

Функция SharedFilecopy (ByVal SourcePath как строка, ByVal DestinationPath как строка)

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, то

SharedFilecopy = False

Resume exitcopy

Еще

Resume

Конец, если

Конечная функция

person Community    schedule 12.05.2009

arrow_upward
1
arrow_downward

Более короткое решение:

1- Проект -> Ссылки. Отметьте «Microsoft Scripting Runtime»

2- Используйте это:

Dim fso As New FileSystemObject 
fso.CopyFile file1, file2
person suuuzi    schedule 13.09.2013