Серийный номер железа или как ещё привязать к компьютеру?

MsgBox CreateObject("Scripting.FileSystemObject").GetDrive("C:").SerialNumber, , "SN Drive C:"

Private Function GetMACAddress( _
                 ByRef bData() As Byte) As Boolean
    Dim bAdapterInfo()  As Byte
    Dim lRet            As Long
    Dim lSize           As Long
    Dim bMACAddress()   As Byte
    Dim lMACAddresSize  As Long
    
    ' // Get MAC address
    lSize = &H288
    ReDim bAdapterInfo(lSize - 1)
 
    lRet = GetAdaptersInfo(bAdapterInfo(0), lSize)
    
    If lRet = ERROR_BUFFER_OVERFLOW Then
    
        ReDim bAdapterInfo(lSize - 1)
        lRet = GetAdaptersInfo(bAdapterInfo(0), lSize)
        
    End If
 
    If lRet = 0 Then
        
        GetMem4 bAdapterInfo(&H190), lMACAddresSize
        
        If lMACAddresSize > 0 Then
            
            ReDim bData(lMACAddresSize - 1)
            memcpy bData(0), bAdapterInfo(&H194), lMACAddresSize
            
            GetMACAddress = True
            
        End If
        
    End If
    
End Function

Private Function GetCPUIDInfo( _
                 ByRef bData() As Byte) As Boolean
    Dim pCode       As Long
    Dim types()     As Integer
    Dim list()      As Long
    Dim param()     As Variant
    
    pCode = VirtualAlloc(0&, &H1000, MEM_COMMIT Or MEM_RESERVE, PAGE_EXECUTE_READWRITE)
    If pCode = 0 Then Exit Function
    
    GetMem8 -842598367924536.4653@, ByVal pCode
    GetMem8 -857273203654571.5132@, ByVal pCode + 8
    GetMem8 88933012021608.5599@, ByVal pCode + &H10
    GetMem8 3762050.5183@, ByVal pCode + &H18
    
    ReDim bData(&H20 - 1)
    ReDim types(1)
    ReDim list(1)
    ReDim param(1)
    
    param(0) = VarPtr(bData(0)):    param(1) = 0&
    types(0) = vbLong:              types(1) = vbLong
    list(0) = VarPtr(param(0)):     list(1) = VarPtr(param(1))
    
    DispCallFunc 0, pCode, CC_STDCALL, vbEmpty, 2, types(0), list(0), Null
    
    param(0) = VarPtr(bData(&H10)): param(1) = 1&
    
    DispCallFunc 0, pCode, CC_STDCALL, vbEmpty, 2, types(0), list(0), Null
    
    VirtualFree pCode, 0, MEM_RELEASE
    
    GetCPUIDInfo = True
    
End Function

Private Function GetHDDInfo( _
                 ByRef bData() As Byte) As Boolean
    Dim guidDiskInterface   As Guid
    Dim hSet                As Long
    Dim tInterfaceData      As SP_DEVICE_INTERFACE_DATA
    Dim lDeviceIndex        As Long
    Dim lRequiredSize       As Long
    Dim pDataDetail         As Long
    Dim hDisk               As Long
    Dim tDiskNumber         As STORAGE_DEVICE_NUMBER
    Dim bLocalData()        As Byte
    Dim lSize               As Long
    Dim lLocalSize          As Long
    Dim lIndex              As Long
    
    ' // GUID_DEVINTERFACE_DISK {53F56307-B6BF-11D0-94F2-00A0C91EFB8B}
    With guidDiskInterface
    
        .Data1 = &H53F56307
        .Data2 = &HB6BF
        .Data3 = &H11D0
        .Data4(0) = &H94
        .Data4(1) = &HF2
        .Data4(2) = &H0
        .Data4(3) = &HA0
        .Data4(4) = &HC9
        .Data4(5) = &H1E
        .Data4(6) = &HFB
        .Data4(7) = &H8B
        
    End With
    
    hSet = SetupDiGetClassDevs(guidDiskInterface, 0&, 0&, DIGCF_PRESENT Or DIGCF_DEVICEINTERFACE)
    If hSet = INVALID_HANDLE_VALUE Then Exit Function
    
    tInterfaceData.cbSize = Len(tInterfaceData)
    
    Do While SetupDiEnumDeviceInterfaces(hSet, ByVal 0&, guidDiskInterface, lDeviceIndex, tInterfaceData)
    
        SetupDiGetDeviceInterfaceDetail hSet, tInterfaceData, ByVal 0&, _
                                        0, lRequiredSize, ByVal 0&
        If Err.LastDllError <> ERROR_INSUFFICIENT_BUFFER Then GoTo continue
        
        If pDataDetail Then HeapFree GetProcessHeap(), HEAP_NO_SERIALIZE, pDataDetail
        
        pDataDetail = HeapAlloc(GetProcessHeap(), HEAP_NO_SERIALIZE, lRequiredSize)
        If pDataDetail = 0 Then GoTo continue
        
        GetMem4 6&, ByVal pDataDetail   ' // sizeof(SP_DEVICE_INTERFACE_DETAIL_DATA)
        
        If SetupDiGetDeviceInterfaceDetail(hSet, tInterfaceData, ByVal pDataDetail, _
                        lRequiredSize, 0, ByVal 0&) = 0 Then GoTo continue
        
        If hDisk <> INVALID_HANDLE_VALUE And hDisk <> 0 Then CloseHandle (hDisk)
        
        hDisk = CreateFile(pDataDetail + 4, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, _
                            ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
        If hDisk = INVALID_HANDLE_VALUE Then GoTo continue
        
        If DeviceIoControl(hDisk, IOCTL_STORAGE_GET_DEVICE_NUMBER, ByVal 0&, 0, tDiskNumber, _
                            Len(tDiskNumber), 0, ByVal 0&) = 0 Then GoTo continue
                            
        If Not GetPhysicalDriveInfo(tDiskNumber.DeviceNumber, bLocalData()) Then GoTo continue
        
        lLocalSize = SafeArrayElementsCount(Not Not bLocalData)
        
        If lLocalSize > 0 Then
            
            ReDim Preserve bData(lIndex + 31)
 
            HashData bLocalData(0), lLocalSize, bData(lIndex), 32
            
            lIndex = lIndex + 32
            
        End If
        
continue:
        
        lDeviceIndex = lDeviceIndex + 1
        
    Loop
 
    If hDisk <> INVALID_HANDLE_VALUE And hDisk <> 0 Then CloseHandle (hDisk)
    If pDataDetail Then HeapFree GetProcessHeap(), HEAP_NO_SERIALIZE, pDataDetail
    If hSet <> INVALID_HANDLE_VALUE Then SetupDiDestroyDeviceInfoList (hSet)
    
    GetHDDInfo = True
    
End Function
 
Private Function GetPhysicalDriveInfo( _
                 ByVal lDeviceIndex As Long, _
                 ByRef bData() As Byte) As Boolean
    Dim sDevicePath     As String
    Dim hDevice         As Long
    Dim tProp           As STORAGE_PROPERTY_QUERY
    Dim tHeader         As STORAGE_DESCRIPTOR_HEADER
    Dim pOutBuffer      As Long
    Dim lOffset         As Long
    Dim lLength         As Long
    Dim bPropSerial()   As Byte
    Dim bPropVendor()   As Byte
    Dim bPropModel()    As Byte
    Dim bSmartSerial()  As Byte
    Dim bSmartModel()   As Byte
    Dim pArray          As Long
    
    sDevicePath = "\\.\PhysicalDrive" & CStr(lDeviceIndex)
    
    hDevice = CreateFile(StrPtr(sDevicePath), GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or _
                         FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
    If hDevice = INVALID_HANDLE_VALUE Then Exit Function
    
    tProp.PropertyId = StorageDeviceProperty
    tProp.QueryType = PropertyStandardQuery
    
    If DeviceIoControl(hDevice, IOCTL_STORAGE_QUERY_PROPERTY, tProp, LenB(tProp), tHeader, _
                        Len(tHeader), 0, ByVal 0&) = 0 Then GoTo CleanUp
                        
    pOutBuffer = HeapAlloc(GetProcessHeap(), HEAP_NO_SERIALIZE, tHeader.Size)
    If pOutBuffer = 0 Then GoTo CleanUp
    
    If DeviceIoControl(hDevice, IOCTL_STORAGE_QUERY_PROPERTY, tProp, LenB(tProp), ByVal pOutBuffer, _
                        tHeader.Size, 0&, ByVal 0&) = 0 Then GoTo SMART_METHOD
                                        
    GetMem4 ByVal pOutBuffer + &H18, lOffset
    
    If lOffset Then
    
        lLength = lstrlenA(ByVal pOutBuffer + lOffset)
        If lLength > 0 Then
            
            ReDim bPropSerial(lLength - 1)
            memcpy bPropSerial(0), ByVal pOutBuffer + lOffset, lLength
 
        End If
 
    End If
    
    GetMem4 ByVal pOutBuffer + &HC, lOffset
    
    If lOffset Then
    
        lLength = lstrlenA(ByVal pOutBuffer + lOffset)
        If lLength > 0 Then
            
            ReDim bPropVendor(lLength - 1)
            memcpy bPropVendor(0), ByVal pOutBuffer + lOffset, lLength
 
        End If
 
    End If
    
    GetMem4 ByVal pOutBuffer + &H10, lOffset
    
    If lOffset Then
    
        lLength = lstrlenA(ByVal pOutBuffer + lOffset)
        If lLength > 0 Then
            
            ReDim bPropModel(lLength - 1)
            memcpy bPropModel(0), ByVal pOutBuffer + lOffset, lLength
 
        End If
 
    End If
    
SMART_METHOD:
 
    Dim tCmdIn          As SENDCMDINPARAMS
    Dim tCmdOut         As SENDCMDOUTPARAMS
    Dim tSmartVersion   As GETVERSIONOUTPARAMS
    Dim lIndex          As Long
    
    If DeviceIoControl(hDevice, SMART_GET_VERSION, ByVal 0&, 0, tSmartVersion, _
                       Len(tSmartVersion), 0, 0) = 0 Then GoTo COLLECT_INFO
                     
    tCmdIn.cBufferSize = 512
    tCmdIn.irDriveRegs.bCommandReg = ID_CMD
    
    If DeviceIoControl(hDevice, SMART_RCV_DRIVE_DATA, tCmdIn, LenB(tCmdIn), _
                       tCmdOut, LenB(tCmdOut), 0, ByVal 0&) = 0 Then GoTo COLLECT_INFO
                       
    ReDim bSmartSerial(19)
    ReDim bSmartModel(39)
    
    memcpy bSmartSerial(0), tCmdOut.bBuffer(&H14), 20
    memcpy bSmartModel(0), tCmdOut.bBuffer(&H36), 40
    
COLLECT_INFO:
    
    lLength = SafeArrayElementsCount(Not Not bPropSerial) + _
              SafeArrayElementsCount(Not Not bPropModel) + _
              SafeArrayElementsCount(Not Not bPropVendor) + _
              SafeArrayElementsCount(Not Not bSmartSerial) + _
              SafeArrayElementsCount(Not Not bSmartModel) + 5 * 2
              
    ReDim bData(lLength - 1)
    lOffset = 0
    
    For lIndex = 0 To 4
        
        Select Case lIndex
        Case 0: pArray = Not Not bPropSerial
        Case 1: pArray = Not Not bPropVendor
        Case 2: pArray = Not Not bPropModel
        Case 3: pArray = Not Not bSmartSerial
        Case 4: pArray = Not Not bSmartModel
        End Select
        
        lLength = SafeArrayElementsCount(pArray)
        
        If lLength Then
            
            Select Case lIndex
            Case 0: pArray = VarPtr(bPropSerial(0))
            Case 1: pArray = VarPtr(bPropVendor(0))
            Case 2: pArray = VarPtr(bPropModel(0))
            Case 3: pArray = VarPtr(bSmartSerial(0))
            Case 4: pArray = VarPtr(bSmartModel(0))
            End Select
            
            memcpy bData(lOffset), ByVal pArray, lLength
            lOffset = lOffset + lLength
            
        End If
        
        bData(lOffset) = 13
        bData(lOffset + 1) = 10
        
        lOffset = lOffset + 2
            
    Next
 
    GetPhysicalDriveInfo = True
    
CleanUp:
 
    If pOutBuffer Then HeapFree GetProcessHeap(), HEAP_NO_SERIALIZE, pOutBuffer
    CloseHandle hDevice
    
End Function

Private Function GetComputerInfo( _
                 ByRef bData() As Byte) As Boolean
    Dim lLength As Long
    
    lLength = MAX_COMPUTERNAME_LENGTH + 1
    
    ReDim bData(lLength - 1)
    
    GetComputerName bData(0), lLength
    
    If lLength > 0 Then
    
        ReDim Preserve bData(lLength - 1)
        GetComputerInfo = True
        
    Else
        Erase bData
    End If
 
End Function

    param(0) = VarPtr(bData(0)):    param(1) = 0&
    types(0) = vbLong:              types(1) = vbLong
    list(0) = VarPtr(param(0)):     list(1) = VarPtr(param(1))

    GetMem8 -842598367924536.4653@, ByVal pCode
    GetMem8 -857273203654571.5132@, ByVal pCode + 8
    GetMem8 88933012021608.5599@, ByVal pCode + &H10
    GetMem8 3762050.5183@, ByVal pCode + &H18

Private Declare Function GetMem1 Lib "msvbvm60" ( _
                         ByRef src As Any, _
                         ByRef dst As Any) As Long
Private Declare Function GetMem2 Lib "msvbvm60" ( _
                         ByRef src As Any, _
                         ByRef dst As Any) As Long
Private Declare Function GetMem4 Lib "msvbvm60" ( _
                         ByRef src As Any, _
                         ByRef dst As Any) As Long
Private Declare Function GetMem8 Lib "msvbvm60" ( _
                         ByRef src As Any, _
                         ByRef dst As Any) As Long