form7.frm

模拟文件管理系统

VERSION 5.00
Begin VB.Form Form7 
   BackColor       =   &H00FFC0FF&
   Caption         =   "驱动器及文件属性查询"
   ClientHeight    =   7290
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   8010
   LinkTopic       =   "Form7"
   ScaleHeight     =   7290
   ScaleWidth      =   8010
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      BackColor       =   &H00C0E0FF&
      Caption         =   "退出"
      Height          =   495
      Left            =   3600
      Style           =   1  'Graphical
      TabIndex        =   6
      Top             =   6480
      Width           =   855
   End
   Begin VB.CommandButton Command1 
      BackColor       =   &H00C0E0FF&
      Caption         =   "返 回"
      Height          =   495
      Left            =   1920
      MaskColor       =   &H000000FF&
      Style           =   1  'Graphical
      TabIndex        =   5
      Top             =   6480
      Width           =   855
   End
   Begin VB.ListBox List1 
      Height          =   1320
      Left            =   600
      TabIndex        =   3
      Top             =   360
      Width           =   3375
   End
   Begin VB.TextBox Text1 
      Height          =   1455
      Left            =   600
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   2
      Top             =   4680
      Width           =   3375
   End
   Begin VB.DirListBox Dir1 
      Height          =   2610
      Left            =   600
      TabIndex        =   1
      Top             =   1920
      Width           =   3375
   End
   Begin VB.FileListBox File1 
      Height          =   5850
      Left            =   4320
      TabIndex        =   0
      Top             =   360
      Width           =   3495
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "显示信息"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   15
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   1335
      Left            =   120
      TabIndex        =   4
      Top             =   4800
      Width           =   495
   End
End
Attribute VB_Name = "Form7"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit '使用 Option Explicit 语句强制所有变量的显式声明。
'试图使用未声明的变量将导致编译时错误,语句只用在模块级,必须出现在脚本的任何其他语句之前。
Dim fso As New FileSystemObject
Private Sub Command1_Click()
Form1.Show
Form7.Hide
End Sub

Private Sub Command2_Click()
End
End Sub



Private Sub Dir1_Change()
'同步改变Dir1和File1路径
File1.Path = Dir1.Path
End Sub

Private Sub Dir1_Click()
Dim s As String
Dim fd As Folder
'如果不能获得信息,跳转到错误处理语句
On Error GoTo handle
'获得文件夹句柄
Set fd = fso.GetFolder(Dir1.List(Dir1.ListIndex))
'如果是根目录,不能访问其创建日期,所以不处理根目录
If Not fd.IsRootFolder Then
s = " " & fd.Name + vbCrLf
s = s & "大小" & Format(fd.Size, "###,###,###,##0") & "Kb" + vbCrLf
s = s & "创建日期" & CStr(fd.DateCreated) + vbCrLf
s = s & "最后访问日期" & CStr(fd.DateLastAccessed) + vbCrLf
s = s & "最后修改日期" & CStr(fd.DateLastModified)
Else
s = "It's a RootFolder!"
End If
Text1.Text = s
Exit Sub
handle:
       Text1.Text = ""
End Sub

Private Sub File1_Click()
Dim s As String
Dim fl As File
'如不能访问，跳转到handle错误处理语句中
On Error GoTo handle
'使dir1和列表显示的路径一致
Dir1.Path = Dir1.List(Dir1.ListIndex)
'获取文件句柄
Set fl = fso.GetFile(Dir1.Path & "\" & File1.List(File1.ListIndex))
s = " " & fl.Name + vbCrLf
s = s & "大小" & Format(fl.Size, "###,###,###,##0") & "Kb" + vbCrLf
s = s & "创建日期" & CStr(fl.DateCreated) + vbCrLf
s = s & "最后访问日期" & CStr(fl.DateLastAccessed) + vbCrLf
s = s & "最后修改日期" & CStr(fl.DateLastModified)
Text1.Text = s
Exit Sub
handle:
      Text1.Text = "用FSO不能访问该文件"
End Sub

Private Sub Form_Load()
Dim drvset As Drives, drv As Drive
Dim str As String
Dim sysmsg As String
'从FSO对象中获得所有Drive对象集合
Set drvset = fso.Drives '用drv遍历Drive对象集合
For Each drv In drvset
   str = drv.DriveLetter & ":" & " "
   Select Case drv.DriveType
      Case 0: str = str + "UnKnown"
      Case 1: str = str + "Removable"
      Case 2: str = str + "Fixed"
      Case 3: str = str + "NetWork"
      Case 4: str = str + "CD-ROM"
      Case 5: str = str + "RAM Disk"
    End Select
    '确认驱动器是否准备好
    If drv.IsReady Then
       sysmsg = drv.FileSystem
    Else
       sysmsg = "NotReady"
    End If
    str = str & " " & sysmsg & " "
    If drv.IsReady Then
      Select Case drv.DriveType
        Case 3: str = str & drv.ShareName
        Case 4: str = str & drv.VolumeName
        Case Else: str = str & drv.VolumeName
      End Select
    End If
    '把驱动器的属性字符串显示到list1中
    List1.AddItem (str)
    Next
    '自动选择第二行内容作为默认内容
    List1.ListIndex = 1
End Sub

Private Sub List1_Click()
Dim s As String
Dim drvset As Drives
Dim drv As Drive
Set drvset = fso.Drives
'如果列表框中没有被选中的项目,退出该过程
If List1.ListIndex < 0 Then Exit Sub
Set drv = drvset.Item(Left(List1.List(List1.ListIndex), 1))
If drv.IsReady Then
s = "总空间:" & Format(drv.TotalSize, "###,###,###,##0") & "Kb" + vbCrLf
s = s & "剩余空间" & Format(drv.FreeSpace, "###,###,###,##0") & "Kb" + vbCrLf
s = s & "可用空间" & Format(drv.AvailableSpace, "###,###,###,##0") & "Kb" + vbCrLf
'更新目录列表中的内容
Dir1.Path = drv.Path
Else
s = "驱动器没有准备好!"
'如果驱动器没有准备好,退回到上一个驱动器
List1.ListIndex = List1.ListIndex - 1
End If
'将信息显示在公共信息栏上
Text1.Text = s
End Sub