form1.frm

大量优秀的vb编程

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "对文件的全面操作"
   ClientHeight    =   4296
   ClientLeft      =   3708
   ClientTop       =   1296
   ClientWidth     =   5988
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4296
   ScaleWidth      =   5988
   StartUpPosition =   2  'CenterScreen
   Begin VB.Frame Frame1 
      Caption         =   "操作设置"
      Height          =   2532
      Left            =   240
      TabIndex        =   9
      Top             =   960
      Width           =   5412
      Begin VB.CheckBox chkSilent 
         Caption         =   "不显示过程对话框"
         Height          =   255
         Left            =   240
         TabIndex        =   14
         Top             =   360
         Width           =   3015
      End
      Begin VB.CheckBox chkYesToAll 
         Caption         =   "对显示所有的对话框回答""Yes to All"""
         Height          =   375
         Left            =   240
         TabIndex        =   13
         Top             =   720
         Width           =   3372
      End
      Begin VB.CheckBox chkRename 
         Caption         =   "如果文件名称在操作时冲突，允许重新命名"
         Height          =   495
         Left            =   240
         TabIndex        =   12
         Top             =   1080
         Width           =   3732
      End
      Begin VB.CheckBox chkDir 
         Caption         =   "不允许产生新目录"
         Height          =   495
         Left            =   240
         TabIndex        =   11
         Top             =   1560
         Width           =   3972
      End
      Begin VB.CheckBox chkFilesOnly 
         Caption         =   "如果名称为*.*，只对文件进行操作"
         Height          =   375
         Left            =   240
         TabIndex        =   10
         Top             =   2040
         Width           =   4452
      End
   End
   Begin VB.CommandButton cmdFileOp 
      Caption         =   "删除"
      Height          =   375
      Index           =   3
      Left            =   3480
      TabIndex        =   5
      ToolTipText     =   "Enter Source only."
      Top             =   3720
      Width           =   855
   End
   Begin VB.CommandButton cmdFileOp 
      Caption         =   "移动"
      Height          =   375
      Index           =   1
      Left            =   1560
      TabIndex        =   3
      ToolTipText     =   "Enter Source and Destination."
      Top             =   3720
      Width           =   855
   End
   Begin VB.CommandButton cmdFileOp 
      Caption         =   "重命名"
      Height          =   375
      Index           =   2
      Left            =   2520
      TabIndex        =   4
      ToolTipText     =   "Enter Source and Destination."
      Top             =   3720
      Width           =   855
   End
   Begin VB.TextBox txtDestination 
      Height          =   285
      Left            =   1560
      TabIndex        =   1
      ToolTipText     =   "Enter the full path of the destination file or folder.  Wildcards are allowed."
      Top             =   600
      Width           =   4095
   End
   Begin VB.TextBox txtSource 
      Height          =   285
      Left            =   1560
      TabIndex        =   0
      ToolTipText     =   "Enter the full path of the file or folder to copy, rename, move or delete. Wildcards are allowed."
      Top             =   240
      Width           =   4095
   End
   Begin VB.CommandButton cmdQuit 
      Caption         =   "退出程序"
      Height          =   375
      Left            =   4440
      TabIndex        =   6
      Top             =   3720
      Width           =   855
   End
   Begin VB.CommandButton cmdFileOp 
      Caption         =   "拷贝"
      Height          =   375
      Index           =   0
      Left            =   600
      TabIndex        =   2
      ToolTipText     =   "Enter Source and Destination."
      Top             =   3720
      Width           =   855
   End
   Begin VB.Label Label2 
      Alignment       =   1  'Right Justify
      Caption         =   "目标文件或者目录:"
      Height          =   252
      Left            =   120
      TabIndex        =   8
      Top             =   600
      Width           =   1332
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      Caption         =   "源文件或者目录:"
      Height          =   252
      Left            =   0
      TabIndex        =   7
      Top             =   240
      Width           =   1332
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const FO_COPY = &H2
Const FO_DELETE = &H3
Const FO_MOVE = &H1
Const FO_RENAME = &H4
Const FOF_ALLOWUNDO = &H40
Const FOF_SILENT = &H4
Const FOF_NOCONFIRMATION = &H10
Const FOF_RENAMEONCOLLISION = &H8
Const FOF_NOCONFIRMMKDIR = &H200
Const FOF_FILESONLY = &H80

Private Type SHFILEOPSTRUCT
    hwnd      As Long
    wFunc     As Long
    pFrom     As String
    pTo       As String
    fFlags    As Integer
    fAborted  As Boolean
    hNameMaps As Long
    sProgress As String
End Type

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



Private Sub cmdFileOp_Click(Index As Integer)
Dim lFileOp  As Long
Dim lresult  As Long
Dim lFlags   As Long
Dim SHFileOp As SHFILEOPSTRUCT

Screen.MousePointer = vbHourglass
Select Case Index
    Case 0
        lFileOp = FO_COPY
    Case 1
        lFileOp = FO_MOVE
    Case 2
        lFileOp = FO_RENAME
    Case 3
        lFileOp = FO_DELETE
End Select

If chkSilent Then lFlags = lFlags Or FOF_SILENT
If chkYesToAll Then lFlags = lFlags Or FOF_NOCONFIRMATION
If chkRename Then lFlags = lFlags Or FOF_RENAMEONCOLLISION
If chkDir Then lFlags = lFlags Or FOF_NOCONFIRMMKDIR
If chkFilesOnly Then lFlags = lFlags Or FOF_FILESONLY
'
' NOTE:  By adding the FOF_ALLOWUNDO flag you can move
' a file to the Recycle Bin instead of deleting it.
'
With SHFileOp
    .wFunc = lFileOp
    .pFrom = txtSource.Text & vbNullChar & vbNullChar
    .pTo = txtDestination & vbNullChar & vbNullChar
    .fFlags = lFlags
End With
lresult = SHFileOperation(SHFileOp)
'
' If User hit Cancel button while operation is in progress,
' the fAborted parameter will be true
'
Screen.MousePointer = vbDefault
If lresult <> 0 Or SHFileOp.fAborted Then Exit Sub
MsgBox "操作完毕！", vbInformation, "文件操作"
End Sub
Private Sub cmdQuit_Click()
Unload Me
End Sub