frmmain.frm

文件分割与合并 vb环境开发 界面做的非常好 是vb学习的绝佳素材 this vbsystem is very useful

VERSION 5.00
Begin VB.Form frmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "文件管理器"
   ClientHeight    =   3270
   ClientLeft      =   150
   ClientTop       =   720
   ClientWidth     =   4575
   LinkTopic       =   "Form4"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3270
   ScaleWidth      =   4575
   StartUpPosition =   3  '窗口缺省
   Begin VB.ComboBox cboFilter 
      Height          =   300
      Left            =   120
      TabIndex        =   6
      Text            =   "*.*"
      Top             =   2880
      Width           =   2055
   End
   Begin VB.DriveListBox drvList 
      Height          =   300
      Left            =   120
      TabIndex        =   4
      Top             =   360
      Width           =   2055
   End
   Begin VB.DirListBox dirList 
      Height          =   1770
      Left            =   120
      TabIndex        =   2
      Top             =   720
      Width           =   2055
   End
   Begin VB.FileListBox filList 
      Height          =   2790
      Left            =   2280
      TabIndex        =   1
      Top             =   360
      Width           =   2175
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "文件类型(&T)："
      Height          =   180
      Left            =   120
      TabIndex        =   5
      Top             =   2640
      Width           =   1170
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "选择文件夹(&D)："
      Height          =   180
      Left            =   120
      TabIndex        =   3
      Top             =   120
      Width           =   1350
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "文件列表(&F)："
      Height          =   180
      Left            =   2280
      TabIndex        =   0
      Top             =   120
      Width           =   1170
   End
   Begin VB.Menu mnuDir 
      Caption         =   "文件夹(&D)"
      Begin VB.Menu mnuDirNew 
         Caption         =   "新建(&N)..."
         Shortcut        =   ^N
      End
      Begin VB.Menu mnuDirDel 
         Caption         =   "删除(&D)"
      End
      Begin VB.Menu mnuBar3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuDirRename 
         Caption         =   "重命名(&R)..."
      End
      Begin VB.Menu mnuDirAttribute 
         Caption         =   "属性(&P)..."
      End
      Begin VB.Menu mnuBar2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "退出(&X)"
         Shortcut        =   ^X
      End
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu mnuFileRename 
         Caption         =   "重命名(&R)..."
         Shortcut        =   {F2}
      End
      Begin VB.Menu mnuFileAttribute 
         Caption         =   "属性(&A)..."
         Shortcut        =   {F4}
      End
      Begin VB.Menu mnuBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileCopy 
         Caption         =   "复制(&C)"
      End
      Begin VB.Menu mnuFilePaste 
         Caption         =   "粘贴(&P)"
      End
      Begin VB.Menu mnuFileDel 
         Caption         =   "删除(&D)"
         Shortcut        =   {DEL}
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim msFileToCopy  '所拷贝的文件的名称
Dim msPathToCopy  '所拷贝的文件的路径

'声明模块级的FileSystemObject对象
Dim mFSO As New FileSystemObject

Private Sub dirList_Change()
   filList.Path = dirList.Path
End Sub

Private Sub drvList_Change()
   dirList.Path = drvList.Drive
End Sub

Private Sub cboFilter_Change()
    filList.Pattern = cboFilter.Text
End Sub

Private Sub cboFilter_Click()
   filList.Pattern = cboFilter.Text
End Sub

Private Sub filList_DblClick()
   mnuFileAttribute_Click
End Sub

Private Sub Form_Load()
   '添加文件类型
   cboFilter.AddItem "*.*"
   cboFilter.AddItem "*.doc"
   cboFilter.AddItem "*.txt"
   
   '设置在运行时显示在 FileListBox 中的文件类型
   filList.Pattern = "*.*"
   filList.Archive = True
   filList.Hidden = True
   filList.System = True
   filList.ReadOnly = True
   filList.Normal = True
   
   mnuFilePaste.Enabled = False
End Sub

Private Sub mnuDirAttribute_Click()
   If dirList.Path = "" Then Exit Sub
      
   Load frmAttribute
   frmAttribute.FileName = dirList.Path
   
   frmAttribute.Show 1 '以模式方式显示属性窗体
End Sub

Private Sub mnuDirDel_Click()
   On Error GoTo errHandler
   If MsgBox("真的要删除文件夹吗？", vbYesNo + vbQuestion, "询问") = vbNo Then Exit Sub
   
   Dim theFolder As Folder
   Set theFolder = mFSO.GetFolder(dirList.Path)   '取得要删除的文件夹对象
   If theFolder.Path = "" Or theFolder.IsRootFolder Then Exit Sub
   
   Dim strParent As String
   strParent = theFolder.ParentFolder
   theFolder.Delete True   '调用Folder对象的Delete方法来强制删除文件夹
   dirList.Path = strParent '刷新文件夹列表
   
   Exit Sub
   
errHandler:
   MsgBox Err.Description, vbCritical, "错误"
End Sub

Private Sub mnuDirRename_Click()
   Dim theFolder As Folder
   Set theFolder = mFSO.GetFolder(dirList.Path) '取得Folder对象
   If theFolder.Path = "" Or theFolder.IsRootFolder Then Exit Sub
      
   Dim strAfterDir As String
   strAfterDir = InputBox("请输入新的名称", "输入名称")
   If strAfterDir = "" Then Exit Sub
   theFolder.Name = strAfterDir '更改文件夹的名称
      
   dirList.Path = theFolder.Path '刷新文件夹列表
End Sub

Private Sub mnuFileDel_Click()
    On Error GoTo errHandler
    If filList.FileName = "" Then Exit Sub
    
    '询问是否要删除文件
    If MsgBox("真的要删除所选的文件吗？", vbYesNo + vbQuestion, "询问") = vbNo Then Exit Sub
        
    Dim str As String
    str = mFSO.BuildPath(filList.Path, filList.FileName)
    mFSO.DeleteFile str, True '调用FileSystemObject的DeleteFile方法来删除文件
    filList.Refresh   '更新文件列表
    
    Exit Sub
errHandler:
   MsgBox Err.Description, vbCritical, "删除文件时，出现下列错误："
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub mnuFileCopy_Click()
   '获取所要拷贝的文件名
    msFileToCopy = filList.FileName
    msPathToCopy = filList.Path
    
    mnuFilePaste.Enabled = (msFileToCopy <> "")
End Sub

Private Sub mnuFilePaste_Click()
   On Error GoTo errHandler
   
   '取得源文件的全路径名称
   Dim strCopyFrom As String
   strCopyFrom = mFSO.BuildPath(msPathToCopy, msFileToCopy)
   '取得目标文件的全路径名称
   Dim strCopyTo As String
   strCopyTo = mFSO.BuildPath(filList.Path, msFileToCopy)
        
   '使用FileSystemObject对象的CopyFile来实现拷贝文件
   mFSO.CopyFile strCopyFrom, strCopyTo, False
   filList.Refresh   '刷新文件列表
   Exit Sub
    
errHandler:
   MsgBox Err.Description, vbCritical, "错误"
End Sub

Private Sub mnuDirNew_Click()
   On Error GoTo errHandler
   
   Dim str As String
   str = InputBox("输入所要创建的文件夹的名称！", "新建文件夹", mFSO.GetTempName())
   If str = "" Then Exit Sub
   str = mFSO.BuildPath(dirList.Path, str)
   mFSO.CreateFolder str '创建文件夹
   dirList.Path = str '刷新文件夹列表
   
   Exit Sub
    
errHandler:
   MsgBox Err.Description, vbCritical, "创建文件夹错误"
End Sub

Private Sub mnuFileRename_Click()
   On Error GoTo errHandler
   If filList.FileName = "" Then Exit Sub
   
   Dim str
   str = mFSO.BuildPath(filList.Path, filList.FileName)
   Dim theFile As File
   Set theFile = mFSO.GetFile(str)   '取得File对象
   
   '取得文件名，并改变当前的文件名
   str = InputBox("请输入新的名称", "输入名称")
   If str = "" Then Exit Sub
   theFile.Name = str
   filList.Refresh   '更新文件列表
   
   Exit Sub
   
errHandler:
   MsgBox Err.Description, vbCritical, "错误"
End Sub


Private Sub mnuFileAttribute_Click()
   If filList.FileName = "" Then Exit Sub
    
   Load frmAttribute
   frmAttribute.FileName = mFSO.BuildPath(filList.Path, filList.FileName)
   frmAttribute.Show 1 '以模式方式显示属性窗体
End Sub