删除文件到回收站.frm

个人VB学习源码精选,自己学习时的一些编程小程序,希望对大家有帮助

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1 
      Caption         =   "删除"
      Height          =   285
      Left            =   3015
      TabIndex        =   3
      Top             =   2745
      Width           =   1050
   End
   Begin VB.FileListBox File1 
      Height          =   2430
      Left            =   2655
      MultiSelect     =   2  'Extended
      TabIndex        =   2
      Top             =   135
      Width           =   1950
   End
   Begin VB.DirListBox Dir1 
      Height          =   1980
      Left            =   45
      TabIndex        =   1
      Top             =   585
      Width           =   2490
   End
   Begin VB.DriveListBox Drive1 
      Height          =   300
      Left            =   45
      TabIndex        =   0
      Top             =   135
      Width           =   2535
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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 Long
        hNameMappings As Long
        lpszProgressTitle As String '
End Type
Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40
Private Function ShellDelete(FileName() As String)
    Dim I As Integer
    Dim sFileNames As String
    Dim SHFileOp As SHFILEOPSTRUCT
    For I = LBound(FileName) To UBound(FileName)
        sFileNames = sFileNames & FileName(I) & vbNullChar
    Next I
    sFileNames = sFileNames & vbNullChar
    With SHFileOp
        .wFunc = FO_DELETE
        .pFrom = sFileNames
        .fFlags = FOF_ALLOWUNDO
    End With
    ShellDelete = SHFileOperation(SHFileOp)
    File1.Refresh
End Function

Private Sub Command1_Click()
    Dim Afile() As String
    Dim I As Long
    Dim SelectNum As Long
    For I = 0 To File1.ListCount - 1
        If File1.Selected(I) Then
            ReDim Preserve Afile(SelectNum)
            Afile(SelectNum) = IIf(Len(File1.Path) > 3, File1.Path & "\" & File1.List(I), File1.Path & File1.List(I))
            SelectNum = SelectNum + 1
        End If
    Next I
    ShellDelete Afile()
    MsgBox "Selected all files already deleted!", vbInformation
End Sub

Private Sub Dir1_Change()
    File1.Path = Dir1.Path
End Sub

Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive
End Sub