哪位高手知道，vb中不用ocx 和 dll 读取硬盘物理序列号(不是用getvolumeinfomation)!谢谢！

Question

你这个帖子白发了，不会有答案的。
内嵌汇编一般是很难的，根本不实用。或者，我用VC写个EXE，然后在Basic里调用可以吗？不过到头来VC程序还要用GetVolumeInformation …… 呵呵

Answer 1

对了，你试试 FSO 对象，可以！fso.getvolume，呵呵

Answer 2

搞定！看代码！
Sub ShowDriveList()
    On Error Resume Next
    Dim fs
    Dim s As String
    Dim a As Scripting.Drive
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    For Each a In fs.Drives
        s = s & a.DriveLetter & " - " & a.SerialNumber & vbCrLf
    Next
    MsgBox s
End Sub

Answer 3

用 GetVolumeInfo API 
=============================================================
Private mRootName As String
Private lpVolumeNameBuffer As String
Private nVolumeNameSize As Long
Private lpVolumeSerialNumber As Long
Private lpMaximumComponentLength As Long
Private lpFileSystemFlags As Long
Private lpFileSystemNameBuffer As String
Private nFileSystemNameSize As Long'\\ API call declarations...
Private 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 LongPrivate Declare Function SetVolumeLabel Lib "kernel32" _
Alias "SetVolumeLabelA" (ByVal lpRootPathName As String, _
ByVal lpVolumeName As String) As Long
Public Enum FileSystemFlags
FILE_CASE_SENSITIVE_SEARCH = &H1
FILE_CASE_PRESERVED_NAMES = &H2
FILE_UNICODE_ON_DISK = &H4
FILE_PERSISTENT_ACLS = &H8
FILE_FILE_COMPRESSION = &H10
FILE_VOLUME_QUOTAS = &H20
FILE_SUPPORTS_SPARSE_FILES = &H40
FILE_SUPPORTS_REPARSE_POINTS = &H80
FILE_SUPPORTS_REMOTE_STORAGE = &H100
FILE_VOLUME_IS_COMPRESSED = &H8000
FILE_SUPPORTS_OBJECT_IDS = &H10000
FILE_SUPPORTS_ENCRYPTION = &H20000
End EnumPrivate bChanged As Boolean
Friend Property Get Changed() As Boolean
Changed = bChanged
End Property
Friend Property Let Changed(ByVal newChanged As Boolean)
bChanged = newChanged
End PropertyPublic Property Get CasePreserved() As BooleanCall RefreshVolumeInfo
CasePreserved = (lpFileSystemFlags And FILE_CASE_PRESERVED_NAMES)End PropertyPublic Property Get CaseSensitive() As BooleanCall RefreshVolumeInfo
CaseSensitive = (lpFileSystemFlags And FILE_CASE_SENSITIVE_SEARCH)End Property
Public Property Get Compressed() As BooleanCall RefreshVolumeInfo
Compressed = (lpFileSystemFlags And FILE_VOLUME_IS_COMPRESSED)End PropertyPublic Property Get Encryption() As BooleanCall RefreshVolumeInfo
Encryption = (lpFileSystemFlags And FILE_SUPPORTS_ENCRYPTION)End PropertyPublic Property Get FileCompression() As BooleanCall RefreshVolumeInfo
FileCompression = (lpFileSystemFlags And FILE_FILE_COMPRESSION)End PropertyPublic Property Get FileSystemName() As StringCall RefreshVolumeInfo
If InStr(lpFileSystemNameBuffer, Chr$(0)) > 0 Then
FileSystemName = Left$(lpFileSystemNameBuffer, InStr(lpFileSystemNameBuffer, Chr$(0)) - 1)
End IfEnd PropertyPublic Property Get ObjectIds() As BooleanCall RefreshVolumeInfo
ObjectIds = (lpFileSystemFlags And FILE_SUPPORTS_OBJECT_IDS)End PropertyPublic Property Get PersistantACLs() As BooleanCall RefreshVolumeInfo
PersistantACLs = (lpFileSystemFlags And FILE_PERSISTENT_ACLS)End PropertyPrivate Sub RefreshVolumeInfo()Dim lret As Long'\\ Initialise the buffers
lpVolumeNameBuffer = String$(1024, 0)
nVolumeNameSize = Len(lpVolumeNameBuffer)
lpFileSystemNameBuffer = String$(1024, 0)
nFileSystemNameSize = Len(lpFileSystemNameBuffer)
lret = GetVolumeInformation(mRootName, lpVolumeNameBuffer, nVolumeNameSize, lpVolumeSerialNumber, lpMaximumComponentLength, lpFileSystemFlags, lpFileSystemNameBuffer, nFileSystemNameSize)
If Err.LastDllError <> 0 Then
ReportError Err.LastDllError, "ApiVolume:Name (Let)", GetLastSystemError
End IfEnd SubPublic Property Get RemoteStorage() As BooleanCall RefreshVolumeInfo
RemoteStorage = (lpFileSystemFlags And FILE_SUPPORTS_REMOTE_STORAGE)End PropertyPublic Property Get ReparsePoints() As BooleanCall RefreshVolumeInfo
ReparsePoints = (lpFileSystemFlags And FILE_SUPPORTS_REPARSE_POINTS)End PropertyPublic Property Get RootName() As StringRootName = mRootNameEnd PropertyPublic Property Let RootName(ByVal newname As String)Dim lret As Long'\\ If the name changes get all the other volume info...
If newname <> mRootName Then
mRootName = newname
End IfEnd PropertyPublic Property Get SerialNumber() As LongCall RefreshVolumeInfo
SerialNumber = lpVolumeSerialNumberEnd PropertyPublic Property Get SparseFiles() As BooleanCall RefreshVolumeInfo
SparseFiles = (lpFileSystemFlags And FILE_SUPPORTS_SPARSE_FILES)End PropertyPublic Property Get UnicodeFileTable() As BooleanCall RefreshVolumeInfo
UnicodeFileTable = (lpFileSystemFlags And FILE_UNICODE_ON_DISK)End PropertyPublic Property Let VolumeName(ByVal newname As String)Dim lret As Longlret = SetVolumeLabel(mRootName, newname)
If Err.LastDllError Then
ReportError Err.LastDllError, "ApiVolume:Volumename (Let)", GetLastSystemError
End IfEnd PropertyPublic Property Get VolumeName() As StringCall RefreshVolumeInfo
If InStr(lpVolumeNameBuffer, Chr$(0)) > 0 Then
VolumeName = Left$(lpVolumeNameBuffer, InStr(lpVolumeNameBuffer, Chr$(0)) - 1)
End IfEnd Property
Public Property Get VolumeQuotas() As BooleanCall RefreshVolumeInfo
VolumeQuotas = (lpFileSystemFlags And FILE_VOLUME_QUOTAS)End Property

Answer 4

搞定！看代码！
Sub ShowDriveList()
On Error Resume Next
Dim fs
Dim s As String
Dim a As Scripting.Drive
Set fs = CreateObject("Scripting.FileSystemObject")For Each a In fs.Drives
s = s & a.DriveLetter & " - " & a.SerialNumber & vbCrLf
Next
MsgBox s
End Sub补充：需要引用Script库，否则要改代码：
Sub ShowDriveList()
On Error Resume Next
Dim fs
Dim s As String
Dim a
Set fs = CreateObject("Scripting.FileSystemObject")For Each a In fs.Drives
s = s & a.DriveLetter & " - " & a.SerialNumber & vbCrLf
Next
MsgBox s
End Sub 

Answer 5

嘿嘿，要求太高了。
自己写个驱动挂上。就象HWiNFO一样，就知道了。其他没办法

Answer 6

用DeviceIOControl函数,不过在98下需要smartvsd.vxd放在system\iosubsys目录下

Answer 7

恐怕我这个又市效又明了.而且绝非卷标
磁盘序列号,每次格式化后生成,而且绝不重复,可以用来加密.在vb中我是这样获取它的:
  在窗体上放一个label放一个command
  然后粘上这一段代码,就可以获得d:盘的序列号:
  Private  Declare  Function  GetVolumeInformation  Lib  "kernel32.dll"  Alias  "GetVolumeInformationA"  (ByVal  lpRootPathName  As  String,  ByVal  lpVolumeNameBuffer  As  String,  ByVal  nVolumeNameSize  As  Integer,  lpVolumeSerialNumber  As  Long,  lpMaximumComponentLength  As  Long,  lpFileSystemFlags  As  Long,  ByVal  lpFileSystemNameBuffer  As  String,  ByVal  nFileSystemNameSize  As  Long)  As  Long
  
  
  Function  GetSerialNumber(sRoot  As  String)  As  Long
          Dim  lSerialNum  As  Long
          Dim  R  As  Long
          Dim  sTemp1  As  String,  sTemp2  As  String
          strLabel  =  String$(255,  Chr$(0))
          strType  =  String$(255,  Chr$(0))
          R  =  GetVolumeInformation(sRoot,  strLabel,  Len(strLabel),  lSerialNum,  0,  0,  strType,  Len(strType))
          GetSerialNumber  =  lSerialNum
  End  Function
  
  Private  Sub  Command1_Click()
          i  =  GetSerialNumber("d:\")
          Label1.Caption  =  "序列号为"  +  CStr(i)
  End  Sub 
 
 
 
 

Answer 8

各位都是小题大作，实现的都是逻辑序列号的取，根本是答非所问。
我有用VC做的DLL解决方法，可有时候系统太忙时不能正确读取物理序列号。