Option Compare Database
      Option Explicit      

      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 cmdVolumeInfo_Click()
        Dim r As Long
        Dim PathName As String
        Dim DrvVolumeName As String
        Dim DrvSerialNo As String

        'the drive to check
        PathName$ = "C:\"      
        
        rgbGetVolume PathName, DrvVolumeName, DrvSerialNo
        'show the results
        Debug.Print
        Debug.Print "  Drive Statistics for  ", ":  "; UCase$(PathName)
        Debug.Print
        Debug.Print "  Volume Label", ":  "; DrvVolumeName
        Debug.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 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&

      '------ poprawka KN -------

       '  HiHexStr = Format$(Hex(HiWord), "0000")
       '  LoHexStr = Format$(Hex(LoWord), "0000")

        HiHexStr = Right$("0000" & Hex(HiWord), 4)
        LoHexStr = Right$("0000" & Hex(LoWord), 4)

      '--- koniec poprawki KN ---

        DrvSerialNo = HiHexStr & "-" & LoHexStr
      End Sub      

      Private Function GetHiWord(dw As Long) As Integer
        If dw And &H80000000 Then
            GetHiWord = (dw \ 65535) - 1
        Else
            GetHiWord = dw \ 65535
        End If
      End Function      

      Private 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