📄 frmlistalldrives.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmListAllDrives
BorderStyle = 1 'Fixed Single
Caption = "List opp alle drives"
ClientHeight = 3645
ClientLeft = 150
ClientTop = 435
ClientWidth = 5025
Icon = "frmListAllDrives.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3645
ScaleWidth = 5025
StartUpPosition = 3 'Windows Default
Begin VB.CheckBox chkArrange
Caption = "Arrange Automatic"
Height = 195
Left = 120
TabIndex = 10
Top = 3240
Width = 2655
End
Begin VB.CommandButton cmdOptions
Caption = "&Properties"
Height = 300
Index = 7
Left = 3840
TabIndex = 9
TabStop = 0 'False
Top = 2640
Width = 1095
End
Begin VB.CommandButton cmdOptions
Caption = "&Descending"
Height = 300
Index = 6
Left = 3840
TabIndex = 8
TabStop = 0 'False
Top = 2280
Width = 1095
End
Begin VB.CommandButton cmdOptions
Caption = "&Ascending"
Enabled = 0 'False
Height = 300
Index = 5
Left = 3840
TabIndex = 7
TabStop = 0 'False
Top = 1920
Width = 1095
End
Begin VB.CommandButton cmdOptions
Caption = "De&tails"
Height = 300
Index = 4
Left = 3840
TabIndex = 6
TabStop = 0 'False
Top = 1560
Width = 1095
End
Begin VB.CommandButton cmdOptions
Caption = "&List"
Height = 300
Index = 3
Left = 3840
TabIndex = 5
TabStop = 0 'False
Top = 1200
Width = 1095
End
Begin VB.CommandButton cmdOptions
Caption = "&Small Icons"
Height = 300
Index = 2
Left = 3840
TabIndex = 4
TabStop = 0 'False
Top = 840
Width = 1095
End
Begin VB.CommandButton cmdOptions
Caption = "&Big Icons"
Enabled = 0 'False
Height = 300
Index = 1
Left = 3840
TabIndex = 3
TabStop = 0 'False
Top = 480
Width = 1095
End
Begin VB.CommandButton cmdOptions
Caption = "&Open"
Height = 300
Index = 0
Left = 3840
TabIndex = 2
TabStop = 0 'False
Top = 120
Width = 1095
End
Begin MSComctlLib.ListView lvwDrives
Height = 2895
Left = 120
TabIndex = 0
Top = 120
Width = 3615
_ExtentX = 6376
_ExtentY = 5106
Sorted = -1 'True
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 393217
Icons = "imlDrivesIcon"
SmallIcons = "imlDrivesSmallIcon"
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 2
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "Drives"
Object.Width = 3246
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "Description"
Object.Width = 2893
EndProperty
End
Begin MSComctlLib.ImageList imlDrivesSmallIcon
Left = 3120
Top = 2760
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 5
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmListAllDrives.frx":22A2
Key = "floppy"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmListAllDrives.frx":4556
Key = "cdrom"
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmListAllDrives.frx":49AA
Key = "fixed"
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmListAllDrives.frx":4DFE
Key = "remote"
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmListAllDrives.frx":5252
Key = "unknown"
EndProperty
EndProperty
End
Begin VB.CommandButton cmdExit
Caption = "&Exit"
Height = 300
Left = 3840
TabIndex = 1
Top = 3240
Width = 1095
End
Begin MSComctlLib.ImageList imlDrivesIcon
Left = 3120
Top = 2880
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 32
ImageHeight = 32
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 5
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmListAllDrives.frx":7506
Key = "floppy"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmListAllDrives.frx":795A
Key = "cdrom"
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmListAllDrives.frx":7DAE
Key = "fixed"
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmListAllDrives.frx":8202
Key = "remote"
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmListAllDrives.frx":8656
Key = "unknown"
EndProperty
EndProperty
End
Begin VB.Menu mnuShortCutDrv
Caption = "ShortCutDrv"
Visible = 0 'False
Begin VB.Menu mnuOpen
Caption = "&Open"
End
Begin VB.Menu mnuSplitt1
Caption = "-"
End
Begin VB.Menu mnuIcons
Caption = "&Big Icons"
Enabled = 0 'False
End
Begin VB.Menu mnuSmallIcons
Caption = "&Small Icons"
End
Begin VB.Menu mnuList
Caption = "&List"
End
Begin VB.Menu mnuDetails
Caption = "De&tails"
End
Begin VB.Menu mnuSplitt2
Caption = "-"
End
Begin VB.Menu mnuAscending
Caption = "&Ascending"
End
Begin VB.Menu mnuDescending
Caption = "&Descending"
End
Begin VB.Menu Splitt3
Caption = "-"
End
Begin VB.Menu mnuProperties
Caption = "&Properties"
End
End
End
Attribute VB_Name = "frmListAllDrives"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub LoadAllDrives()
Dim li As ListItem
Dim fso As New FileSystemObject
Dim dr As Drive
Dim sDl As String
On Error Resume Next
For Each dr In fso.Drives
sDl = dr.DriveLetter & ":"
If dr.DriveType = Removable Then
Set li = lvwDrives.ListItems.Add(, , sDl, "floppy", "floppy")
li.SubItems(1) = "3.5 Floppy"
ElseIf dr.DriveType = CDRom Then
Set li = lvwDrives.ListItems.Add(, , sDl, "cdrom", "cdrom")
li.SubItems(1) = "Removable CD-ROM"
ElseIf dr.DriveType = Fixed Then
Set li = lvwDrives.ListItems.Add(, , dr.VolumeName & " " & sDl, "fixed", "fixed")
li.SubItems(1) = "Fixed Disk"
ElseIf dr.DriveType = Remote Then
Set li = lvwDrives.ListItems.Add(, , dr.ShareName & " " & sDl, "remote", "remote")
li.SubItems(1) = "Remote Disk"
Else
Set li = lvwDrives.ListItems.Add(, , sDl, "unknown", "unknown")
li.SubItems(1) = "Unknown ?"
End If
Next dr
Set fso = Nothing
End Sub
Private Sub chkArrange_Click()
If chkArrange.Value = 0 Then
lvwDrives.Arrange = lvwNone
Else
lvwDrives.Arrange = lvwAutoTop
End If
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdOpen_Click()
End Sub
Private Sub cmdOptions_Click(Index As Integer)
Select Case Index
Case 0
mnuOpen_Click
Case 1
mnuIcons_Click
Case 2
mnuSmallIcons_Click
Case 3
mnuList_Click
Case 4
mnuDetails_Click
Case 5
mnuAscending_Click
Case 6
mnuDescending_Click
Case 7
mnuProperties_Click
End Select
End Sub
Private Sub Form_Load()
' InitializeListImages
' AddColHeaders
LoadAllDrives
End Sub
Private Sub lvwDrives_DblClick()
If lvwDrives.SelectedItem.Selected = False Then Exit Sub
Dim Ex
On Error Resume Next
Ex = Shell("Explorer.exe " & Right(lvwDrives.SelectedItem.Text, 3), 1)
End Sub
Private Sub lvwDrives_KeyPress(KeyAscii As Integer)
If lvwDrives.SelectedItem.Selected = False Then Exit Sub
If KeyAscii = 13 Then mnuOpen_Click
End Sub
Private Sub lvwDrives_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then PopupMenu mnuShortCutDrv
End Sub
Private Sub mnuAscending_Click()
cmdOptions(5).Enabled = False
cmdOptions(6).Enabled = True
mnuAscending.Enabled = False
mnuDescending.Enabled = True
lvwDrives.SortOrder = lvwAscending
End Sub
Private Sub mnuDescending_Click()
cmdOptions(6).Enabled = False
cmdOptions(5).Enabled = True
mnuDescending.Enabled = False
mnuAscending.Enabled = True
lvwDrives.SortOrder = lvwDescending
End Sub
Private Sub mnuDetails_Click()
mnuDetails.Enabled = False
mnuIcons.Enabled = True
mnuSmallIcons.Enabled = True
mnuList.Enabled = True
cmdOptions(4).Enabled = False
cmdOptions(1).Enabled = True
cmdOptions(2).Enabled = True
cmdOptions(3).Enabled = True
lvwDrives.View = lvwReport
End Sub
Private Sub mnuIcons_Click()
mnuIcons.Enabled = False
mnuList.Enabled = True
mnuSmallIcons.Enabled = True
mnuDetails.Enabled = True
cmdOptions(1).Enabled = False
cmdOptions(2).Enabled = True
cmdOptions(3).Enabled = True
cmdOptions(4).Enabled = True
lvwDrives.View = lvwIcon
End Sub
Private Sub mnuList_Click()
mnuList.Enabled = False
mnuIcons.Enabled = True
mnuSmallIcons.Enabled = True
mnuDetails.Enabled = True
cmdOptions(3).Enabled = False
cmdOptions(1).Enabled = True
cmdOptions(2).Enabled = True
cmdOptions(4).Enabled = True
lvwDrives.View = lvwList
End Sub
Private Sub mnuOpen_Click()
Dim Ex
Me.MousePointer = vbHourglass
On Error Resume Next
Ex = Shell("Explorer.exe " & Right(lvwDrives.SelectedItem.Text, 2), 1)
Me.MousePointer = vbArrow
End Sub
Private Sub mnuProperties_Click()
Me.MousePointer = vbHourglass
On Error Resume Next
Call GetFileOrDiskProps(Me.hwnd, Right(lvwDrives.SelectedItem.Text, 2))
Me.MousePointer = vbArrow
End Sub
Private Sub mnuSmallIcons_Click()
mnuSmallIcons.Enabled = False
mnuList.Enabled = True
mnuIcons.Enabled = True
mnuDetails.Enabled = True
cmdOptions(2).Enabled = False
cmdOptions(1).Enabled = True
cmdOptions(3).Enabled = True
cmdOptions(4).Enabled = True
lvwDrives.View = lvwSmallIcon
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -