Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0321: Den Shell-Dialog zum Kopieren nutzen

VB 5/6-Tipp 0321: Den Shell-Dialog zum Kopieren nutzen

 von ActiveVB

Schwierigkeitsgrad:

Verwendete API-Aufrufe: SHFileOperationA (SHFileOperation)

Download: Download des Beispielprojektes [2,89 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Kontrollkästchen-Steuerelement "Check4"
' Steuerelement: Kontrollkästchen-Steuerelement "Check3"
' Steuerelement: Kontrollkästchen-Steuerelement "Check2"
' Steuerelement: Verzeichnisauswahlliste "Dir1"
' Steuerelement: Dateiauswahlliste "File1"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Kontrollkästchen-Steuerelement "Check1"

Option Explicit

Private Declare Function SHFileOperation Lib "shell32.dll" _
        Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) _
        As Long

Private Type SHFILEOPSTRUCT
  Hwnd As Long
  wFunc As Long
  pFrom As String
  pTo As String
  fFlags As Integer
  fAnyOperationsAborted As Boolean
  hNameMappings As Long
  lpszProgressTitle As String
End Type

Const FO_MOVE = &H1
Const FO_COPY = &H2
Const FO_DELETE = &H3
Const FO_RENAME = &H4

Const FOF_MULTIDESTFILES = &H1
Const FOF_CONFIRMMOUSE = &H2
Const FOF_SILENT = &H4
Const FOF_RENAMEONCOLLISION = &H8
Const FOF_NOCONFIRMATION = &H10
Const FOF_WANTMAPPINGHANDLE = &H20
Const FOF_ALLOWUNDO = &H40
Const FOF_FILESONLY = &H80
Const FOF_SIMPLEPROGRESS = &H100
Const FOF_NOCONFIRMMKDIR = &H200

Private Sub Form_Load()
  Call MakeFiles
End Sub

Private Sub Command1_Click()
  Dim Files$
  Dim SFO As SHFILEOPSTRUCT
    
    MousePointer = vbHourglass
    Command1.Enabled = False
    DoEvents

    Files = Files & App.Path & "\Test\*.*" & Chr$(0)
    Files = Files & Chr$(0)
       
    With SFO
      .Hwnd = Me.Hwnd
      .wFunc = FO_COPY
      .pFrom = Files
      .pTo = App.Path & "\Ziel" & Chr$(0)

      If Check1.Value = vbUnchecked Then .fFlags = FOF_FILESONLY
      
      If Check2.Value = vbChecked Then _
                        .fFlags = .fFlags Or FOF_SIMPLEPROGRESS
                        
      If Check3.Value = vbChecked Then _
                        .fFlags = .fFlags Or FOF_NOCONFIRMATION
                        
      If Check4.Value = vbChecked Then _
                        .fFlags = .fFlags Or FOF_SILENT

    End With

    Call SHFileOperation(SFO)
    File1.Refresh
    Dir1.Refresh
    
    If SFO.fAnyOperationsAborted Then
      Call MsgBox("Enige Operationen wurden nicht ausgeführt!")
    End If
    
    MousePointer = vbDefault
    Command1.Enabled = True
End Sub

Private Sub Command2_Click()
  Command1.Enabled = False
  Command2.Enabled = False
  MousePointer = vbHourglass
  DoEvents
  
  Call DelZiel
  
  MousePointer = vbDefault
  Command1.Enabled = True
  Command2.Enabled = True
End Sub

Private Sub MakeFiles()
  Dim x&, y&, FN%, aa$, bb$
    
    Command1.Enabled = False
    Command2.Enabled = False
    MousePointer = vbHourglass
    DoEvents
    
    If Dir$(App.Path & "\Ziel", vbDirectory) = "" Then
      MkDir App.Path & "\Ziel"
    End If
    
    'Ein paar Ordner und Dateien erstellen
    bb = App.Path & "\Test"
    If Dir$(bb, vbDirectory) = "" Then MkDir bb
    
    aa = String(1024, "x")
    For y = 0 To 500
      FN = FreeFile
      Open bb & "\File" & CStr(y) & ".txt" For Output As #FN
        Print #FN, aa
      Close FN
    Next y
    
    If Dir$(bb & "\Ordner1", vbDirectory) = "" Then
      MkDir bb & "\Ordner1"
    End If
    
    If Dir$(bb & "\Ordner1\Ordner2", vbDirectory) = "" Then
      MkDir bb & "\Ordner1\Ordner2"
    End If

    File1.Path = App.Path & "\Ziel"
    Dir1.Path = App.Path & "\Ziel"
    
    MousePointer = vbDefault
    Command1.Enabled = True
    Command2.Enabled = True
End Sub

Private Sub DelZiel()
  Dim SFO As SHFILEOPSTRUCT
  
    With SFO
      .Hwnd = Me.Hwnd
      .wFunc = FO_DELETE
      .pFrom = App.Path & "\Ziel\*.*" & Chr$(0) & Chr$(0)
      .pTo = "" & Chr$(0)
      .fFlags = .fFlags Or FOF_NOCONFIRMATION Or FOF_SILENT
    End With
    Call SHFileOperation(SFO)
    File1.Refresh
    Dir1.Refresh
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 5 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.