HD serial fails...

04/12/2008 - 01:14 von Jeff Frey | Report spam
This code seemed stable to me, but now it turned out it isn't...

Private Function GetDiskSignature(ByVal uDiskName As String) As Long
On Error GoTo CatchErr

' This function returns all the properties of a specific device
Dim DeviceSet As SWbemObjectSet
Dim Device As SWbemObject
Dim iCount As Integer
Dim vTemp As Variant
Dim sTemp As String

On Error Resume Next

' Set theSWbemObjectSet object
Set DeviceSet = GetObject("winmgmts:").InstancesOf("Win32_DiskDrive")
For Each Device In DeviceSet
' Check if the current device in the chosen device
If Device.Caption = uDiskName Then
' Get all the properties of the chosen device
For Each vTemp In Device.Properties_
On Error Resume Next
If vTemp.Value <> vbNull Then
If Len(vTemp) > 0 Then
If vTemp.Name = "Signature" Then
Debug.Print vTemp.Name
GetDiskSignature = vTemp.Value
Exit Function
End If
End If
End If
Next
End If
Next Device

Exit Function
CatchErr
'some stuff... fallback on Windows serial...
End Function

Within the last 5 days 2 user complained that it's not working anymore.
Do you see any error in my function?

Thank you,
Jeff Frey
 

Lesen sie die antworten

#1 Jeff Frey
04/12/2008 - 01:27 | Warnen spam
That's how I get the main drive's name which is used in
GetDiskSignature(ByVal uDiskName As String) As Long:

Private Function GetPrimaryDiskDriveName() As String
On Error GoTo CatchErr

Dim DeviceSet As wbemscripting.SWbemObjectSet
Dim Device As SWbemObject

Dim iCount As Integer
Dim sTemp As String
Dim sDeviceName$
sDeviceName = "Win32_DiskDrive"

On Error Resume Next
' Set the SWbemObjectSet object
Set DeviceSet = GetObject("winmgmts:").InstancesOf(sDeviceName)

' Get the devices captions
For Each Device In DeviceSet
If Device.Index = 0 Then '/* Use first hd found */
GetPrimaryDiskDriveName = Device.Caption
End If
Next Device

Exit Function
CatchErr:
'Some stuff like fallbacks

Ähnliche fragen