wen1.frm

这是一个文件管理器

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "文件管理器"
   ClientHeight    =   3780
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   4995
   LinkTopic       =   "Form4"
   LockControls    =   -1  'True
   ScaleHeight     =   3780
   ScaleWidth      =   4995
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1 
      Caption         =   "开始搜索"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   492
      Left            =   2880
      TabIndex        =   10
      Top             =   3000
      Width           =   1932
   End
   Begin VB.ComboBox Combo1 
      Height          =   276
      Left            =   120
      TabIndex        =   9
      Text            =   "*.*"
      Top             =   3240
      Width           =   2532
   End
   Begin VB.DriveListBox Drive1 
      Height          =   276
      Left            =   2880
      TabIndex        =   7
      Top             =   2400
      Width           =   1932
   End
   Begin VB.DirListBox Dir1 
      Height          =   1092
      Left            =   2880
      TabIndex        =   5
      Top             =   840
      Width           =   1932
   End
   Begin VB.FileListBox File1 
      Height          =   1710
      Left            =   120
      TabIndex        =   3
      Top             =   840
      Width           =   2532
   End
   Begin VB.TextBox Text1 
      Height          =   264
      Left            =   1920
      TabIndex        =   1
      Text            =   "Text1"
      Top             =   120
      Width           =   2892
   End
   Begin VB.Label Label5 
      Caption         =   "文件类型列表(&T)："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   120
      TabIndex        =   8
      Top             =   3000
      Width           =   2292
   End
   Begin VB.Label Label4 
      Caption         =   "驱动器列表(&D)："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   2880
      TabIndex        =   6
      Top             =   2160
      Width           =   1812
   End
   Begin VB.Label Label3 
      Caption         =   "目录列表(&L)："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   2880
      TabIndex        =   4
      Top             =   600
      Width           =   1812
   End
   Begin VB.Label Label2 
      Caption         =   "文件列表(&F)："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   120
      TabIndex        =   2
      Top             =   600
      Width           =   2052
   End
   Begin VB.Label Label1 
      Caption         =   "搜索文件名(&S)："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   120
      TabIndex        =   0
      Top             =   156
      Width           =   1932
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件"
      Begin VB.Menu mnuNewFileDir 
         Caption         =   "新建文件夹"
      End
      Begin VB.Menu mnuBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuDel 
         Caption         =   "删除"
      End
      Begin VB.Menu mnuRename 
         Caption         =   "重命名"
      End
      Begin VB.Menu mnuAttribute 
         Caption         =   "属性"
      End
      Begin VB.Menu mnuBar2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "退出"
      End
   End
   Begin VB.Menu mnuEdit 
      Caption         =   "编辑"
      Begin VB.Menu mnuCopy 
         Caption         =   "复制"
      End
      Begin VB.Menu mnuPaste 
         Caption         =   "粘贴"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim copyFile$   '需拷贝的文件
Dim newCopyFile$    '新拷贝的文件
Private comdResult As Integer

Private Sub Command1_Click()
    On Error GoTo BadFilename
    comdResult = -1
    ' 文本被解析为文件名、路径和驱动器
    File1.FileName = Text1.Text
    Dir1.Path = File1.Path  ' 设置目录路径
    Drive1.Drive = Dir1.Path    ' 设置驱动器
    File1.Pattern = Combo1.Text '恢复文件显示类型
    comdResult = 0
    Exit Sub
BadFilename: '如果没该文件，则显示错误信息
    MsgBox "No such file !"
    comdResult = 0
End Sub

Private Sub Dir1_Change()
    File1.Path = Dir1.Path
    curFile = ""    '排除删除文件的事件
    '为诸如更名或删除事件设置变量
    curDirec = Dir1.Path
    curName = Dir1.Path
End Sub

Private Sub Drive1_Change()
    Dim msg As String
    On Error GoTo Drive_er
    Dir1.Path = Drive1.Drive
    Exit Sub
Drive_er:
    If (err = 68) Or (err = 71) Then
        msg$ = "驱动器" & Drive1.Drive & "未准备好"""
        MsgBox msg$, vbOKOnly
    Else
        msg$ = "发现未知错误，错误号=" + Str$(err)
        MsgBox msg$, vbOKOnly
    End If
End Sub

Private Sub File1_Click()
    '测试目录后是否有分隔符
    If Right$(Dir1.Path, 1) <> "\" Then
        curFile = Dir1.Path & "\" & File1.FileName
    Else
        curFile = Dir1.Path & File1.FileName
    End If
    '单击文件，可能要进行删除或拷贝操作
    curDirec = ""
    waitingCopyFile = File1.FileName
End Sub

Private Sub File1_DblClick()
    Dim RetVal, msg$
    If comdResult = -1 Then Exit Sub
    '测试文件类型
    On Error GoTo err
    RetVal = Shell(File1.FileName, 4)
    Exit Sub
err:    '不是可执行文件就出错
    If RetVal = 0 Then
        msg$ = "文件打开错误"
        MsgBox msg$, vbOKOnly
    End If
End Sub

Private Sub Combo1_Change() '可人工设置文件类型
    File1.Pattern = Combo1.Text '设置文件列表框的文件显示类型
End Sub

Private Sub Combo1_Click()  '用鼠标选取组合框中的文件类型
    File1.Pattern = Combo1.Text '设置文件列表框的文件显示类型
End Sub

Private Sub Form_Load()
    '装载文件类型
    Combo1.AddItem "*.*"
    Combo1.AddItem "*.bmp"
    Combo1.AddItem "*.exe"
    Combo1.AddItem "*.doc"
    Combo1.AddItem "*.txt"
    Command1.Default = True ' 设置缺省属性
    Text1.Text = ""
    '设置在运行时显示在 FileListBox 中的文件类型
    File1.Pattern = "*.*"
    curFile = ""    '变量初始化
    curDirec = Dir1.Path
    curName = Dir1.Path
End Sub

Private Sub Form_Resize()
    '当窗体缩放时，各控件要做相应的变化
    Label1.Width = Form1.Width / 2
    Text1.Left = Label1.Left + Label1.Width + 300
    '设置窗体左边的控件
    Label2.Width = Form1.Width / 2
    Label3.Left = Form1.Width / 2 + 400
    Label3.Width = Form1.Width - Label2.Width - 600
    Text1.Width = Label3.Width
    File1.Width = Label2.Width
    File1.Left = Label2.Left
    If Form1.Height < (3 * Label1.Height + Combo1.Height + 1000) Then
        Exit Sub
    End If
    File1.Height = Form1.Height - 3 * Label1.Height - Combo1.Height - 1000
    Label5.Top = File1.Top + File1.Height + 100
    Combo1.Top = Label5.Top + Label5.Height
    Label5.Width = Label2.Width:    Combo1.Width = Label5.Width
    '设置窗体右边的控件
    Dir1.Left = Label3.Left
    Dir1.Width = Label3.Width
    Dir1.Height = File1.Height - Drive1.Height - Label4.Height - 160
    Label4.Left = Label3.Left
    Label4.Top = Dir1.Top + Dir1.Height + 100
    Drive1.Left = Label3.Left
    Drive1.Width = Label3.Width
    Drive1.Top = Label4.Height + Label4.Top
    Command1.Left = Drive1.Left
    Command1.Top = Label5.Top
    Command1.Width = Drive1.Width
    Command1.Height = Combo1.Height + Label5.Height
End Sub

Private Sub mnuDel_Click()
    Dim myDir$, reTempDir$
    On Error GoTo errBad
    If curFile <> "" Then
        Kill curFile
        File1.Refresh   '文件列表更新
    Else
        If curDirec <> "" Then
            reTempDir = curDirec: myDir$ = curDirec
            lenfile = Len(reTempDir)
            '获取上级目录
            Do While lenfile <> 1
                If Right$(reTempDir, 1) = "\" Then
                    reTempDir = Left$(reTempDir, lenfile - 1)
                    '测试是否到了根目录
                    If Right$(reTempDir, 1) = ":" Then
                        reTempDir = reTempDir & "\"
                    End If
                    Exit Do
                End If
                reTempDir = Left$(reTempDir, lenfile - 1)
                lenfile = Len(reTempDir)
            Loop
            If lenfile = 1 Then Exit Sub
            Dir1.Path = reTempDir
            ChDir Dir1.Path '返回上级目录
            RmDir myDir$    '需在上级目录进行删除操作
            Dir1.Refresh    '目录列表更新
        End If
    End If
    Exit Sub
errBad:
    If (err = 53) Then
        MsgBox "文件不存在", vbOKOnly
    Else
        If (err = 75) Then
            MsgBox "目录中还存在文件", vbOKOnly
        Else
            msg$ = "发现未知错误，错误号=" + Str$(err)
            MsgBox msg$, vbOKOnly
        End If
    End If
End Sub

Private Sub mnuExit_Click()
    Reset
    End
End Sub

Private Sub mnuCopy_Click()
    copyFile = curFile  '获取拷贝文件名
    newCopyFile = waitingCopyFile   '新文件名
End Sub

Private Sub mnuPaste_Click()
    Dim finalFile$
    On Error GoTo errBad
    ChDir curDirec    '设置到目的目录
    If Right$(curDirec, 1) <> "\" Then
        finalFile$ = curDirec & "\" & newCopyFile
    Else
        finalFile$ = curDirec & newCopyFile
    End If
    FileCopy copyFile, finalFile$
    File1.Refresh
    Exit Sub
errBad:
    MsgBox "文件不能自身复制", vbOKOnly
End Sub

Private Sub mnuNewFileDir_Click()
    Load Form2  '装载新建文件夹窗体
    Form2.Show 1
End Sub

Private Sub mnuRename_Click()
    Load Form3  '装载重命名窗体
    Form3.Show 1
End Sub

Private Sub mnuAttribute_Click()
    If curFile = "" Then   '如果选中的是文件
        MsgBox "请选中一个文件", vbOKOnly
        Exit Sub
    End If
    Load Form4      '装载属性窗体
    Form4.Show 1    '窗体是模式的
End Sub