Get HDD (and NOT Volume) Serial Number on Vista Ultimate 64 bit - windows-vista

I was once looking for getting the HDD serial number without using WMI, and I found it. The code I found and posted on StackOverFlow.com works very well on 32 bit Windows, both XP and Vista. The trouble only begins when I try to get the serial number on 64 bit OSs (Vista Ultimate 64, specifically). The code returns String.Empty, or a Space all the time.
Anyone got an idea how to fix this?
EDIT:
I used the tools Dave Cluderay suggested, with interesting results:
Here is the output from DiskId32, on Windows XP SP2 32-bit:
To get all details use "diskid32 /d"
Trying to read the drive IDs using physical access with admin rights
Drive 0 - Primary Controller - - Master drive
Drive Model Number________________: [MAXTOR STM3160215AS]
Drive Serial Number_______________: [ 6RA26XK3]
Drive Controller Revision Number__: [3.AAD]
Controller Buffer Size on Drive___: 2097152 bytes
Drive Type________________________: Fixed
Drive Size________________________: 160041885696 bytes
Trying to read the drive IDs using the SCSI back door
Drive 4 - Tertiary Controller - - Master drive
Drive Model Number________________: [MAXTOR STM3160215AS]
Drive Serial Number_______________: [ 6RA26XK3]
Drive Controller Revision Number__: [3.AAD]
Controller Buffer Size on Drive___: 2097152 bytes
Drive Type________________________: Fixed
Drive Size________________________: 160041885696 bytes
Trying to read the drive IDs using physical access with zero rights
**** STORAGE_DEVICE_DESCRIPTOR for drive 0 ****
Vendor Id = []
Product Id = [MAXTOR STM3160215AS]
Product Revision = [3.AAD]
Serial Number = []
**** DISK_GEOMETRY_EX for drive 0 ****
Disk is fixed
DiskSize = 160041885696
Trying to read the drive IDs using Smart
Drive 0 - Primary Controller - - Master drive
Drive Model Number________________: [MAXTOR STM3160215AS]
Drive Serial Number_______________: [ 6RA26XK3]
Drive Controller Revision Number__: [3.AAD]
Controller Buffer Size on Drive___: 2097152 bytes
Drive Type________________________: Fixed
Drive Size________________________: 160041885696 bytes
Hard Drive Serial Number__________: 6RA26XK3
Hard Drive Model Number___________: MAXTOR STM3160215AS
And DiskId32 run on Windows Vista Ultimate 64-bit:
To get all details use "diskid32 /d"
Trying to read the drive IDs using physical access with admin rights
Trying to read the drive IDs using the SCSI back door
Trying to read the drive IDs using physical access with zero rights
**** STORAGE_DEVICE_DESCRIPTOR for drive 0 ****
Vendor Id = [MAXTOR S]
Product Id = [TM3160215AS]
Product Revision = [3.AA]
Serial Number = []
**** DISK_GEOMETRY_EX for drive 0 ****
Disk is fixed
DiskSize = 160041885696
Trying to read the drive IDs using Smart
Hard Drive Serial Number__________:
Hard Drive Model Number___________:
Notice how much lesser the information is on Vista, and how the Serial Number is not returned. Also the other tool, EnumDisk, refers to my hard disks on Vista as "SCSI" as opposed to "ATA" on Windows XP.
Any ideas?
EDIT 2:
I'm posting the results from EnumDisks:
On Windows XP SP2 32-bit:
Properties for Device 1
Device ID: IDE\DiskMAXTOR_STM3160215AS_____________________3.AAD___
Adapter Properties
------------------
Bus Type : ATA
Max. Tr. Length: 0x20000
Max. Phy. Pages: 0xffffffff
Alignment Mask : 0x1
Device Properties
-----------------
Device Type : Direct Access Device (0x0)
Removable Media : No
Product ID : MAXTOR STM3160215AS
Product Revision: 3.AAD
Inquiry Data from Pass Through
------------------------------
Device Type: Direct Access Device (0x0)
Vendor ID : MAXTOR S
Product ID : TM3160215AS
Product Rev: 3.AA
Vendor Str :
*** End of Device List ***
And on Vista 64 Ultimate:
Properties for Device 1
Device ID: SCSI\DiskMAXTOR_STM3160215AS_____3.AA
Adapter Properties
------------------
Bus Type : FIBRE
Max. Tr. Length: 0x20000
Max. Phy. Pages: 0x11
Alignment Mask : 0x0
Device Properties
-----------------
Device Type : Direct Access Device (0x0)
Removable Media : No
Vendor ID : MAXTOR S
Product ID : TM3160215AS
Product Revision: 3.AA
Inquiry Data from Pass Through
------------------------------
Device Type: Direct Access Device (0x0)
Vendor ID : MAXTOR S
Product ID : TM3160215AS
Product Rev: 3.AA
Vendor Str :
*** End of Device List ***

This code makes three attempts at obtaining the serial number:
Using IOCTL_STORAGE_QUERY_PROPERTY.
Using SMART_RCV_DRIVE_DATA.
Using IOCTL_SCSI_PASS_THROUGH.
This code works for me on 64-bit:
' PhysicalDrive.vb
Option Strict On
Option Explicit On
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.ComponentModel
Imports Microsoft.Win32.SafeHandles
Public Class PhysicalDrive
#Region "Win32 Definitions"
<StructLayout(LayoutKind.Sequential)> _
Private Structure IDEREGS
Public bFeaturesReg As Byte
Public bSectorCountReg As Byte
Public bSectorNumberReg As Byte
Public bCylLowReg As Byte
Public bCylHighReg As Byte
Public bDriveHeadReg As Byte
Public bCommandReg As Byte
Public bReserved As Byte
End Structure
<StructLayout(LayoutKind.Sequential)> _
Private Structure SENDCMDINPARAMS
Public cBufferSize As Int32
Public irDriveRegs As IDEREGS
Public bDriveNumber As Byte
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=3)> _
Public bReserved As Byte()
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=4)> _
Public dwReserved As Int32()
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=1)> _
Public bBuffer As Byte()
End Structure
<StructLayout(LayoutKind.Sequential)> _
Private Structure DRIVERSTATUS
Public bDriverError As Byte
Public bIDEError As Byte
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=2)> _
Public bReserved As Byte()
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=2)> _
Public dwReserved As Int32()
End Structure
<StructLayout(LayoutKind.Sequential)> _
Private Structure SENDCMDOUTPARAMS
Public cBufferSize As Int32
Public DriverStatus As DRIVERSTATUS
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=IDENTIFY_BUFFER_SIZE)> _
Public bBuffer As Byte()
End Structure
<StructLayout(LayoutKind.Sequential)> _
Private Structure GETVERSIONINPARAMS
Public bVersion As Byte
Public bRevision As Byte
Public bReserved As Byte
Public bIDEDeviceMap As Byte
Public fCapabilities As Int32
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=4)> _
Public dwReserved As Int32()
End Structure
<StructLayout(LayoutKind.Sequential)> _
Private Structure STORAGE_PROPERTY_QUERY
Public PropertyId As Int32
Public QueryType As Int32
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=1)> _
Public AdditionalParameters As Byte()
End Structure
<StructLayout(LayoutKind.Sequential)> _
Private Structure STORAGE_DEVICE_DESCRIPTOR
Public Version As Int32
Public Size As Int32
Public DeviceType As Byte
Public DeviceTypeModifier As Byte
Public RemovableMedia As Byte
Public CommandQueueing As Byte
Public VendorIdOffset As Int32
Public ProductIdOffset As Int32
Public ProductRevisionOffset As Int32
Public SerialNumberOffset As Int32
Public BusType As Byte
Public RawPropertiesLength As Int32
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=10240)> _
Public RawDeviceProperties As Byte()
End Structure
<StructLayout(LayoutKind.Sequential)> _
Private Structure SCSI_PASS_THROUGH
Public Length As Int16
Public ScsiStatus As Byte
Public PathId As Byte
Public TargetId As Byte
Public Lun As Byte
Public CdbLength As Byte
Public SenseInfoLength As Byte
Public DataIn As Byte
Public DataTransferLength As Int32
Public TimeOutValue As Int32
Public DataBufferOffset As IntPtr
Public SenseInfoOffset As Int32
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=16)> _
Public Cdb As Byte()
End Structure
<StructLayout(LayoutKind.Sequential)> _
Private Structure SCSI_PASS_THROUGH_WITH_BUFFER
Public Spt As SCSI_PASS_THROUGH
Public Filler As Int32
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=64)> _
Public Buffer As Byte()
End Structure
<DllImport("kernel32.dll", SetLastError:=True)> _
Private Shared Function CreateFile(ByVal lpFileName As String, ByVal dwDesiredAccess As Int32, ByVal dwShareMode As Int32, ByVal lpSecurityAttributes As IntPtr, ByVal dwCreationDisposition As Int32, ByVal dwFlagsAndAttributes As Int32, ByVal hTemplateFile As IntPtr) As SafeFileHandle
End Function
<DllImport("kernel32.dll", SetLastError:=True)> _
Private Shared Function DeviceIoControl(ByVal hDevice As SafeFileHandle, ByVal dwIoControlCode As Int32, <[In]()> ByRef lpInBuffer As SENDCMDINPARAMS, ByVal nInBufferSize As Int32, <[In](), Out()> ByRef lpOutBuffer As SENDCMDOUTPARAMS, ByVal nOutBufferSize As Int32, ByRef lpBytesReturned As Int32, ByVal lpOverlapped As Int32) As Int32
End Function
<DllImport("kernel32.dll", SetLastError:=True)> _
Private Shared Function DeviceIoControl(ByVal hDevice As SafeFileHandle, ByVal dwIoControlCode As Int32, ByVal lpInBuffer As IntPtr, ByVal nInBufferSize As Int32, <[In](), Out()> ByRef lpOutBuffer As GETVERSIONINPARAMS, ByVal nOutBufferSize As Int32, ByRef lpBytesReturned As Int32, ByVal lpOverlapped As Int32) As Int32
End Function
<DllImport("kernel32.dll", SetLastError:=True)> _
Private Shared Function DeviceIoControl(ByVal hDevice As SafeFileHandle, ByVal dwIoControlCode As Int32, <[In]()> ByRef lpInBuffer As STORAGE_PROPERTY_QUERY, ByVal nInBufferSize As Int32, <[In](), Out()> ByRef lpOutBuffer As STORAGE_DEVICE_DESCRIPTOR, ByVal nOutBufferSize As Int32, ByRef lpBytesReturned As Int32, ByVal lpOverlapped As Int32) As Int32
End Function
<DllImport("kernel32.dll", SetLastError:=True)> _
Private Shared Function DeviceIoControl(ByVal hDevice As SafeFileHandle, ByVal dwIoControlCode As Int32, <[In]()> ByRef lpInBuffer As SCSI_PASS_THROUGH_WITH_BUFFER, ByVal nInBufferSize As Int32, <[In](), Out()> ByRef lpOutBuffer As SCSI_PASS_THROUGH_WITH_BUFFER, ByVal nOutBufferSize As Int32, ByRef lpBytesReturned As Int32, ByVal lpOverlapped As Int32) As Int32
End Function
Private Const OPEN_EXISTING As Int32 = 3
Private Const GENERIC_READ As Int32 = &H80000000
Private Const GENERIC_WRITE As Int32 = &H40000000
Private Const FILE_SHARE_READ As Int32 = &H1
Private Const FILE_SHARE_WRITE As Int32 = &H2
Private Const FILE_SHARE_DELETE As Int32 = &H4
Private Const SMART_GET_VERSION As Int32 = &H74080
Private Const SMART_RCV_DRIVE_DATA As Int32 = &H7C088
Private Const ID_CMD As Int32 = &HEC
Private Const IDENTIFY_BUFFER_SIZE As Int32 = 512
Private Const CAP_SMART_CMD As Int32 = &H4
Private Const IOCTL_STORAGE_QUERY_PROPERTY As Int32 = &H2D1400
Private Const IOCTL_SCSI_PASS_THROUGH As Int32 = &H4D004
Private Const SCSI_IOCTL_DATA_IN As Int32 = &H1
Private Const PropertyStandardQuery As Int32 = 0
Private Const StorageDeviceProperty As Int32 = 0
Private Const ERROR_INVALID_FUNCTION As Int32 = &H1
#End Region
Public Shared Function GetSerialNumberUsingStorageQuery(ByVal diskNumber As Integer) As String
Using hDisk As SafeFileHandle = OpenDisk(diskNumber)
Dim iBytesReturned As Int32
Dim spq As New STORAGE_PROPERTY_QUERY()
Dim sdd As New STORAGE_DEVICE_DESCRIPTOR()
spq.PropertyId = StorageDeviceProperty
spq.QueryType = PropertyStandardQuery
If DeviceIoControl(hDisk, IOCTL_STORAGE_QUERY_PROPERTY, spq, Marshal.SizeOf(spq), sdd, Marshal.SizeOf(sdd), iBytesReturned, 0) = 0 Then
Throw CreateWin32Exception(Marshal.GetLastWin32Error(), "DeviceIoControl(IOCTL_STORAGE_QUERY_PROPERTY)")
End If
Dim result As New StringBuilder()
If sdd.SerialNumberOffset > 0 Then
Dim rawDevicePropertiesOffset As Integer = Marshal.SizeOf(sdd) - sdd.RawDeviceProperties.Length
Dim pos As Integer = sdd.SerialNumberOffset - rawDevicePropertiesOffset
While pos < iBytesReturned And sdd.RawDeviceProperties(pos) <> 0
result.Append(Encoding.ASCII.GetString(sdd.RawDeviceProperties, pos, 1))
pos += 1
End While
End If
Return result.ToString().Trim()
End Using
End Function
Public Shared Function GetSerialNumberUsingSmart(ByVal diskNumber As Integer) As String
Using hDisk As SafeFileHandle = OpenDisk(diskNumber)
If IsSmartSupported(hDisk) Then
Dim iBytesReturned As Int32
Dim sci As New SENDCMDINPARAMS
Dim sco As New SENDCMDOUTPARAMS
sci.irDriveRegs.bCommandReg = ID_CMD
sci.bDriveNumber = CByte(diskNumber)
sci.cBufferSize = IDENTIFY_BUFFER_SIZE
If DeviceIoControl(hDisk, SMART_RCV_DRIVE_DATA, sci, Marshal.SizeOf(sci), sco, Marshal.SizeOf(sco), iBytesReturned, 0) = 0 Then
Throw CreateWin32Exception(Marshal.GetLastWin32Error(), "DeviceIoControl(SMART_RCV_DRIVE_DATA)")
End If
Dim result As New StringBuilder()
For index As Integer = 20 To 39 Step 2
result.Append(Encoding.ASCII.GetString(sco.bBuffer, index + 1, 1))
result.Append(Encoding.ASCII.GetString(sco.bBuffer, index, 1))
Next
Return result.ToString().Trim()
Else
Return String.Empty
End If
End Using
End Function
Public Shared Function GetSerialNumberUsingScsiPassThrough(ByVal diskNumber As Integer) As String
Using hDisk As SafeFileHandle = OpenDisk(diskNumber)
Dim iBytesReturned As Int32
Dim spt As New SCSI_PASS_THROUGH_WITH_BUFFER
spt.Spt.Length = CShort(Marshal.SizeOf(spt.Spt))
spt.Spt.CdbLength = 16
spt.Spt.DataIn = SCSI_IOCTL_DATA_IN
spt.Spt.DataTransferLength = 64
spt.Spt.DataBufferOffset = New IntPtr(Marshal.SizeOf(spt) - 64)
spt.Spt.TimeOutValue = 60
Dim cdb(15) As Byte
cdb(0) = &H12 ' INQUIRY
cdb(1) = &H1 ' EVPD bit
cdb(2) = &H80 ' Page code (indicates Serial Number)
cdb(4) = 64 ' Allocation length
spt.Spt.Cdb = cdb
If DeviceIoControl(hDisk, IOCTL_SCSI_PASS_THROUGH, spt, Marshal.SizeOf(spt), spt, Marshal.SizeOf(spt), iBytesReturned, 0) = 0 Then
Dim iErrorCode As Int32 = Marshal.GetLastWin32Error()
If iErrorCode <> ERROR_INVALID_FUNCTION Then
Throw CreateWin32Exception(iErrorCode, "DeviceIoControl(IOCTL_SCSI_PASS_THROUGH)")
End If
End If
Dim result As New StringBuilder()
Dim pos As Integer = IntPtr.Size
While pos < spt.Spt.DataTransferLength And spt.Buffer(pos) <> 0
result.Append(Encoding.ASCII.GetString(spt.Buffer, pos, 1))
pos += 1
End While
Return result.ToString().Trim()
End Using
End Function
Private Shared Function CreateWin32Exception(ByVal errorCode As Int32, ByVal context As String) As Win32Exception
Dim win32Exception As New Win32Exception(errorCode)
win32Exception.Data("Context") = context
Return win32Exception
End Function
Private Shared Function OpenDisk(ByVal diskNumber As Integer) As SafeFileHandle
Dim hDevice As SafeFileHandle = CreateFile(String.Format("\\.\PhysicalDrive{0}", diskNumber), GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE Or FILE_SHARE_DELETE, IntPtr.Zero, OPEN_EXISTING, 0, IntPtr.Zero)
If (Not hDevice.IsInvalid) Then
Return hDevice
Else
Throw CreateWin32Exception(Marshal.GetLastWin32Error(), "CreateFile")
End If
End Function
Private Shared Function IsSmartSupported(ByVal hDisk As SafeFileHandle) As Boolean
Dim iBytesReturned As Int32
Dim gvi As New GETVERSIONINPARAMS
If DeviceIoControl(hDisk, SMART_GET_VERSION, IntPtr.Zero, 0, gvi, Marshal.SizeOf(gvi), iBytesReturned, 0) = 0 Then
Return False
End If
Return (gvi.fCapabilities And CAP_SMART_CMD) > 0
End Function
End Class
And here's the code to call it:
' MainModule.vb
Module MainModule
Sub Main()
Console.WriteLine("{0}-bit runtime.", IntPtr.Size * 8)
For drive As Integer = 0 To 4
Try
Console.WriteLine("Drive {0}, SMART: [{1}]", drive, PhysicalDrive.GetSerialNumberUsingSmart(drive))
Console.WriteLine("Drive {0}, Storage Query: [{1}]", drive, PhysicalDrive.GetSerialNumberUsingStorageQuery(drive))
Console.WriteLine("Drive {0}, SCSI Pass Through: [{1}]", drive, PhysicalDrive.GetSerialNumberUsingScsiPassThrough(drive))
Catch ex As Exception
If ex.Data("Context") IsNot Nothing Then Console.Error.Write("{0} failed: ", ex.Data("Context"))
Console.Error.WriteLine(ex.Message)
End Try
Next
End Sub
End Module
EDIT - I've changed the main method to display the results of each attempt for comparison. This will hopefully illustrate how hit and miss these techniques can be.

use DeviceIoControl with IOCTL_STORAGE_GET_MEDIA_SERIAL_NUMBER
or check IOCTL_CHANGER_GET_PRODUCT_DATA

You need to ensure that your P/Invoke definitions are 64-bit friendly. Alternatively, try setting the target CPU of the projects in your solution to 32-bit. More information on P/Invoke and 64-bit can be found here.
EDIT:
The following rewritten code might work better for you - basically I've tidied up the P/Invoke definitions and added better error handling. The code makes two attempts to obtain the serial number. The first uses IOCTL_STORAGE_QUERY_PROPERTY and the second uses SMART_RCV_DRIVE_DATA.
' PhysicalDrive.vb
Option Strict On
Option Explicit On
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.ComponentModel
Imports Microsoft.Win32.SafeHandles
Public Class PhysicalDrive
#Region "Win32 Definitions"
<StructLayout(LayoutKind.Sequential)> _
Private Structure IDEREGS
Public bFeaturesReg As Byte
Public bSectorCountReg As Byte
Public bSectorNumberReg As Byte
Public bCylLowReg As Byte
Public bCylHighReg As Byte
Public bDriveHeadReg As Byte
Public bCommandReg As Byte
Public bReserved As Byte
End Structure
<StructLayout(LayoutKind.Sequential)> _
Private Structure SENDCMDINPARAMS
Public cBufferSize As Int32
Public irDriveRegs As IDEREGS
Public bDriveNumber As Byte
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=3)> _
Public bReserved As Byte()
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=4)> _
Public dwReserved As Int32()
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=1)> _
Public bBuffer As Byte()
End Structure
<StructLayout(LayoutKind.Sequential)> _
Private Structure DRIVERSTATUS
Public bDriverError As Byte
Public bIDEError As Byte
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=2)> _
Public bReserved As Byte()
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=2)> _
Public dwReserved As Int32()
End Structure
<StructLayout(LayoutKind.Sequential)> _
Private Structure SENDCMDOUTPARAMS
Public cBufferSize As Int32
Public DriverStatus As DRIVERSTATUS
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=IDENTIFY_BUFFER_SIZE)> _
Public bBuffer As Byte()
End Structure
<StructLayout(LayoutKind.Sequential)> _
Private Structure GETVERSIONOUTPARAMS
Public bVersion As Byte
Public bRevision As Byte
Public bReserved As Byte
Public bIDEDeviceMap As Byte
Public fCapabilities As Int32
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=4)> _
Public dwReserved As Int32()
End Structure
<StructLayout(LayoutKind.Sequential)> _
Private Structure STORAGE_PROPERTY_QUERY
Public PropertyId As Int32
Public QueryType As Int32
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=1)> _
Public AdditionalParameters As Byte()
End Structure
<StructLayout(LayoutKind.Sequential)> _
Private Structure STORAGE_DEVICE_DESCRIPTOR
Public Version As Int32
Public Size As Int32
Public DeviceType As Byte
Public DeviceTypeModifier As Byte
Public RemovableMedia As Byte
Public CommandQueueing As Byte
Public VendorIdOffset As Int32
Public ProductIdOffset As Int32
Public ProductRevisionOffset As Int32
Public SerialNumberOffset As Int32
Public BusType As Byte
Public RawPropertiesLength As Int32
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=10240)> _
Public RawDeviceProperties As Byte()
End Structure
<DllImport("kernel32.dll", SetLastError:=True)> _
Private Shared Function CreateFile(ByVal lpFileName As String, ByVal dwDesiredAccess As Int32, ByVal dwShareMode As Int32, ByVal lpSecurityAttributes As IntPtr, ByVal dwCreationDisposition As Int32, ByVal dwFlagsAndAttributes As Int32, ByVal hTemplateFile As IntPtr) As SafeFileHandle
End Function
<DllImport("kernel32.dll", SetLastError:=True)> _
Private Shared Function DeviceIoControl(ByVal hDevice As SafeFileHandle, ByVal dwIoControlCode As Int32, <[In](), Out()> ByRef lpInBuffer As SENDCMDINPARAMS, ByVal nInBufferSize As Int32, <[In](), Out()> ByRef lpOutBuffer As SENDCMDOUTPARAMS, ByVal nOutBufferSize As Int32, ByRef lpBytesReturned As Int32, ByVal lpOverlapped As Int32) As Int32
End Function
<DllImport("kernel32.dll", SetLastError:=True)> _
Private Shared Function DeviceIoControl(ByVal hDevice As SafeFileHandle, ByVal dwIoControlCode As Int32, ByVal lpInBuffer As IntPtr, ByVal nInBufferSize As Int32, <[In](), Out()> ByRef lpOutBuffer As GETVERSIONOUTPARAMS, ByVal nOutBufferSize As Int32, ByRef lpBytesReturned As Int32, ByVal lpOverlapped As Int32) As Int32
End Function
<DllImport("kernel32.dll", SetLastError:=True)> _
Private Shared Function DeviceIoControl(ByVal hDevice As SafeFileHandle, ByVal dwIoControlCode As Int32, <[In](), Out()> ByRef lpInBuffer As STORAGE_PROPERTY_QUERY, ByVal nInBufferSize As Int32, <[In](), Out()> ByRef lpOutBuffer As STORAGE_DEVICE_DESCRIPTOR, ByVal nOutBufferSize As Int32, ByRef lpBytesReturned As Int32, ByVal lpOverlapped As Int32) As Int32
End Function
Private Const OPEN_EXISTING As Int32 = 3
Private Const GENERIC_READ As Int32 = &H80000000
Private Const GENERIC_WRITE As Int32 = &H40000000
Private Const FILE_SHARE_READ As Int32 = &H1
Private Const FILE_SHARE_WRITE As Int32 = &H2
Private Const FILE_SHARE_DELETE As Int32 = &H4
Private Const SMART_GET_VERSION As Int32 = &H74080
Private Const SMART_RCV_DRIVE_DATA As Int32 = &H7C088
Private Const ID_CMD As Int32 = &HEC
Private Const IDENTIFY_BUFFER_SIZE As Int32 = 512
Private Const CAP_SMART_CMD As Int32 = &H4
Private Const IOCTL_STORAGE_QUERY_PROPERTY As Int32 = &H2D1400
Private Const PropertyStandardQuery As Int32 = 0
Private Const StorageDeviceProperty As Int32 = 0
#End Region
Public Shared Function GetSerialNumber(ByVal diskNumber As Integer) As String
Dim result As String = GetSerialNumberUsingStorageQuery(diskNumber)
If String.IsNullOrEmpty(result) Then
result = GetSerialNumberUsingSmart(diskNumber)
End If
Return result
End Function
Public Shared Function GetSerialNumberUsingStorageQuery(ByVal diskNumber As Integer) As String
Using hDisk As SafeFileHandle = OpenDisk(diskNumber)
Dim iBytesReturned As Int32
Dim spq As New STORAGE_PROPERTY_QUERY()
Dim sdd As New STORAGE_DEVICE_DESCRIPTOR()
spq.PropertyId = StorageDeviceProperty
spq.QueryType = PropertyStandardQuery
If DeviceIoControl(hDisk, IOCTL_STORAGE_QUERY_PROPERTY, spq, Marshal.SizeOf(spq), sdd, Marshal.SizeOf(sdd), iBytesReturned, 0) = 0 Then
Throw CreateWin32Exception(Marshal.GetLastWin32Error(), "DeviceIoControl(IOCTL_STORAGE_QUERY_PROPERTY)")
End If
Dim result As New StringBuilder()
If sdd.SerialNumberOffset > 0 Then
Dim rawDevicePropertiesOffset As Integer = Marshal.SizeOf(sdd) - sdd.RawDeviceProperties.Length
Dim pos As Integer = sdd.SerialNumberOffset - rawDevicePropertiesOffset
While pos < iBytesReturned And sdd.RawDeviceProperties(pos) <> 0
result.Append(Encoding.ASCII.GetString(sdd.RawDeviceProperties, pos, 1))
pos += 1
End While
End If
Return result.ToString()
End Using
End Function
Public Shared Function GetSerialNumberUsingSmart(ByVal diskNumber As Integer) As String
Using hDisk As SafeFileHandle = OpenDisk(diskNumber)
If IsSmartSupported(hDisk) Then
Dim iBytesReturned As Int32
Dim sci As New SENDCMDINPARAMS
Dim sco As New SENDCMDOUTPARAMS
sci.irDriveRegs.bCommandReg = ID_CMD
sci.bDriveNumber = CByte(diskNumber)
sci.cBufferSize = IDENTIFY_BUFFER_SIZE
If DeviceIoControl(hDisk, SMART_RCV_DRIVE_DATA, sci, Marshal.SizeOf(sci), sco, Marshal.SizeOf(sco), iBytesReturned, 0) = 0 Then
Throw CreateWin32Exception(Marshal.GetLastWin32Error(), "DeviceIoControl(SMART_RCV_DRIVE_DATA)")
End If
Dim result As New StringBuilder()
For index As Integer = 20 To 39 Step 2
result.Append(Encoding.ASCII.GetString(sco.bBuffer, index + 1, 1))
result.Append(Encoding.ASCII.GetString(sco.bBuffer, index, 1))
Next
Return result.ToString()
Else
Return String.Empty
End If
End Using
End Function
Private Shared Function CreateWin32Exception(ByVal errorCode As Int32, ByVal context As String) As Win32Exception
Dim win32Exception As New Win32Exception(errorCode)
win32Exception.Data("Context") = context
Return win32Exception
End Function
Private Shared Function OpenDisk(ByVal diskNumber As Integer) As SafeFileHandle
Dim hDevice As SafeFileHandle = CreateFile(String.Format("\\.\PhysicalDrive{0}", diskNumber), GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE Or FILE_SHARE_DELETE, IntPtr.Zero, OPEN_EXISTING, 0, IntPtr.Zero)
If (Not hDevice.IsInvalid) Then
Return hDevice
Else
Throw CreateWin32Exception(Marshal.GetLastWin32Error(), "CreateFile")
End If
End Function
Private Shared Function IsSmartSupported(ByVal hDisk As SafeFileHandle) As Boolean
Dim iBytesReturned As Int32
Dim gvo As New GETVERSIONOUTPARAMS
If DeviceIoControl(hDisk, SMART_GET_VERSION, IntPtr.Zero, 0, gvo, Marshal.SizeOf(gvo), iBytesReturned, 0) = 0 Then
Return False
End If
Return (gvo.fCapabilities And CAP_SMART_CMD) > 0
End Function
End Class
This is the code to call it:
' MainModule.vb
Module MainModule
Sub Main()
Console.WriteLine("{0}-bit runtime.", IntPtr.Size * 8)
For drive As Integer = 0 To 4
Try
Console.WriteLine("Drive {0} - serial number: [{1}]", drive, PhysicalDrive.GetSerialNumber(drive))
Catch ex As Exception
If ex.Data("Context") IsNot Nothing Then Console.Error.Write("{0} failed: ", ex.Data("Context"))
Console.Error.WriteLine(ex.Message)
End Try
Next
End Sub
End Module
I only have one 64-bit machine to test against, but this code does work on it.

This code should give you the hard disk serial number. It's similar (ReadPhysicalDriveInNTWithAdminRights) to your code you linked to but with several additional functions.

Got working on Windows 7 64:
ManagementObjectSearcher mos = new ManagementObjectSearcher("SELECT * FROM Win32_DiskDrive");
foreach (ManagementObject obj in mos.Get()) {
Trace.TraceInformation("Information about disk drive {0}:", obj["Name"]);
Trace.Indent();
foreach (PropertyData pd in obj.Properties)
Trace.TraceInformation("Name \"{0}\": \"{1}\"", pd.Name, pd.Value);
Trace.Unindent();
obj.Properties["SerialNumber"]
}
Probably the class Win32_PhysicalMedia is not served on 64 bit platforms.
Even Disk32, at this time, is working (apart a bug when flipping serial number bytes), because is based on the same concepts.

Modified from the code here:
using System;
using System.Collections.Generic;
using System.Linq;
using System.Management;
using System.Text;
namespace Console_DiskDrive
{
class Program
{
static void Main(string[] args)
{
String query = "SELECT * FROM Win32_DiskDrive";
foreach (ManagementObject item in new ManagementObjectSearcher(query).Get())
{
string serialNumber = Convert.ToString(item["SerialNumber"]);
Console.WriteLine(serialNumber);
}
Console.ReadLine();
}
}
}
On my system running Vista Home Premium x64, gives me a 40-character hex string that I'm assuming is my serial number. I'll open up the box and confirm later, but give that a try and see if it's what you're looking for.

You might want to use Windows unmanaged API to do this:
call GetVolumeInformation api with proper struct and find VolumeSerialNumber integer field.
This API is there for ages and was working for me since Windows 98. Unfortunately, can't check it on x64.
Can you see the correct serial number using other Windows tools?
By the way: '0' is a valid serial number! This might happen if disk image was restored from backup or something like that.

Related

base64 string to byte to image

I have a base64 string which was generated from an image using another application. Now on my application I want to convert the base64 string to byte and display it on a PictureBox.
I already found a sample application which takes a byte input and sets a PictureBox image. Unfortunately the sample application gets the byte array from an image and just translates it back. Here's the function it uses.
Public Function PictureFromByteStream(b() As Byte) As IPicture
Dim LowerBound As Long
Dim ByteCount As Long
Dim hMem As Long
Dim lpMem As Long
Dim IID_IPicture(15)
Dim istm As stdole.IUnknown
On Error GoTo Err_Init
If UBound(b, 1) < 0 Then
Exit Function
End If
LowerBound = LBound(b)
ByteCount = (UBound(b) - LowerBound) + 1
hMem = GlobalAlloc(&H2, ByteCount)
If hMem <> 0 Then
lpMem = GlobalLock(hMem)
If lpMem <> 0 Then
MoveMemory ByVal lpMem, b(LowerBound), ByteCount
Call GlobalUnlock(hMem)
If CreateStreamOnHGlobal(hMem, 1, istm) = 0 Then
If CLSIDFromString(StrPtr("{7BF80980-BF32-101A-8BBB-00AA00300CAB}"), IID_IPicture(0)) = 0 Then
Call OleLoadPicture(ByVal ObjPtr(istm), ByteCount, 0, IID_IPicture(0), PictureFromByteStream)
End If
End If
End If
End If
Exit Function
Err_Init:
If Err.Number = 9 Then
'Uninitialized array
MsgBox "You must pass a non-empty byte array to this function!"
Else
MsgBox Err.Number & " - " & Err.Description
End If
End Function
Here's the function I found to convert a base64 string to a byte, it seems to be converting it but when I pass the byte data to the above function, no image appears.
Private Function DecodeBase64(ByVal strData As String) As Byte()
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
' help from MSXML
Set objXML = New MSXML2.DOMDocument
Set objNode = objXML.createElement("b64")
objNode.dataType = "bin.base64"
objNode.Text = strData
DecodeBase64 = objNode.nodeTypedValue
' thanks, bye
Set objNode = Nothing
Set objXML = Nothing
End Function
And here's my code calling the functions.
Dim b() As Byte
b = DecodeBase64(Text1.Text)
Dim pic As StdPicture
Set pic = PictureFromByteStream(b)
Set Picture1.Picture = pic
Try this:
Option Explicit
Private Const CRYPT_STRING_BASE64 As Long = &H1&
Private Const STRING_IPICTURE_GUID As String = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Private Declare Function CryptStringToBinaryW Lib "Crypt32.dll" ( _
ByVal pszString As Long, _
ByVal cchString As Long, _
ByVal dwFlags As Long, _
ByVal pbBinary As Long, _
ByRef pcbBinary As Long, _
ByVal pdwSkip As Long, _
ByVal pdwFlags As Long) As Long
Private Declare Function CreateStreamOnHGlobal Lib "ole32.dll" ( _
ByRef hGlobal As Any, _
ByVal fDeleteOnResume As Long, _
ByRef ppstr As Any) As Long
Private Declare Function OleLoadPicture Lib "olepro32.dll" ( _
ByVal lpStream As IUnknown, _
ByVal lSize As Long, _
ByVal fRunMode As Long, _
ByRef riid As GUID, _
ByRef lplpObj As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32.dll" ( _
ByVal lpsz As Long, _
ByRef pclsid As GUID) As Long
Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Public Function DecodeBase64(ByVal strData As String) As Byte()
Dim Buffer() As Byte
Dim dwBinaryBytes As Long
dwBinaryBytes = LenB(strData)
ReDim Buffer(dwBinaryBytes - 1) As Byte
If CryptStringToBinaryW(StrPtr(strData), LenB(strData), CRYPT_STRING_BASE64, _
VarPtr(Buffer(0)), dwBinaryBytes, 0, 0) Then
ReDim Preserve Buffer(dwBinaryBytes - 1) As Byte
DecodeBase64 = Buffer
End If
Erase Buffer
End Function
Public Function PictureFromByteStream(ByRef b() As Byte) As IPicture
On Error GoTo errorHandler
Dim istrm As IUnknown
Dim tGuid As GUID
If Not CreateStreamOnHGlobal(b(LBound(b)), False, istrm) Then
CLSIDFromString StrPtr(STRING_IPICTURE_GUID), tGuid
OleLoadPicture istrm, UBound(b) - LBound(b) + 1, False, tGuid, PictureFromByteStream
End If
Set istrm = Nothing
Exit Function
errorHandler:
Debug.Print "Error in converting to IPicture."
End Function

How can I get any Browser's URL in VB6?

Recently, I was trying to make a program for saving all visited URLs in a text file from any browser using Visual Basic 6. I have found some codes for VB.NET, but I like programming in VB6.
VB.NET Code for getting browser URL
Option Explicit On
Imports System.Text
Imports System.Runtime.InteropServices.Marshal
Module CurrentUrl
#Region " Overview & References "
'Overview:
'Function GetCurrentUrl returns the URL of the selected browser (IE or Chrome; Firefox to be added).
'Most of the code is based on the references listed below, but this function starts with
'the browser's main window handle and returns only 1 URL.
'It also builds a simple "treeview" of the windows up to the target window's classname.
'References:
'http://www.xtremevbtalk.com/archive/index.php/t-129988.html
'http://social.msdn.microsoft.com/forums/en-us/vbgeneral/thread/321D0EAD-CD50-4517-BC43-29190542DCE0
'http://social.msdn.microsoft.com/Forums/en/vbgeneral/thread/02a67f3a-4a26-4d9a-9c67-0fdff1428a66
#End Region
#Region " Declares, Constants, and Variables"
Private Delegate Function EnumProcDelegate(ByVal hwnd As IntPtr, ByVal lParam As IntPtr) As Boolean 'Delegate added
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As EnumProcDelegate, ByVal lParam As IntPtr) As Boolean
Private Declare Auto Function GetWindowText Lib "user32" (ByVal hWnd As IntPtr, ByVal lpString As StringBuilder, ByVal nMaxCount As Integer) As Integer
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As IntPtr, ByVal wCmd As IntPtr) As IntPtr
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As IntPtr, ByVal lpClassName As String, ByVal nMaxCount As Integer) As Integer
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As IntPtr, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Private Const GW_HWNDFIRST = 0
Private sURL As String 'String that will contain the URL
Private cbWindows As ComboBox 'Treeview"
Private sIndent As String 'Spaces
Private sBrowser As String 'Starting window (IE or Chrome)
Private sClassName As String = "Edit" 'Default
#End Region
Public Function GetCurrentUrl(ByVal hwnd As IntPtr, ByVal browser As String, ByVal classname As String, ByVal combo As ComboBox) As String
sBrowser = browser
sClassName = classname
cbWindows = combo
If cbWindows IsNot Nothing Then
If cbWindows.GetType.Name = "ComboBox" Then
cbWindows.Items.Clear()
Else
cbWindows = Nothing
End If
End If
sURL = ""
sIndent = ""
EnumWindows(AddressOf EnumProc, hwnd) 'hwnd - originally IntPtr.Zero
Return sURL
End Function
' Enumerate the windows
' Find the URL in the browser window
Private Function EnumProc(ByVal hWnd As IntPtr, ByVal lParam As IntPtr) As Boolean
Dim buf As StringBuilder = New StringBuilder(256) 'String * 1024
Dim title As String
Dim length As Integer
' Get the window's title.
length = GetWindowText(hWnd, buf, buf.Capacity)
title = Left(buf.ToString, length)
' See if the title ends with the browser name
Dim s As String = sBrowser
Dim inprivate = sBrowser & " - [InPrivate]" 'IE adds this to the window title
If title <> "" Then
If (Right(title, s.Length) = s) Or (Right(title, inprivate.Length) = inprivate) Then
' This is it. Find the URL information.
sURL = EditInfo(hWnd, cbWindows)
Return False
End If
End If
' Continue searching
Return True
End Function
' If this window is of the Edit class (IE) or Chrome_AutocompleteEditView (Google), return its contents.
' Otherwise search its children for such an object.
Private Function EditInfo(ByVal window_hwnd As IntPtr, ByRef cbWindows As ComboBox) As String
Dim txt As String = ""
Dim buf As String
Dim buflen As Integer
Dim child_hwnd As IntPtr
Dim children() As IntPtr = {}
Dim num_children As Integer
Dim i As Integer
'Get the class name.
buflen = 256
buf = Space(buflen - 1)
buflen = GetClassName(window_hwnd, buf, buflen)
buf = Left(buf, buflen)
'Add an item to the window list combo, indent as required
If cbWindows IsNot Nothing Then
cbWindows.Items.Add(sIndent & buf)
End If
' See if we found an Edit/AutocompleteEditView object.
If buf = sClassName Then
Return WindowText(window_hwnd)
End If
' It's not an Edit/AutocompleteEditView object. Search the children.
' Make a list of the child windows.
num_children = 0
child_hwnd = GetWindow(window_hwnd, GW_CHILD)
While child_hwnd <> 0
num_children = num_children + 1
ReDim Preserve children(0 To num_children) 'was 1 to ..
children(num_children) = child_hwnd
child_hwnd = GetWindow(child_hwnd, GW_HWNDNEXT)
End While
' Get information on the child windows.
sIndent &= " "
For i = 1 To num_children
txt = EditInfo(children(i), cbWindows)
If txt <> "" Then Exit For
Next i
sIndent = Left(sIndent, sIndent.Length - 4)
Return txt
End Function
' ************************************************
' Return the text associated with the window.
' ************************************************
Private Function WindowText(ByVal window_hwnd As IntPtr) As String
Dim txtlen As Integer
Dim txt As String
txt = "" 'WindowText = ""
If window_hwnd = 0 Then Return "" 'Exit Function
'Get the size of the window text
txtlen = SendMessage(window_hwnd, WM_GETTEXTLENGTH, 0, 0)
If txtlen = 0 Then Return "" 'Exit Function
'Extra for terminating char
txtlen = txtlen + 1
'Alloc memory for the buffer that recieves the text
Dim buffer As IntPtr = AllocHGlobal(txtlen)
'Send The WM_GETTEXT Message
txtlen = SendMessage(window_hwnd, WM_GETTEXT, txtlen, buffer) 'byval txt
'Copy the characters from the unmanaged memory to a managed string
txt = PtrToStringAnsi(buffer)
Return Left(txt, txtlen)
End Function
End Module

VB6 reading registry entry but no data returned

newly signed up desperate user here.
I left the programming business quite a while ago but now and then get asked to make some enhancements etc.
I want to use the registry to store some file locations so the user doesn't have to specify them all the time. I want to store them under HKEY_LOCAL_MACHINE because there are multiple users.
I have got the key created using RegCreateKeyEx, and a value has been entered into the key, with RegSetValueExString, so there is a key under HKEY_LOCAL_MACHINE called SUPPLIERFILE and it has the value "C:\Documents and Settings.." etc.
However when I use RegQueryValueExString it doesn't work: the lpValue string is empty, although the cbdata does contain the length of the string I was expecting to find there. The error retured is 234, ERROR_MORE_DATA.
I have tried using RegGetValue, because I thought maybe a non-null terminated string was the problem, but I haven't got RegGetValue in the api dll.
Any suggestions would be gratefully received, even along the lines of how to terminate a string with a null.
Thanks,
Steve
Your error indicates you have not initialized a large enough string buffer for the API function to use, but without your code, ??? I pulled the code below from a registry utility class I use. I think I have included all the API declarations, and constants used, as well as a method to translate returned errors to something helpful.
Public Enum RegRootKey
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_CONFIG = &H80000005
HKEY_CURRENT_USER = &H80000001
HKEY_DYN_DATA = &H80000006
HKEY_LOCAL_MACHINE = &H80000002
HKEY_PERFORMANCE_DATA = &H80000004
HKEY_USERS = &H80000003
End Enum
'the following declare is used to return windows error descriptions
Private Declare Function FormatMessage Lib "Kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
'key constants
Private Const ERROR_NO_MORE_ITEMS = 259&
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_SUCCESS = 0&
Private Const SYNCHRONIZE = &H100000
Private Const READ_CONTROL = &H20000
Private Const READ_WRITE = 2
Private Const READAPI = 0
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL)
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Private Const KEY_NOTIFY = &H10
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_EVENT = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
Private Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Private Const REG_OPTION_NON_VOLATILE = 0
Private Const REG_SZ = 1 ' Unicode nul terminated string
Private Const REG_BINARY = 3
Private Const REG_DWORD = 4
Private Const REG_MULTI_SZ = 7 ' Multiple Unicode strings
Private Const REG_NONE = 0 ' No value type
Private Const KEY_WOW64_64KEY As Long = &H100& '32 bit app to access 64 bit hive
Private Const KEY_WOW64_32KEY As Long = &H200& '64 bit app to access 32 bit hive
'API declarations
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RootKeyName Lib "advapi32.dll" Alias "RootKeyNameA" (ByVal lphKey As RegRootKey) As String
Public Function GetStringValue(ByVal hKeyRoot As RegRootKey, ByVal hKeySubKey As String, ByVal ValueName As String, Optional ByVal Default As String) As String
Dim strReturn As String
Dim strBuffer As String
Dim lngType As Long
Dim lngBufLen As Long
Dim lngRst As Long
Dim hKeyHandle As Long
On Error GoTo errGetStringValue
'just to avoid any errors in calling functions using a ubound to check the contents
strBuffer = String(255, vbNullChar)
lngBufLen = Len(strBuffer)
lngRst = RegOpenKeyEx(hKeyRoot, hKeySubKey, 0, KEY_READ Or KEY_WOW64_64KEY, hKeyHandle)
If hKeyHandle <> 0 Then
If StrComp(ValueName, "default", vbTextCompare) = 0 Then
lngRst = RegQueryValueEx(hKeyHandle, "", ByVal 0&, lngType, ByVal strBuffer, lngBufLen)
Else
lngRst = RegQueryValueEx(hKeyHandle, ValueName, ByVal 0&, lngType, ByVal strBuffer, lngBufLen)
End If
End If
If lngRst = 0 Then
If lngType = REG_SZ Then
If lngBufLen > 0 Then
strReturn = Left$(strBuffer, lngBufLen - 1)
Else
strReturn = Default
End If
Else
Err.Raise 1, App.EXEName, FormatClassError(1)
End If
ElseIf lngRst = 2 Then 'the key does not exists so return the default
strReturn = Default
Else 'if the return is non-zero there was an error
Err.Raise lngRst, App.EXEName, "There was an error reading the " & RootKeyName(hKeyRoot) & "\" & _
hKeySubKey & " registry key, " & LCase$(FormatClassError(lngRst))
End If
If hKeyHandle <> 0 Then
lngRst = RegCloseKey(hKeyHandle)
hKeyHandle = 0
End If
GetStringValue = strReturn
Exit Function
errGetStringValue:
If hKeyHandle <> 0 Then
lngRst = RegCloseKey(hKeyHandle)
hKeyHandle = 0
End If
Err.Raise Err.Number, Err.Source & ":GetStringValue", Err.Description
End Function
Private Function FormatClassError(ByVal ErrorNumber As Long) As String
Dim strReturn As String
Dim strBuffer As String
Dim lngBufLen As Long
Dim lngRst As Long
On Error Resume Next
'initialize the buffer to to API function
strBuffer = String(1024, vbNullChar)
lngBufLen = Len(strBuffer)
'make the call to the API function
lngRst = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, ByVal 0&, ErrorNumber, ByVal 0&, strBuffer, lngBufLen, ByVal 0&)
'if the return value is <> 0 then we have a valid message
If lngRst <> 0 Then
strReturn = Left$(strBuffer, lngRst)
Else
'make another call to the API function with the last dll error
lngRst = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, ByVal 0&, Err.LastDllError, ByVal 0&, strBuffer, lngBufLen, ByVal 0&)
If lngRst <> 0 Then
strReturn = Left$(strBuffer, lngRst)
Else
strReturn = "Unable to retrieve error description."
End If
End If
'return the result
FormatClassError = strReturn
End Function
Quick answer: try the GetRegStringValue$ code here
In case you (or others) want to know more
When you call that API, as with many windows APIs you are supposed to provide a buffer (string) to hold the registry value, and you are supposed to pass in the maximum size of your buffer.
MSDN explains
If the buffer specified by lpData parameter is not large enough to hold the data, the function returns ERROR_MORE_DATA and stores the required buffer size in the variable pointed to by lpcbData. In this case, the contents of the lpData buffer are undefined.
You need to allocate a buffer (probably fill your string with spaces) and pass in the size in lpData.
you should check first, if the Registry is really do exist or not. By error handling, we can check for the Registry key Entry.
Private Function RegOSInfo(RegPath As String, RegKey As String) As String
On Error GoTo ErrHandler
Dim osName As String
Dim Reg As Object
Set Reg = CreateObject("WScript.Shell")
RegOSInfo = Reg.RegRead(RegPath & "\" & RegKey)
ErrHandler:
RegOSInfo = "-555" 'custom Error Code, Registry key doesn't exist
End Function
you can handle the Custom error code according to your need.

Calling FindMimeFromData from VB6

Public Declare Function FindMimeFromData Lib "urlmon.dll" ( _
ByVal pbc As Long, _
ByVal pwzUrl As String, _
pBuffer As Any, _
cbSize As Long, _
ByVal pwzMimeProposed As String, _
dwMimeFlags As Long, _
ppwzMimeOut As Long, _
dwReserved As Long) As Long
In VB6, I can't seem to figure out how to pass the pBuffer parameter of the first 256 characters of a file. When I try to use a Dim buffer() As Byte and populate that, and pass it as the parameter, it throws the error of wrong param even those of the definition is Any.
I've tried to use this example, but passing the entire file name from a file system doesn't seem to work. so I have to try sending it like the C# example with the first 256 bytes of the file.
Can anyone help?
I played around with the following Declare, and built up some code around it. There are two wrappers, GetMimeTypeFromUrl() and GetMimeTypeFromData(). I found the former only worked when you used simple URLs such as http://host.com/file.xtn. You may have to play around with the other flags.
However, the other wrapper function sounds like what you need.
Note that all the string pointers are declared As Long, and I pass the underlying UTF-16 VB string as a pointer using StrPtr().
Also note that you have to use CoTaskMemFree() to free the output ppwzMimeOut string pointer, otherwise you will leak memory.
Option Explicit
Private Declare Function FindMimeFromData Lib "Urlmon.dll" ( _
ByVal pBC As Long, _
ByVal pwzUrl As Long, _
ByVal pBuffer As Long, _
ByVal cbSize As Long, _
ByVal pwzMimeProposed As Long, _
ByVal dwMimeFlags As Long, _
ByRef ppwzMimeOut As Long, _
ByVal dwReserved As Long _
) As Long
'
' Flags:
'
' Default
Private Const FMFD_DEFAULT As Long = &H0
' Treat the specified pwzUrl as a file name.
Private Const FMFD_URLASFILENAME As Long = &H1
' Internet Explorer 6 for Windows XP SP2 and later. Use MIME-type detection even if FEATURE_MIME_SNIFFING is detected. Usually, this feature control key would disable MIME-type detection.
Private Const FMFD_ENABLEMIMESNIFFING As Long = &H2
' Internet Explorer 6 for Windows XP SP2 and later. Perform MIME-type detection if "text/plain" is proposed, even if data sniffing is otherwise disabled. Plain text may be converted to text/html if HTML tags are detected.
Private Const FMFD_IGNOREMIMETEXTPLAIN As Long = &H4
' Internet Explorer 8. Use the authoritative MIME type specified in pwzMimeProposed. Unless FMFD_IGNOREMIMETEXTPLAIN is specified, no data sniffing is performed.
Private Const FMFD_SERVERMIME As Long = &H8
' Internet Explorer 9. Do not perform detection if "text/plain" is specified in pwzMimeProposed.
Private Const FMFD_RESPECTTEXTPLAIN As Long = &H10
' Internet Explorer 9. Returns image/png and image/jpeg instead of image/x-png and image/pjpeg.
Private Const FMFD_RETURNUPDATEDIMGMIMES As Long = &H20
'
' Return values:
'
' The operation completed successfully.
Private Const S_OK As Long = 0&
' The operation failed.
Private Const E_FAIL As Long = &H80000008
' One or more arguments are invalid.
Private Const E_INVALIDARG As Long = &H80000003
' There is insufficient memory to complete the operation.
Private Const E_OUTOFMEMORY As Long = &H80000002
'
' String routines
'
Private Declare Function lstrlen Lib "Kernel32.dll" Alias "lstrlenW" ( _
ByVal lpString As Long _
) As Long
Private Declare Sub CopyMemory Lib "Kernel32.dll" Alias "RtlMoveMemory" (ByVal pDest As Long, ByVal pSrc As Long, ByVal nCount As Long)
Private Declare Sub CoTaskMemFree Lib "Ole32.dll" ( _
ByVal pv As Long _
)
Private Function CopyPointerToString(ByVal in_pString As Long) As String
Dim nLen As Long
' Need to copy the data at the string pointer to a VB string buffer.
' Get the length of the string, allocate space, and copy to that buffer.
nLen = lstrlen(in_pString)
CopyPointerToString = Space$(nLen)
CopyMemory StrPtr(CopyPointerToString), in_pString, nLen * 2
End Function
Private Function GetMimeTypeFromUrl(ByRef in_sUrl As String, ByRef in_sProposedMimeType As String) As String
Dim pMimeTypeOut As Long
Dim nRet As Long
nRet = FindMimeFromData(0&, StrPtr(in_sUrl), 0&, 0&, StrPtr(in_sProposedMimeType), FMFD_DEFAULT, pMimeTypeOut, 0&)
If nRet = S_OK Then
GetMimeTypeFromUrl = CopyPointerToString(pMimeTypeOut)
CoTaskMemFree pMimeTypeOut
Else
Err.Raise nRet
End If
End Function
Private Function GetMimeTypeFromData(ByRef in_abytData() As Byte, ByRef in_sProposedMimeType As String) As String
Dim nLBound As Long
Dim nUBound As Long
Dim pMimeTypeOut As Long
Dim nRet As Long
nLBound = LBound(in_abytData)
nUBound = UBound(in_abytData)
nRet = FindMimeFromData(0&, 0&, VarPtr(in_abytData(nLBound)), nUBound - nLBound + 1, StrPtr(in_sProposedMimeType), FMFD_DEFAULT, pMimeTypeOut, 0&)
If nRet = S_OK Then
GetMimeTypeFromData = CopyPointerToString(pMimeTypeOut)
CoTaskMemFree pMimeTypeOut
Else
Err.Raise nRet
End If
End Function
Private Sub Command1_Click()
Dim sRet As String
Dim abytData() As Byte
sRet = GetMimeTypeFromUrl("http://msdn.microsoft.com/en-us/library/ms775107%28v=vs.85%29.aspx", vbNullString)
Debug.Print sRet
abytData() = StrConv("<HTML><HEAD><TITLE>Stuff</TITLE></HEAD><BODY>Test me</BODY></HTML>", vbFromUnicode)
sRet = GetMimeTypeFromData(abytData(), vbNullString)
Debug.Print sRet
End Sub

How to get current HDD type?

I've found a way to get hdd serial no in vb6. But it needs to select an option from
primary master
primary slave
secondary master
secondary slave
But I want to auto select an option. The auto select logic is,
suppose I've 4 HDD with the above 4 types. And the logic will select the hdd type, on which the current system is loaded.
I really have no idea how to detect the current system is on which HDD type. Please help.
Here is the class that I use to select HDD serial no. HDSN CLASS
The code below should help:
Option Explicit
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const IOCTL_VOLUME_BASE As Long = 86 ' Asc("V")
Private Const METHOD_BUFFERED As Long = 0
Private Const FILE_READ_ACCESS As Long = 1
Private Const FILE_ANY_ACCESS As Long = 0
'DEFINE IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS CTL_CODE(IOCTL_VOLUME_BASE, 0, METHOD_BUFFERED, FILE_ANY_ACCESS)
Private Const IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS = (((IOCTL_VOLUME_BASE) * (2& ^ 16&)) Or ((FILE_ANY_ACCESS) * (2& ^ 14&)) Or ((0&) * (2& ^ 2&)) Or (METHOD_BUFFERED))
Private Type DISK_EXTENT
DiskNumber As Long
StartingOffset As Currency
ExtentLength As Currency
End Type
Private Type VOLUME_DISK_EXTENTS
NumberOfDiskExtents As Currency
Extents(1 To 4) As DISK_EXTENT
End Type
Private Declare Function CreateFile _
Lib "kernel32" Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle _
Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Declare Function GetWindowsDirectory Lib "Kernel32.dll" Alias "GetWindowsDirectoryW" ( _
ByVal lpBuffer As Long, _
ByVal uSize As Long _
) As Long
Private Declare Function DeviceIoControlNoInput _
Lib "kernel32" Alias "DeviceIoControl" _
(ByVal hDevice As Long, _
ByVal dwIoControlCode As Long, _
ByVal lpInBuffer As Long, _
ByVal nInBufferSize As Long, _
ByRef lpOutBuffer As Any, _
ByVal nOutBufferSize As Long, _
ByRef lpBytesReturned As Long, _
ByVal lpOverlapped As Long) As Long
' Return the index of the physical drive from which we've booted into Windows.
Public Function GetBootPhysicalDrive() As Long
Dim sWindowsPath As String
Dim nRet As Long
Dim sDevicePath As String
Dim hLogicalBootDrive As Long
Dim sVolumeDevice As String
Dim uVolumeDiskExtents As VOLUME_DISK_EXTENTS
Dim nBytesReturned As Long
' Allocate space and retrieve the windows directory.
sWindowsPath = Space$(64)
nRet = GetWindowsDirectory(StrPtr(sWindowsPath), 64)
' This gives us the volume that Windows is on. Open it.
sVolumeDevice = "\\.\" & Left$(sWindowsPath, 2)
hLogicalBootDrive = CreateFile(sVolumeDevice, GENERIC_READ + GENERIC_WRITE, FILE_SHARE_READ + FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
' Find out information about this volume.
nRet = DeviceIoControlNoInput(hLogicalBootDrive, IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS, 0&, 0&, uVolumeDiskExtents, LenB(uVolumeDiskExtents), nBytesReturned, 0&)
If nRet = 0 Then
' Something went wrong. Return error value.
GetBootPhysicalDrive = -1
Else
' This is the physical disk number.
GetBootPhysicalDrive = uVolumeDiskExtents.Extents(1).DiskNumber
End If
' Close volume.
CloseHandle hLogicalBootDrive
End Function
Using theAbove Solution of Mark Bertenshaw I wrote the following in a module and just called the GetDiskSerialNumber function to get serial of the HDD from which the current system is Booted. Here is my module code:
Option Explicit
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const IOCTL_VOLUME_BASE As Long = 86 ' Asc("V")
Private Const METHOD_BUFFERED As Long = 0
Private Const FILE_READ_ACCESS As Long = 1
Private Const FILE_ANY_ACCESS As Long = 0
'DEFINE IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS CTL_CODE(IOCTL_VOLUME_BASE, 0, METHOD_BUFFERED, FILE_ANY_ACCESS)
Private Const IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS = (((IOCTL_VOLUME_BASE) * (2& ^ 16&)) Or ((FILE_ANY_ACCESS) * (2& ^ 14&)) Or ((0&) * (2& ^ 2&)) Or (METHOD_BUFFERED))
Private Type DISK_EXTENT
DiskNumber As Long
StartingOffset As Currency
ExtentLength As Currency
End Type
Private Type VOLUME_DISK_EXTENTS
NumberOfDiskExtents As Currency
Extents(1 To 4) As DISK_EXTENT
End Type
Private Declare Function CreateFile _
Lib "kernel32" Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle _
Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Declare Function GetWindowsDirectory Lib "Kernel32.dll" Alias "GetWindowsDirectoryW" ( _
ByVal lpBuffer As Long, _
ByVal uSize As Long _
) As Long
Private Declare Function DeviceIoControlNoInput _
Lib "kernel32" Alias "DeviceIoControl" _
(ByVal hDevice As Long, _
ByVal dwIoControlCode As Long, _
ByVal lpInBuffer As Long, _
ByVal nInBufferSize As Long, _
ByRef lpOutBuffer As Any, _
ByVal nOutBufferSize As Long, _
ByRef lpBytesReturned As Long, _
ByVal lpOverlapped As Long) As Long
' Return the index of the physical drive from which we've booted into Windows.
Public Function GetBootPhysicalDrive() As Long
Dim sWindowsPath As String
Dim nRet As Long
Dim sDevicePath As String
Dim hLogicalBootDrive As Long
Dim sVolumeDevice As String
Dim uVolumeDiskExtents As VOLUME_DISK_EXTENTS
Dim nBytesReturned As Long
' Allocate space and retrieve the windows directory.
sWindowsPath = Space$(64)
nRet = GetWindowsDirectory(StrPtr(sWindowsPath), 64)
' This gives us the volume that Windows is on. Open it.
sVolumeDevice = "\\.\" & Left$(sWindowsPath, 2)
hLogicalBootDrive = CreateFile(sVolumeDevice, GENERIC_READ + GENERIC_WRITE, FILE_SHARE_READ + FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&)
' Find out information about this volume.
nRet = DeviceIoControlNoInput(hLogicalBootDrive, IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS, 0&, 0&, uVolumeDiskExtents, LenB(uVolumeDiskExtents), nBytesReturned, 0&)
If nRet = 0 Then
' Something went wrong. Return error value.
GetBootPhysicalDrive = -1
Else
' This is the physical disk number.
GetBootPhysicalDrive = uVolumeDiskExtents.Extents(1).DiskNumber
End If
' Close volume.
CloseHandle hLogicalBootDrive
End Function
Public Function GetDiskSerialNumber() As String
Dim wmiObject As Object
Dim obj As Object
Set wmiObject = GetObject("WinMgmts:")
For Each obj In wmiObject.InstancesOf("Win32_PhysicalMedia")
If obj.Tag = "\\.\PHYSICALDRIVE" + CStr(GetBootPhysicalDrive) Then GetDiskSerialNumber = obj.Tag + " : " + obj.SerialNumber
Next obj
End Function
Many thanks to Mark Bertenshaw.

Resources