VERSION 5.00
Begin VB.Form Form7 
   BackColor       =   &H00FFC0FF&
   Caption         =   "驅(qū)動器及文件屬性查詢"
   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 語句強(qiáng)制所有變量的顯式聲明。
'試圖使用未聲明的變量將導(dǎo)致編譯時(shí)錯(cuò)誤,語句只用在模塊級,必須出現(xiàn)在腳本的任何其他語句之前。
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
'如果不能獲得信息,跳轉(zhuǎn)到錯(cuò)誤處理語句
On Error GoTo handle
'獲得文件夾句柄
Set fd = fso.GetFolder(Dir1.List(Dir1.ListIndex))
'如果是根目錄,不能訪問其創(chuàng)建日期,所以不處理根目錄
If Not fd.IsRootFolder Then
s = " " & fd.Name + vbCrLf
s = s & "大小" & Format(fd.Size, "###,###,###,##0") & "Kb" + vbCrLf
s = s & "創(chuàng)建日期" & 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
'如不能訪問，跳轉(zhuǎn)到handle錯(cuò)誤處理語句中
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 & "創(chuàng)建日期" & 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
    '確認(rèn)驅(qū)動器是否準(zhǔn)備好
    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
    '把驅(qū)動器的屬性字符串顯示到list1中
    List1.AddItem (str)
    Next
    '自動選擇第二行內(nèi)容作為默認(rèn)內(nèi)容
    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
'如果列表框中沒有被選中的項(xiàng)目,退出該過程
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
'更新目錄列表中的內(nèi)容
Dir1.Path = drv.Path
Else
s = "驅(qū)動器沒有準(zhǔn)備好!"
'如果驅(qū)動器沒有準(zhǔn)備好,退回到上一個(gè)驅(qū)動器
List1.ListIndex = List1.ListIndex - 1
End If
'將信息顯示在公共信息欄上
Text1.Text = s
End Sub