[VB] HWID System

Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Security.Cryptography

Public Class HWID
    <Flags()> _
    Private Enum DockInfo
        DOCKINFO_DOCKED = &H2
        DOCKINFO_UNDOCKED = &H1
        DOCKINFO_USER_SUPPLIED = &H4
        DOCKINFO_USER_DOCKED = &H5
        DOCKINFO_USER_UNDOCKED = &H6
    End Enum

    <StructLayout(LayoutKind.Sequential)> _
    Public Class HW_PROFILE_INFO
        <MarshalAs(UnmanagedType.U4)> _
        Public dwDockInfo As Int32

        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=39)> _
        Public szHwProfileGuid As String

        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=80)> _
        Public szHwProfileName As String
    End Class

    <DllImport("advapi32.dll", SetLastError:=True)> _
    Private Shared Function GetCurrentHwProfile(lpHwProfileInfo As IntPtr) As Boolean
    End Function

    Declare Function GetVolumeInformationA Lib "kernel32" ( _
        PathName As String, _
        VolumeNameBuffer As StringBuilder, _
        VolumeNameSize As UInt32, _
        ByRef VolumeSerialNumber As UInt32, _
        ByRef MaximumComponentLength As UInt32, _
        ByRef FileSystemFlags As UInt32, _
        FileSystemNameBuffer As StringBuilder, _
        FileSystemNameSize As UInt32) As Long

    Private Shared Function ProfileInfo() As HW_PROFILE_INFO
        Dim profile As HW_PROFILE_INFO
        Dim profilePtr As IntPtr = IntPtr.Zero
        Try
            profile = New HW_PROFILE_INFO()
            profilePtr = Marshal.AllocHGlobal(Marshal.SizeOf(profile))
            Marshal.StructureToPtr(profile, profilePtr, False)

            If Not GetCurrentHwProfile(profilePtr) Then
                Throw New Exception("Error cant get current hw profile!")
            Else
                Marshal.PtrToStructure(profilePtr, profile)
                Return profile
            End If
        Catch e As Exception
            Throw New Exception(e.ToString())
        Finally
            If profilePtr <> IntPtr.Zero Then
                Marshal.FreeHGlobal(profilePtr)
            End If
        End Try
    End Function

    Private Shared Function GetVolumeSerial(strDriveLetter As String) As String
        Dim serNum As UInteger = 0
        Dim maxCompLen As UInteger = 0
        Dim VolLabel As New StringBuilder(256)
        Dim VolFlags As New UInt32()
        Dim FSName As New StringBuilder(256)
        strDriveLetter += ":\"
        Dim Ret As Long = GetVolumeInformationA(strDriveLetter, VolLabel, CType(VolLabel.Capacity, UInt32), serNum, maxCompLen, VolFlags, _
         FSName, CType(FSName.Capacity, UInt32))
        Return Convert.ToString(serNum)
    End Function

    Shared Function getHWID() As String
        Dim info As HW_PROFILE_INFO = ProfileInfo()
        Dim GUID As String = info.szHwProfileGuid.ToString()
        Dim volumeserial As String = GetVolumeSerial(Environment.SystemDirectory.Substring(0, 1))

        Dim md5Hasher As MD5 = MD5.Create()
        Dim data As Byte() = md5Hasher.ComputeHash(Encoding.Default.GetBytes(GUID & volumeserial))
        Dim sBuilder As New StringBuilder()

        For i = 0 To data.Length - 1
            sBuilder.Append(data(i).ToString("x2"))
        Next i

        getHWID = sBuilder.ToString()
    End Function
End Class