如何使用VB 6讀取HDD卷序列號？

Question

如何使用VB 6讀取HDD卷序列號，但不使用任何ActiveX控件或第三方加載項？

Answer 1

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)) 

來源：http://www.devx.com/tips/Tip/15908

Answer 2

下面的示例提供了驅動器的串行您的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 

Answer 3

下面的示例無需API。

Public Function GetSerialNumber(ByVal sDrive As String) As String 
    On Error Resume Next 
    Open "Vol.bat" For Output As 1 
     Print #1, "@vol %1%>DSN" 
    Close 
    Kill "DSN" 
    Shell ("Vol.bat " + sDrive) 
    Do 
     Open "DSN" For Input As 1 
     Input #1, GetSerialNumber 
     Input #1, GetSerialNumber 
     Close 
    Loop While GetSerialNumber = "" 
    GetSerialNumber = Right$(GetSerialNumber, 9) 
    Kill "Vol.bat" 
    Kill "DSN" 
End Function