ActiveX コントロールやサードパーティのアドオンを使用せずに、VB 6 を使用して HDD ボリュームのシリアル番号を読み取るにはどうすればよいですか?
9215 次
3 に答える
7
Private Declare Function GetVolumeInformation _
Lib "kernel32" Alias "GetVolumeInformationA" _
(ByVal lpRootPathName As String, _
ByVal pVolumeNameBuffer 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
Public Function GetSerialNumber( _
ByVal sDrive As String) As Long
If Len(sDrive) Then
If InStr(sDrive, "\\") = 1 Then
' Make sure we end in backslash for UNC
If Right$(sDrive, 1) <> "\" Then
sDrive = sDrive & "\"
End If
Else
' If not UNC, take first letter as drive
sDrive = Left$(sDrive, 1) & ":\"
End If
Else
' Else just use current drive
sDrive = vbNullString
End If
' Grab S/N -- Most params can be NULL
Call GetVolumeInformation( _
sDrive, vbNullString, 0, GetSerialNumber, _
ByVal 0&, ByVal 0&, vbNullString, 0)
End Function
呼び出すには:
Dim Drive As String
Drive = InputBox("Enter drive for checking SN")
MsgBox Hex$(GetSerialNumber(Drive))
于 2012-08-24T00:49:30.440 に答える
1
次のサンプルは、EXE があるドライブのシリアルを提供します。
'APi declaration
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
Sub subHDsn()
Dim TempAPi, VolumeSerial As Long
Dim strPATH As String
On Error Resume Next
TempAPi = 0
VolumeSerial = 0
If App.Path Like "*:*" Then
'checking whether the drive is local or mapped
strPATH = Left(App.Path, 3)
Else
'if it's a UNC
strPATH = Left(App.Path, InStr((InStr(3, App.Path, "\") + 1), App.Path, "\"))
End If
'call API
TempAPi = GetVolumeInformation(strPATH, VolumeName, 100, VolumeSerial, 100, FileSystemFlags, FileSystemName, 100)
If TempAPi = 0 Then
MsgBox "Error calling API!", 16
End
End If
'convert from HeX
HDsn = Hex(VolumeSerial)
End Sub
于 2014-02-28T12:53:09.960 に答える