Option Explicit

Public 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

Public Function LwSerialNumber(Lw As String) As String
  Dim FileSystem As String
  Dim SerNum As Long
  Dim MaxLen As Long
  Dim Flags As Long
  Dim VolSize As Long
  Dim VolLabel As String
  Dim SerialNumber As String

  Lw = LCase$(left$(Lw, 1))

  If Lw = "\" Then
    Exit Function
  Else
    Lw = Lw & ":\"
  End If

  FileSystem = Space$(256)
  If GetVolumeInformation(Lw, VolLabel, VolSize, SerNum, _
          MaxLen, Flags, FileSystem, Len(FileSystem)) <> 0 Then

    SerialNumber = Trim(Hex(SerNum))
    SerialNumber = _
          String(8 - Len(SerialNumber), "0") & SerialNumber
    SerialNumber = _
          left$(SerialNumber, 4) & "-" & right$(SerialNumber, 4)

    LwSerialNumber = SerialNumber
  Else
    LwSerialNumber = "- keine -"
  End If
End Function

Option Explicit

Private Sub Drive1_Change()
  Dim VolumeSerialNumber As Long
  Dim VolumeNameBuffer As String
  Dim MaximumComponentLength As Long
  Dim FileSystemFlags As Long
  Dim FileSystemNameBuffer As String

  VolumeNameBuffer = Space(256)
  FileSystemNameBuffer = Space(256)

  GetVolumeInformation left(Drive1.Drive, 1) & ":\", _
        VolumeNameBuffer, Len(VolumeNameBuffer), _
        VolumeSerialNumber, MaximumComponentLength, _
        FileSystemFlags, FileSystemNameBuffer, _
        Len(FileSystemNameBuffer)

  If left$(VolumeNameBuffer, 1) = Chr(0) Then
    Label1(1).Caption = "- keine -"
  Else
    Label1(1).Caption = VolumeNameBuffer
  End If

  Label1(3).Caption = LwSerialNumber(Drive1.Drive)
End Sub