'Globals
'****************************************************************
'Windows API/Global Declarations for :Determine the Disk Volume Label and Serial Number
'****************************************************************


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

'Code
'****************************************************************
' Name: Determine the Disk Volume Label and Serial Number
' Description:Although the Dir() function can retrieve a dis
'     k volume label, this code demonstrates an alternate method f
'     or obtaining the label, and how to get the disk serial numbe
'     r using an API call.
' By: VB Net (Randy Birch)
'
' Inputs:None
' Returns:None
' Assumes:Start a new project, and to the form add 2 command buttons (cmdVolumeInfo and cmdEnd)
' Side Effects:None
'
'Code provided by Planet Source Code(tm) 'as is', without
'     warranties as to performance, fitness, merchantability,
'     and any other warranty (whether expressed or implied).
'****************************************************************

Add the following code to Form1.

Private Sub Form_Load()

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


Private Sub cmdEnd_Click()

       Unload Me
End

End Sub


Private Sub cmdVolumeInfo_Click()

        Dim r As Long
        Dim PathName As String
        Dim DrvVolumeName As String
        Dim DrvSerialNo As String
        
       '      'the drive to check
        PathName$ = "d:\"
        
        rgbGetVolumeInformationRDI 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 rgbGetVolumeInformationRDI(PathName$, DrvVolumeName$, DrvSerialNo$)

        
       '      '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 HiWord As Long
        Dim HiHexStr As String
        Dim LoWord 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 
        HiWord& = GetHiWord(VolumeSN&) And &HFFFF&
        LoWord& = GetLoWord(VolumeSN&) And &HFFFF&
        
        HiHexStr$ = Format$(Hex(HiWord&), "0000")
        LoHexStr$ = Format$(Hex(LoWord&), "0000")
        
        DrvSerialNo$ = HiHexStr$ & "-" & LoHexStr$
End Sub


Function GetHiWord(dw As Long) As Integer

        

              If dw& And &H80000000 Then
                      GetHiWord% = (dw& \ 65535) - 1
              Else: GetHiWord% = dw& \ 65535
              End If

End Function

 

Function GetLoWord(dw As Long) As Integer

        

              If dw& And &H8000& Then
                      GetLoWord% = &H8000 Or (dw& And &H7FFF&)
              Else: GetLoWord% = dw& And &HFFFF&
              End If

End Function