Tippseite

VB-Homepage Tipp 079

Kopieren von Dateien mit Fortschrittsanzeige

Hier ein kleines aber feines VB4-Projekt mit einer Funktionalität, die Sie sich vielleicht schon immer mal gewünscht haben.
Es geht darum, Dateien zu kopieren.

Kein Problem mit dem VB Befehl FILECOPY .... werden Sie sagen, aber wie realisieren Sie eine Fortschrittsanzeige für das kopieren der Datei.
Mit diesem Tipp ist es eine einfache und feine Sache und Sie können bei Bedarf in der selben Funktion des Datei kopierens auch noch andere Aktionen ausführen.

Die Funktion unter
Allgemein/CopyFile

Function CopyFile(src As String, dst As String) As Single
Static Buf$
Dim BTest!, FSize!
Dim Chunk%, F1%, F2%

Const BUFSIZE = 1024

If Dir(src) = "" Then MsgBox "Datei nicht gefunden": Exit Function

Fehlerbehandlung = Right(dst, 1)
If Fehlerbehandlung = "\" Then GoTo FileCopyError

If Len(Dir(dst)) Then
If MsgBox(UCase(dst) & Chr(13) & Chr(10) & "Datei existiert schon!" & Chr(13) & "Soll überschrieben werden?", 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)

' Hiermit wird die Anzeige modifiziert
ProgressBar1.Value = (100 - Int(100 * BTest / FSize))
Loop Until BTest = 0

Close F1
Close F2
CopyFile = FSize

'Anzeige, um Beenden des Kopiervorgang anzuzeigen
MsgBox "Kopiervorgang abgeschlossen"

Exit Function

FileCopyError:
MsgBox "Fehlerhafte Angaben oder Dateizugriffsfehler" & Chr(13) & "Kopierabbruch"
Close F1
Close F2
Exit Function
End Function

Für einen Test benötigt die Form nun noch folgende Steuerelemente
natürlich eine ProgressBar als Fortschrittsanzeige und einen Commandbutton um die Aktion zu starten.

Der Commandbutton bekommt in der Aktion Click folgende Anweisungen
Quelle$ = "C:\Windows\Winfile.exe"
Ziel$ = "C:\Temp\dateimanager.exe"

Call CopyFile(Quelle$, Ziel$)

'setz Anzeige zurück
ProgressBar1.Value = 0

Tipp-Download

Quelle :