Function CopyFile (src As String, dst As String) As Single
'L. Serflaten 1996
Static Buf$
Dim BTest!, FSize!
Dim Chunk%, F1%, F2%
Const BUFSIZE = 1024
'This routine will copy a file while providing a means
'to support a percent gauge. Ex. your display routine
'is called "PercentDone" and accepts the values 0-100.
'Error support is provided.
'
'A larger BUFSIZE is best, but do not attempt to exceed
'64 K (60000 would be fine)
'
'The size of the copied file is returned on success
'0 is returned on failure
If Dir(src) = "" Then MsgBox "File not found": Exit Function
If Len(Dir(dst)) Then
If MsgBox(UCase(dst) & Chr(13) & Chr(10) & "File exists. Overwrite?", 4) <> 6 Then Exit Function
Kill dst
End If
On Error GoTo FileCopyError
F1 = FreeFile
Open src For Binary As F1
F2 = FreeFile
Open dst For Binary As F2
FSize = LOF(F1)
BTest = FSize - LOF(F2)
Do
If BTest < BUFSIZE Then
Chunk = BTest
Else
Chunk = BUFSIZE
End If
Buf = String(Chunk, " ")
Get F1, , Buf
Put F2, , Buf
BTest = FSize - LOF(F2)
' __Call percent display here__
'PercentDone ( 100 - Int(100 * BTest/FSize) )
Loop Until BTest = 0
Close F1
Close F2
CopyFile = FSize
Exit Function
FileCopyError:
MsgBox "Copy Error!"
Close F1
Close F2
Exit Function
End Function
'Önce formunuza bir ProgressBar kontrolü ekleyip ardından
'aşağıdaki kodu kullanarak dosya kopyalayabilirsiniz.
'ProgressBar1.Value = CopyFile (Which_File*, To_Where**)
'* = Kopyalanacak dosya
'** = Kopyalanacağı yer