VolSerialDisk

Option Explicit

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

'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