[VBnet Disk/Drive] GetVolumeInformation: Get Disk Volume Label & Serial Number


	Visual Basic Disk/Drive API Routines GetVolumeInformation: Get Disk Volume Label & Serial Number

Posted:	Sunday January 26, 1997
Updated:	Monday December 26, 2011

Applies to:	VB4-32, VB5, VB6
Developed with:	VB4-32, Windows 95
OS restrictions:	None
Author:	VBnet - Randy Birch

Prerequisites

None.

Although the Dir() function can retrieve a disk volume label, this code demonstrates an alternate method for obtaining the label, and how to get the disk serial number using an API call. Note however that this serial number is format-dependant, and will change if the user reformats the drive.

BAS Module Code

None.

Form Code

To a project form add two command buttons (Command1 and Command2) as indicated in the illustration. Add the following to the form:

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Declare Function GetVolumeInformation Lib "kernel32" _
   Alias "GetVolumeInformationA" _
  (ByVal lpRootPathName As String, _
   ByVal lpVolumeNameBuffer As String, _
   ByVal nVolumeNameSize As Long, _
   lpVolumeSerialNumber As Long, _
   lpMaximumComponentLength As Long, _
   lpFileSystemFlags As Long, _
   ByVal lpFileSystemNameBuffer As String, _
   ByVal nFileSystemNameSize As Long) As Long
    
    
    
Private Sub Form_Load()

   Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
  
End Sub


Private Sub Command2_Click()
   
   Unload Me
   
End Sub


Private Sub Command1_Click()

   Dim PathName As String
   Dim DrvVolumeName As String
   Dim DrvSerialNo As String

  'the drive to check 
   PathName$ = "d:\"
  
   rgbGetVolume PathName, DrvVolumeName, DrvSerialNo

  'show the results 
   Print
   Print "  Drive Statistics for  ", ":  "; UCase$(PathName)
   Print
   Print "  Volume Label", ":  "; DrvVolumeName
   Print "  Volume Serial No", ":  "; DrvSerialNo

End Sub


Private Sub rgbGetVolume(PathName As String, _
                         DrvVolumeName As String, _
                         DrvSerialNo As String)
 
  'create working variables  
  'to keep it simple, use dummy variables for info
  'we're not interested in right now
   Dim r As Long
   Dim pos As Integer
   Dim hword As Long
   Dim HiHexStr As String
   Dim lword As Long 
   Dim LoHexStr As String
   Dim VolumeSN As Long
   Dim MaxFNLen As Long

   Dim UnusedStr As String
   Dim UnusedVal1 As Long
   Dim UnusedVal2 As Long

  'pad the strings   
   DrvVolumeName = Space$(14)
   UnusedStr = Space$(32)

  'do what it says 
   r = GetVolumeInformation(PathName, _
                            DrvVolumeName, _
                            Len(DrvVolumeName), _
                            VolumeSN&, _
                            UnusedVal1, UnusedVal2, _
                            UnusedStr, Len(UnusedStr))


  'error check  
   If r = 0 Then Exit Sub

  'determine the volume label  
   pos = InStr(DrvVolumeName, Chr$(0))
   If pos Then DrvVolumeName = Left$(DrvVolumeName, pos - 1)
   If Len(Trim$(DrvVolumeName)) = 0 Then DrvVolumeName = "(no label)"

  'determine the drive volume id  
   hword = HiWord(VolumeSN) 
   lword = LoWord(VolumeSN) 
   HiHexStr = Format$(Hex(hword), "0000")
   LoHexStr = Format$(Hex(lword), "0000")
 
   DrvSerialNo = HiHexStr & "-" & LoHexStr

End Sub


Private Function HiWord(dw As Long) As Integer
  
    HiWord = (dw And &HFFFF0000) \ &H10000

End Function
  

Private Function LoWord(dw As Long) As Integer
  
    If dw And &H8000& Then
        LoWord = dw Or &HFFFF0000
    Else
        LoWord = dw And &HFFFF&
    End If
    
End Function

Comments

PayPal Link