ZjiÜt∞nφ nßzv∙ a sΘriovΘho Φφsla disku

Do modulu zapiÜte nßsledujφcφ deklarace:
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

Nynφ ve formulß°i definujte nßsledujφcφ procedury:
Private Sub rgbGetVolumeInformationRDI(PathName$, DrvVolumeName$, DrvSerialNo$)

    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

    DrvVolumeName$ = Space$(14) UnusedStr$ = Space$(32)

    r& = GetVolumeInformation(PathName$, DrvVolumeName$, Len(DrvVolumeName$), VolumeSN&, UnusedVal1&,     UnusedVal2&, UnusedStr$, Len(UnusedStr$))

    If r& = 0 Then Exit Sub

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

    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

Na udßlost Click tlaΦφtka cmdVolumeInfo vlo₧te nßsledujφcφ k≤d:
Private Sub cmdVolumeInfo_Click()

    Dim r As Long
    Dim PathName As String
    Dim DrvVolumeName As String
    Dim DrvSerialNo As String

    'Disk pro otestovßnφ
    PathName$ = "D:\"
    rgbGetVolumeInformationRDI PathName$, DrvVolumeName$, DrvSerialNo$

    Print
    Print " Statistika pro disk ", ": "; UCase$(PathName$)
    Print
    Print " Nßzev disku", ": "; DrvVolumeName$
    Print " SΘriovΘ Φφslo", ": "; DrvSerialNo$

End Sub

Zp∞t