GFGetDriveInfo/GFGetDriveInfo.frm

VERSION 5.00
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4695
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4695
   StartUpPosition =   3 'Windows‑Standard
   Begin VB.TextBox Text1
      Height          =   315
      Left            =   120
      TabIndex        =   0
      Text            =   "C:\"
      Top             =   1020
      Width           =   1875
   End
   Begin VB.CommandButton Command1
      Caption         =   "Get Drive Type"
      Height          =   315
      Left            =   2160
      TabIndex        =   1
      Top             =   1020
      Width           =   2415
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2000, 2004 by Louis. Get extended information about a drive on local machine.
'
'Downloaded from www.louis‑coder.com.
'Simple example demonstrating how to get a string containing the type
'(type names invented by Louis Coder) of a drive.
'
'GetDiskSerialNumber (source: www.vb‑world.net)
Private Declare Function GetVolumeInformation Lib "kernel32.dll" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Integer, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
'GFGetDriveInfo
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
'GFGetDriveInfo
Private Type DRIVEINFO
    DriveName As String 'e.g. 'd:\'
    DriveSerialNumber As String
    DriveTypeDescription As String 'e.g. 'hd', 'cdrom', 'network', etc.
End Type
'GFGetDriveInfo
Private Const DRIVE_UNKNOWN = 0& 'Winbase.h
Private Const DRIVE_NO_ROOT_DIR = 1& 'Winbase.h
Private Const DRIVE_REMOVABLE = 2&
Private Const DRIVE_FIXED = 3&
Private Const DRIVE_REMOTE = 4&
Private Const DRIVE_CDROM = 5&
Private Const DRIVE_RAMDISK = 6&

Private Sub Command1_Click()
    'on error resume next
    Dim DRIVEINFOVar As DRIVEINFO
    Call GFGetDriveInfo(Text1.Text, DRIVEINFOVar)
    Debug.Print DRIVEINFOVar.DriveName
    Debug.Print DRIVEINFOVar.DriveSerialNumber
    Debug.Print DRIVEINFOVar.DriveTypeDescription
    If (DRIVEINFOVar.DriveTypeDescription = "cdrom") Then MsgBox "No CDs in here please !", vbOKOnly + vbInformation
    If (DRIVEINFOVar.DriveTypeDescription = "network") Then MsgBox "Let's start a LAN‑party !", vbOKOnly + vbInformation
End Sub

Private Sub GFGetDriveInfo(ByVal DriveName As String, ByRef DRIVEINFOVar As DRIVEINFO)
    'on error resume next 'NOTE: it is not checked if DriveName is valid.
    DRIVEINFOVar.DriveName = DriveName
    DRIVEINFOVar.DriveSerialNumber = GetDiskSerialNumber(DriveName)
    DRIVEINFOVar.DriveTypeDescription = GFGetDriveInfo_GetDriveTypeDescription(DriveName)
End Sub

Private Function GetDiskSerialNumber(ByVal DiskName As String) As String 'used by GFGetDriveInfo
    On Error Resume Next 'copied from NN99 (12‑27‑2000)
    Dim SerialNumber As Long
    Dim Temp As Long
    Dim Tempstr1$
    Dim Tempstr2$
    'verify
    Select Case Len(DiskName)
    Case 1
        DiskName = DiskName + ":\"
    Case 2
        DiskName = DiskName + "\"
    Case Is > 3
        If Not (Left$(DiskName, 2) = "\\") Then
            DiskName = Left$(DiskName, 3) 'not located on a network machine
        Else
            DiskName = DiskName 'located on network machine
        End If
    End Select
    'begin
    Tempstr1$ = String$(255, Chr$(0))
    Tempstr2$ = String$(255, Chr$(0))
    Temp = GetVolumeInformation(DiskName, Tempstr1$, Len(Tempstr1$), SerialNumber, 0, 0, Tempstr2$, Len(Tempstr2$))
    GetDiskSerialNumber = LTrim$(Str$(SerialNumber))
End Function

Private Function GFGetDriveInfo_GetDriveTypeDescription(ByVal DriveName As String) As String
    'on error resume next 'returns a string describing the type of the passed drive
    Dim Description As String
    Select Case GetDriveType(DriveName)
    Case DRIVE_UNKNOWN
        Description = "unknown"
    Case DRIVE_NO_ROOT_DIR
        Description = "ERROR"
    Case DRIVE_REMOVABLE
        Description = "removable"
    Case DRIVE_FIXED
        Description = "hd"
    Case DRIVE_REMOTE
        Description = "network"
    Case DRIVE_CDROM
        Description = "cdrom"
    Case DRIVE_RAMDISK
        Description = "ramdisk"
    Case Else
        Description = "ERROR"
    End Select
    GFGetDriveInfo_GetDriveTypeDescription = Description
End Function


[END OF FILE]