Tipp 0491 Dateien in den Papierkorb verschieben
Autor/Einsender:
Datum:
  Detlev Schubert
19.04.2006
Entwicklungsumgebung:   VB 6
Um in Visual Basic Dateien zu löschen, wird in der Regel die dafür vorgesehene Funktion Kill verwendet. Damit sind Dateien jedoch unwiederbringlich gelöscht, und landen nicht im Windows-Papierkorb. Somit ist es also nicht möglich, eine versehentlich gelöschte Datei über den Papierkorb wiederherzustellen.
Damit die eigene Anwendung, wie u.a. auch der Windows-Explorer, Dateien in den Papierkorb löschen kann, müssen wir in die API-Trickkiste greifen. Mit der Allround-Funktion SHFileOperation für Dateioperationen und dem Struktur-Parameter FO_DELETE ist dies recht schnell erledigt. Allerdings erwartet die Funktion, wie fast alle API-Funktion einen NULL-terminierten String, und daher müssen wir die VB-Daten erst entsprechend aufbereiten. Dies wird von der Funktion DeleteInTrash übernommen, der wir im Beispiel ein entsprechendes Datenfeld mit den zu löschenden Dateien übergeben.
Code im Modul
Die Funktion DeleteInTrash im Tipp wurde so aufgebaut, dass lediglich durch den Austausch einiger weniger Parameter Dateien nicht gelöscht sondern auch "Explorer-Like" kopiert und/oder verschoben werden können. Die dafür benötigten Konstanten sind im Download-Beispiel enthalten.
 
Option Explicit

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

Private Const FO_DELETE As Long = &H3&

Private Const FOF_SILENT As Long = &H4&
Private Const FOF_NOCONFIRMATION As Long = &H10&
Private Const FOF_ALLOWUNDO As Long = &H40&

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

Public Function DeleteInTrash(vFiles As Variant, Optional hHandle _
      As Long, Optional bFrage As Boolean, Optional bShowProgress _
      As Boolean) As Boolean

  Dim FileOp As SHFILEOPSTRUCT
  Dim intI As Integer

  With FileOp
    If IsArray(vFiles) Then
      For intI = LBound(vFiles) To UBound(vFiles)
        .pFrom = .pFrom & vFiles(intI) & vbNullChar
      Next
      .pFrom = .pFrom & vbNullChar
    ElseIf VarType(vFiles) = vbObject Then
      If TypeOf vFiles Is Collection Then
        For intI = 1 To vFiles.Count
          .pFrom = .pFrom & vFiles(intI) & vbNullChar
        Next
        .pFrom = .pFrom & vbNullChar
      End If
    ElseIf VarType(vFiles) = vbString Then
      .pFrom = vFiles
      If Right$(.pFrom, 1) <> vbNullChar Then
        .pFrom = .pFrom & vbNullChar
      End If
      If Mid$(.pFrom, Len(.pFrom) - 1, 1) <> vbNullChar Then
        .pFrom = .pFrom & vbNullChar
      End If
    End If

    .hwnd = hHandle
    .wFunc = FO_DELETE
    .fFlags = FOF_ALLOWUNDO

    If Not bShowProgress Then .fFlags = .fFlags Or FOF_SILENT
    If Not bFrage Then .fFlags = .fFlags Or FOF_NOCONFIRMATION

    DeleteInTrash = Not CBool(SHFileOperation(FileOp) Or _
          .fAnyOperationsAborted)
  End With
End Function
 
Code im Codebereich der Form
 
Option Explicit

Dim sFiles As String

Private Sub Command1_Click()
  Dim aFiles() As String
  Dim Abfrage As Boolean

  Abfrage = IIf(Option1.Value = True, True, False)

  aFiles = Split(sFiles, ";")

  If DeleteInTrash(aFiles, Me.hwnd, Abfrage, True) Then
    MsgBox "Alle markierten Dateien wurden in den Papierkorb " & _
           "gelöscht.", vbOKOnly
    Label1.Caption = "0"
  Else
    MsgBox "Beim Löschen ist ein Fehler aufgetreten.", vbOKOnly
  End If
  File1.Refresh
End Sub

Private Sub File1_Click()
  Dim intI As Integer
  Dim intJ As Integer

  sFiles = ""
  For intI = 0 To File1.ListCount - 1
    If File1.Selected(intI) = True Then
      sFiles = sFiles & ApplicationPath & File1.List(intI) & ";"
      Command1.Enabled = True
      intJ = intJ + 1
      Label1.Caption = Trim$(Str$(intJ))
    End If
  Next
  If intI < 1 Then Command1.Enabled = False
End Sub

Private Function ApplicationPath() As String
  ApplicationPath = App.Path & _
        IIf(Right(App.Path, 1) = "\", "", "\")
End Function
 
Hinweis
Die Funktion SHFileOperation steht bei den Betriebssystemen Windows 95 und NT erst zur Verfügung, wenn der Internet-Explorer ab Version 4.0 installiert ist.

Windows-Version
95
98
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (5,8 kB) Downloads bisher: [ 662 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Mittwoch, 31. August 2011