Postup:
Otevřete nový projekt, připojte
do něj formulář a modul. Na formulář připojte tlačítko s názvem
cmdVolumeInfo
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
|