Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0322: Den Shell-Dialog zum Verschieben nutzen

VB 5/6-Tipp 0322: Den Shell-Dialog zum Verschieben nutzen

 von ActiveVB

Schwierigkeitsgrad:

Verwendete API-Aufrufe: SHFileOperationA (SHFileOperation)

Download: Download des Beispielprojektes [3,09 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: Dateiauswahlliste "File2"
' Steuerelement: Verzeichnisauswahlliste "Dir2"
' Steuerelement: Schaltfläche "Command3"
' 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"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"

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
    ButtonEnable (False)
    DoEvents

    Files = Files & App.Path & "\Test\*.*" & Chr$(0)
    Files = Files & Chr$(0)
       
    With SFO
      .Hwnd = Me.Hwnd
      .wFunc = FO_MOVE
      .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
    File2.Refresh
    Dir2.Refresh
    
    If SFO.fAnyOperationsAborted Then
      Call MsgBox("Enige Operationen wurden nicht ausgeführt!")
    End If
   
    MousePointer = vbDefault
    ButtonEnable (True)
End Sub

Private Sub Command2_Click()
  ButtonEnable (False)
  MousePointer = vbHourglass
  DoEvents
  
  Call DelZiel
  
  MousePointer = vbDefault
  ButtonEnable (True)
End Sub

Private Sub Command3_Click()
  Call MakeFiles
End Sub

Private Sub MakeFiles()
  Dim x&, y&, FN%, aa$, bb$
    
    ButtonEnable (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"
    
    File2.Path = App.Path & "\Test"
    Dir2.Path = App.Path & "\Test"
    File2.Refresh
    Dir2.Refresh
    
    MousePointer = vbDefault
    ButtonEnable (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

Private Sub ButtonEnable(Mode As Boolean)
  Command1.Enabled = Mode
  Command2.Enabled = Mode
  Command3.Enabled = Mode
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------