1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73
| '**************************************************************
' DECLARATION SECTION
'**************************************************************
Option Explicit
'**************************************************************
' FUNCTION: CopyFile()
' PURPOSE:
' Facilitates copying a disk file.
' ARGUMENTS:
' Source - The path\filename of the file to copy from.
' Destination - The path\filename of the file to copy to.
' RETURN:
' The length of the file copied.
'**************************************************************
Function CopyFile (ByVal Source$, ByVal Destination$) As Long
Dim Index1 As Integer, NumBlocks As Integer
Dim FileLength As Long, LeftOver As Long, AmountCopied As Long
Dim SourceFile As Integer, DestFile As Integer
Dim FileData As String
Dim RetVal As Variant
Const BlockSize = 32768
On Error GoTo Err_CopyFile
' Remove the destination file.
DestFile = FreeFile
Open Destination For Output As DestFile
Close DestFile
' Open the source file to read from.
SourceFile = FreeFile
Open Source For Binary Access Read As FreeFile
' Open the destination file to write to.
DestFile = FreeFile
Open Destination For Binary As DestFile
' Get the length of the source file.
FileLength = LOF(SourceFile)
' Calculate the number of blocks in the file and left over.
NumBlocks = FileLength \ BlockSize
LeftOver = FileLength Mod BlockSize
' Create a buffer for the leftover amount.
FileData = String$(LeftOver, 32)
' Read and write the leftover amount.
Get SourceFile, , FileData
Put DestFile, , FileData
' Create a buffer for a block to be read.
FileData = String$(BlockSize, 32)
' Read and write the remaining blocks of data.
For Index1 = 1 To NumBlocks
' Read and write one block of data.
Get SourceFile, , FileData
Put DestFile, , FileData
Next Index1
Close SourceFile, DestFile
CopyFile = AmountCopied
Bye_CopyFile:
Exit Function
Err_CopyFile:
CopyFile = -1 * Err
Resume Bye_CopyFile
End Function |
Partager