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
'Wiekszy BUFSIZE jest lepszy, ale nie przekraczajcie 64 KB (60000 jest ok)
'
'Wielkoc pliku jest zwracana w przypadku nie wystapienia bledow
'0 jest zwracane, gdy byly bledy
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
'UŻYCIE :
'ProgressBar1.Value = CopyFile (JAKI PLIK, GDZIE)
Komentarze
Aby dodać komentarz zaloguj się. Jeśli nie masz konta, załóż je sobie. Tylko zarejestrowani użytkownicy mogą pisać komentarze.
