VB-Homepage Tipp 136

Verzeichnisse inkl. Unterverz. und aller Dateien kopieren

Na klar kennen Sie FileCopy, mit dem man Dateien kopiert.
Was ich hier aber vorstellen will, ist ein VB-Projekt, das gesamte Verzeichnisse, inklusive aller Unterverzeichnisse und aller enthaltenen Dateien kopiert. So ne Art XCopy für VB.

Da hier alles ohne API abläuft, ist dies sowohl für 16 als auch 32Bit nutzbar.

dircopy.mak (16Bit) oder dircopy.vbp (32Bit)
DIRCOPY.FRM
ProjWinSize=152,402,248,215
ProjWinShow=2
IconForm="Form1"
Title="DIRCOPY"
ExeName="DIRCOPY.EXE"

dircopy.frm
VERSION 2.00
Begin Form Form1
BackColor = &H00E0E0E0&
Caption = "VB-Homepage Tipp"
ClientHeight = 5400
ClientLeft = 1545
ClientTop = 1620
ClientWidth = 6120
Height = 5805
Left = 1485
LinkTopic = "Form1"
ScaleHeight = 5400
ScaleWidth = 6120
Top = 1275
Width = 6240
Begin CommandButton Command1
Caption = ">>>> Kopieren >>>>"
Height = 255
Left = 1320
TabIndex = 4
Top = 4560
Width = 3135
End
Begin DriveListBox Drive2
Height = 315
Left = 3120
TabIndex = 3
Top = 600
Width = 2895
End
Begin DirListBox Dir2
Height = 3405
Left = 3120
TabIndex = 2
Top = 1080
Width = 2895
End
Begin DriveListBox Drive1
Height = 315
Left = 120
TabIndex = 1
Top = 600
Width = 2895
End
Begin DirListBox Dir1
Height = 3405
Left = 120
TabIndex = 0
Top = 1080
Width = 2895
End
Begin Label Label2
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "Kopieren gesamter Verzeichnisse, inklusive Unterverzeichnisse und aller Dateien."
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 120
TabIndex = 6
Top = 30
Width = 5895
End
Begin Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "Leider enthält dieses gute Projekt keine Angaben über den Autor, und ich weiß leider nicht mehr wo ich es gefunden habe."
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 120
TabIndex = 5
Top = 4870
Width = 5895
End
End
Option Explicit
Sub Command1_Click ()
Dim quell$, ziel$, zw$, i%, i1%
screen.MousePointer = 11
quell = CStr(dir1.Path)
If Len(quell) > 3 Then
For i = Len(quell) To 0 Step -1
If Mid(quell, i, 1) = "\" Then Exit For
i1 = i1 + 1
Next i
zw = zw & Mid(quell, Len(quell) - i1 + 1, i1)
End If
ziel = CStr(dir2.Path)
If Right(ziel, 1) <> "\" Then ziel = ziel & "\"
ziel = ziel & zw
If MsgBox("Möchten Sie '" & quell & "' nach '" & ziel & "' kopieren", 36, "Frage") = 6 Then
verzeichnis_kopieren quell, ziel
dir1.Refresh
dir2.Refresh
End If
screen.MousePointer = 0
End Sub
Sub copy_dir (von1$, nach1$)
On Error Resume Next
Dim Count%, D(), i%, dirname$, von$, nach$
von = von1
nach = nach1
If Right(von, 1) <> "\" Then von = von & "\"
If Right(nach, 1) <> "\" Then nach = nach & "\"
dirname = Dir(von & "*.*", 30)
Do While dirname <> ""
If dirname <> "." And dirname <> ".." Then
If ((GetAttr(von & dirname) And 16) = 16) Then ' Verzeichnis
MkDir nach & dirname
If (Count Mod 10) = 0 Then ReDim Preserve D(Count + 10)
Count = Count + 1
D(Count) = dirname
Else
DoEvents
FileCopy von & dirname, nach & dirname
End If
End If
dirname = Dir ' Weiteres Verzeichnis.
Loop
For i = 1 To Count
DoEvents
copy_dir von & D(i), nach & D(i)
Next i
End Sub
Sub Drive1_Change ()
dir1.Path = drive1.Drive
End Sub
Sub Drive2_Change ()
dir2.Path = drive2.Drive
End Sub
Sub Mk_Dir (bez1$)
On Error Resume Next
Dim verz$, bez$
bez = bez1
verz = Left(bez, 3)
bez = Right(bez, Len(bez) - 3)
If Right(bez, 1) <> "\" Then bez = bez & "\"
verz = verz & Mid(bez, 1, InStr(bez, "\") - 1)
bez = Right(bez, Len(bez) - InStr(bez, "\"))
While Right(verz, 1) <> "\"
MkDir verz
If bez <> "" Then
verz = verz & "\" + Mid(bez, 1, InStr(bez, "\") - 1)
Else
verz = verz & "\"
End If
bez = Right(bez, Len(bez) - InStr(bez, "\"))
Wend
Exit Sub
Err = 0
End Sub
Sub verzeichnis_kopieren (von$, nach$)
On Error Resume Next
MkDir nach
copy_dir von, nach
End Sub

Um den Code zu nutzen, erstellen Sie sich mit einem Editor (z.Bsp. Notepad) Dateien die Sie wie angegeben benennen und kopieren Sie den Code hinein. Speichern Sie Ihre Datei ab und öffnen Sie das Projekt entweder direkt aus einem Dateimanager oder öffnen Sie Ihre VB Software und laden sich das Projekt.

Tipp-Download

Quelle :

Zurück zur Übersichtsseite