📄 hidedrive.frm
字号:
Height = 255
Index = 11
Left = 960
TabIndex = 18
ToolTipText = "2048"
Top = 1680
Width = 615
End
Begin VB.CheckBox CheckDrive
Caption = "M:"
Height = 255
Index = 12
Left = 960
TabIndex = 17
ToolTipText = "4096"
Top = 2040
Width = 615
End
Begin VB.CheckBox CheckDrive
Caption = "N:"
Height = 255
Index = 13
Left = 960
TabIndex = 16
ToolTipText = "8192"
Top = 2400
Width = 615
End
Begin VB.CheckBox CheckDrive
Caption = "O:"
Height = 255
Index = 14
Left = 1680
TabIndex = 15
ToolTipText = "16384"
Top = 240
Width = 615
End
Begin VB.CheckBox CheckDrive
Caption = "P:"
Height = 255
Index = 15
Left = 1680
TabIndex = 14
ToolTipText = "32768"
Top = 600
Width = 615
End
Begin VB.CheckBox CheckDrive
Caption = "Q:"
Height = 255
Index = 16
Left = 1680
TabIndex = 13
ToolTipText = "65536"
Top = 960
Width = 615
End
Begin VB.CheckBox CheckDrive
Caption = "R:"
Height = 255
Index = 17
Left = 1680
TabIndex = 12
ToolTipText = "131072"
Top = 1320
Width = 615
End
Begin VB.CheckBox CheckDrive
Caption = "S:"
Height = 255
Index = 18
Left = 1680
TabIndex = 11
ToolTipText = "262144"
Top = 1680
Width = 615
End
Begin VB.CheckBox CheckDrive
Caption = "T:"
Height = 255
Index = 19
Left = 1680
TabIndex = 10
ToolTipText = "524288"
Top = 2040
Width = 615
End
Begin VB.CheckBox CheckDrive
Caption = "U:"
Height = 255
Index = 20
Left = 1680
TabIndex = 9
ToolTipText = "1048576"
Top = 2400
Width = 615
End
Begin VB.CheckBox CheckDrive
Caption = "V:"
Height = 255
Index = 21
Left = 2400
TabIndex = 8
ToolTipText = "2097152"
Top = 240
Width = 615
End
Begin VB.CheckBox CheckDrive
Caption = "W:"
Height = 255
Index = 22
Left = 2400
TabIndex = 7
ToolTipText = "4194304"
Top = 600
Width = 615
End
Begin VB.CheckBox CheckDrive
Caption = "X:"
Height = 255
Index = 23
Left = 2400
TabIndex = 6
ToolTipText = "8388608"
Top = 960
Width = 615
End
Begin VB.CheckBox CheckDrive
Caption = "Y:"
Height = 255
Index = 24
Left = 2400
TabIndex = 5
ToolTipText = "16777216"
Top = 1320
Width = 615
End
Begin VB.CheckBox CheckDrive
Caption = "Z:"
Height = 255
Index = 25
Left = 2400
TabIndex = 4
ToolTipText = "33554432"
Top = 1680
Width = 615
End
Begin VB.CommandButton CmdOk
Caption = "确 定"
Height = 855
Left = 3960
Picture = "HideDrive.frx":0442
Style = 1 'Graphical
TabIndex = 3
Top = 1680
Width = 975
End
Begin VB.CheckBox HideAll
Caption = "隐藏所有驱动器"
Height = 255
Left = 2400
TabIndex = 2
ToolTipText = "67108863"
Top = 2400
Width = 1695
End
Begin VB.CheckBox ShowAll
Caption = "显示所有驱动器"
Height = 255
Left = 2400
TabIndex = 1
Top = 2040
Width = 1575
End
Begin VB.Label Label1
Caption = $"HideDrive.frx":0884
Height = 1455
Left = 3000
TabIndex = 30
Top = 360
Width = 2055
End
End
End
Attribute VB_Name = "HideDrive"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub HideDrive_Click()
End Sub
Private Sub CheckDrive_Click(Index As Integer)
For I = 0 To 25
If CheckDrive(I).Value = 1 Then
CheckDrive(I).ForeColor = &HFF&
Else
CheckDrive(I).ForeColor = &H80000012
End If
Next I
End Sub
Private Sub CmdCancel_Click()
Unload Me
End Sub
Private Sub CmdOk_Click()
Dim Hide As Long
Dim Mess As String
Dim Total As Integer
Hide = 0
Mess = "您已隐藏了 "
If HideAll.Value = 1 Then
Hide = Val(HideAll.ToolTipText)
Else
If ShowAll.Value = 1 Then
Hide = 0
Else
For I = 0 To 25
If CheckDrive(I).Value = 1 Then
Hide = Hide + Val(CheckDrive(I).ToolTipText)
End If
Next I
End If
End If
SS = RegOpenKeyEx(&H80000001, "software", 0, KEY_ALL_ACCESS, ID)
SS = RegOpenKeyEx(ID, "microsoft", 0, KEY_ALL_ACCESS, ID)
SS = RegOpenKeyEx(ID, "windows", 0, KEY_ALL_ACCESS, ID)
SS = RegOpenKeyEx(ID, "currentversion", 0, KEY_ALL_ACCESS, ID)
SS = RegOpenKeyEx(ID, "policies", 0, KEY_ALL_ACCESS, ID)
SS = RegOpenKeyEx(ID, "explorer", 0, KEY_ALL_ACCESS, ID)
SS = RegSetValueEx(ID, "NoDrives", 0, 4, Hide, 4)
SS = RegCloseKey(ID)
If HideAll.Value = 1 Then
Mess = "您已隐藏了所有驱动器,注销后生效"
Else
If ShowAll.Value = 1 Then
Mess = "您已显示了所有驱动器,注销后生效"
Else
For I = 0 To 25
If CheckDrive(I).Value = 1 Then
Mess = Mess + CheckDrive(I).Caption
End If
Next I
End If
End If
Text1.Text = Mess + "驱动器,注销后生效"
None:
Total = 0
For I = 0 To 25
Total = Total + CheckDrive(I).Value
Next I
Total = Total + ShowAll.Value + HideAll.Value
If Total = 0 Then
Text1.Text = "您未选中任何项,系统将按以前设置"
End If
End Sub
Private Sub Drive1_Change()
Dim UsedPer As Currency
Dim FreePer As Currency
Dim DriveName As String
Dim BytesFreeAvaiable As Currency, TotalBytes As Currency
Dim TotalFreeBytes As Currency, TotalBytesUsed As Currency
DriveName = Trim(Left(Drive1.Drive, 3))
LabHead.Caption = "以下是" + DriveName + "盘的全部信息："
LabUsedPer.Caption = DriveName + "盘已经使用："
LabFreePer.Caption = DriveName + "盘的可用空间占："
Call GetDiskFreeSpaceEx(DriveName, BytesFreeAvaiable, TotalBytes, TotalFreeBytes)
TxtTotal.Text = TotalBytes * 10000 / 1024 / 1024
TxtFree.Text = TotalFreeBytes * 10000 / 1024 / 1024
TxtAvailable.Text = BytesFreeAvaiable * 10000 / 1024 / 1024
TxtUsed.Text = (TotalBytes * 10000 - TotalFreeBytes * 10000) / 1024 / 1024
UsedPer = CCur(TxtUsed.Text) / CCur(TxtTotal.Text)
TxtUsedPer.Text = Format(UsedPer * 100, "##.#0")
FreePer = CCur(TxtFree.Text) / CCur(TxtTotal.Text)
TxtAvailablePer.Text = Format(FreePer * 100, "##.#0")
End Sub
Private Sub Form_Load()
Dim UsedPer As Currency
Dim FreePer As Currency
Dim DriveName As String
Dim BytesFreeAvaiable As Currency, TotalBytes As Currency
Dim TotalFreeBytes As Currency, TotalBytesUsed As Currency
DriveName = Trim(Left(Drive1.Drive, 3))
LabHead.Caption = "以下是" + DriveName + "盘的全部信息："
LabUsedPer.Caption = DriveName + "盘已经使用："
LabFreePer.Caption = DriveName + "盘的可用空间占："
Call GetDiskFreeSpaceEx(DriveName, BytesFreeAvaiable, TotalBytes, TotalFreeBytes)
TxtTotal.Text = TotalBytes * 10000 / 1024 / 1024
TxtFree.Text = TotalFreeBytes * 10000 / 1024 / 1024
TxtAvailable.Text = BytesFreeAvaiable * 10000 / 1024 / 1024
TxtUsed.Text = (TotalBytes * 10000 - TotalFreeBytes * 10000) / 1024 / 1024
UsedPer = CCur(TxtUsed.Text) / CCur(TxtTotal.Text)
TxtUsedPer.Text = Format(UsedPer * 100, "##.#0")
FreePer = CCur(TxtFree.Text) / CCur(TxtTotal.Text)
TxtAvailablePer.Text = Format(FreePer * 100, "##.#0")
End Sub
Private Sub HideAll_Click()
If HideAll.Value = 1 Then
ShowAll.Value = 0
For I = 0 To 25
CheckDrive(I).Value = 1
CheckDrive(I).Enabled = False
Next I
Else
For I = 0 To 25
CheckDrive(I).Value = 0
CheckDrive(I).Enabled = True
Next I
End If
End Sub
Private Sub ShowAll_Click()
If ShowAll.Value = 1 Then
HideAll.Value = 0
For I = 0 To 25
CheckDrive(I).ForeColor = &H80000012
CheckDrive(I).Value = 0
CheckDrive(I).Enabled = False
Next I
Else
For I = 0 To 25
CheckDrive(I).Enabled = True
Next I
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -