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

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

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

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

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

источник

2009-05-11 JosephStyons

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

Based on this article, ответ, который работал для меня описан ниже.

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

источник

2009-05-11 13:33:07 JosephStyons

Я хотел бы сделать эти маленькие обертки подпрограммы действуют как родные процедуры VB6. Я бы поднял ошибку, если исходный файл не существует, а не отображает окно сообщения. Также я бы проверил, будет ли Result <> 0 (что указывает на то, что копия не удалась) и в этом случае также вызывает ошибку. – MarkJ

Будет ли он работать для файла SAM для Windows?)) – Searush

Если вы хотели бы сделать то же самое без использования 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, то

SharedFilecopy = False 

Resume exitcopy

Else

Resume

End If

End Function

источник

2009-05-12 23:24:55

Шортер решение:

1- Project -> References. Проверка «Microsoft Scripting Runtime»

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

Dim fso As New FileSystemObject 
fso.CopyFile file1, file2

источник

2013-09-13 22:07:56 suuuzi

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

ответ

Смежные вопросы