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 :