form1.frm

本程序在Win98SE中文版、VB6.0下通过 本程序通过读取注册表中的信息获取当前系统中驱动器的隐藏与可见性 本程序只使用了几个简单的函数

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "隐藏驱动器"
   ClientHeight    =   3090
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5490
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3090
   ScaleWidth      =   5490
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Command2 
      Cancel          =   -1  'True
      Caption         =   "取  消"
      Height          =   495
      Left            =   4080
      TabIndex        =   4
      Top             =   2280
      Width           =   1215
   End
   Begin VB.Frame Frame1 
      Caption         =   "请选择要隐藏的驱动器"
      Height          =   2895
      Left            =   120
      TabIndex        =   5
      Top             =   120
      Width           =   3735
      Begin VB.ListBox List1 
         Height          =   1320
         Left            =   120
         Style           =   1  'Checkbox
         TabIndex        =   0
         Top             =   360
         Width           =   3495
      End
      Begin VB.CommandButton Command4 
         Caption         =   "全  否"
         Height          =   495
         Left            =   2160
         TabIndex        =   2
         Top             =   2160
         Width           =   1215
      End
      Begin VB.CommandButton Command3 
         Caption         =   "全  选"
         Height          =   495
         Left            =   360
         TabIndex        =   1
         Top             =   2160
         Width           =   1215
      End
   End
   Begin VB.CommandButton Command1 
      Caption         =   "设  置"
      Default         =   -1  'True
      Height          =   495
      Left            =   4080
      TabIndex        =   3
      Top             =   1320
      Width           =   1215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'欢迎下载本程序，有问题或建议请Email至[e-mail]
'欢迎访问我的主页：Http://mynetclub.myrice.com
Option Explicit
Private Const REG_SZ = 1
Private Const REG_DWORD = 4
Private Const HKEY_USERS = &H80000003
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
    Dim lValue As Long
    Dim sValue As String
    Select Case lType
        Case REG_SZ
            sValue = vValue
            SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
        Case REG_DWORD
            lValue = vValue
            SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
        End Select
End Function
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
    Dim mh As Long
    Dim lrc As Long
    Dim lType As Long
    Dim lValue As Long
    Dim sValue As String
    lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, mh)
    If lrc = 0 Then
        Select Case lType
            Case REG_SZ:
                sValue = String(mh, 0)
                lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, mh)
                If lrc = 0 Then
                    vValue = Left$(sValue, mh)
                Else
                    vValue = 0
                End If
            Case REG_DWORD:
                lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, mh)
                If lrc = 0 Then
                    vValue = lValue
                Else
                    vValue = 0
                End If
        End Select
    Else
        vValue = 0
    End If
End Function
Function SetKeyValue(lPKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
    Dim lRetVal As Long
    Dim hKey As Long
    lRetVal = RegOpenKeyEx(lPKey, sKeyName, 0, &H3F, hKey)
    lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
    RegCloseKey (hKey)
End Function
Function QueryValue(lPKey As Long, sKeyName As String, sValueName As String)
    Dim lRetVal As Long
    Dim hKey As Long
    Dim vValue As Variant
    lRetVal = RegOpenKeyEx(lPKey, sKeyName, 0, &H3F, hKey)
    lRetVal = QueryValueEx(hKey, sValueName, vValue)
    QueryValue = vValue
    RegCloseKey (hKey)
End Function
Private Sub Command1_Click()
    Dim I As Integer, J As Integer, K As Integer, DD As Long
    Dim dDrv(30) As String, DSet(30) As Long
    K = 0
    For I = 65 To 90
        For J = 0 To List1.ListCount - 1
            If Chr(I) = Left(List1.List(J), 1) Then
                DSet(K) = 2 ^ (I - 65)
                K = K + 1
                Exit For
            End If
        Next J
    Next I
    DD = 0
    For I = 0 To List1.ListCount - 1
        If List1.Selected(I) = True Then
            DD = DD + DSet(I)
        End If
    Next I
    SetKeyValue HKEY_USERS, ".Default\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoDrives", DD, REG_DWORD
    Unload Me
End Sub
Private Sub Command2_Click()
    Unload Me
End Sub
Private Sub Command3_Click()
    Dim I As Integer
    For I = 0 To List1.ListCount - 1
        List1.Selected(I) = True
    Next I
End Sub
Private Sub Command4_Click()
    Dim I As Integer
    For I = 0 To List1.ListCount - 1
        List1.Selected(I) = False
    Next I
End Sub
Private Sub Form_Load()
    Dim I As Integer, J As Integer, K As Integer, dDrv As Integer, dT As String
    Dim Yc As Long, H(30) As String, Ycb As Long
    For I = 0 To 25
    dT = Chr$(I + 65) & ":\"
    dDrv = GetDriveType(dT)
    dT = Left(dT, 2)
    Select Case dDrv
        Case 2
            List1.AddItem dT & "    " & "软盘驱动器"
        Case 3
            List1.AddItem dT & "    " & "硬盘驱动器"
        Case 5
            List1.AddItem dT & "    " & "光盘驱动器"
    End Select
    Next I
    Yc = QueryValue(HKEY_USERS, ".Default\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoDrives")
    Ycb = Yc
    If Yc = 0 Then
        K = -1
    Else
        For I = 1 To 26
            If Ycb < 2 ^ I Then
                K = I - 1
                H(I - 1) = Chr$(64 + I)
                Exit For
            Else
                If (Yc Mod 2 ^ I) <> 0 Then
                    H(I - 1) = Chr$(64 + I)
                    Yc = Yc - 2 ^ (I - 1)
                Else
                    H(I - 1) = "0"
                End If
            End If
        Next I
    End If
    If K = -1 Then
        For I = 0 To List1.ListCount - 1
            List1.Selected(I) = False
        Next I
    Else
        For I = 0 To K
            For J = 0 To List1.ListCount - 1
                If H(I) = Left(List1.List(J), 1) Then
                    List1.Selected(J) = True
                    Exit For
                End If
            Next J
        Next I
    End If
End Sub