Получение сигнатуры жесткого диска (HDD)

Функция получает сигнатуру (уникальный идентификатор) жесткого диска с использованием WMI
Вызов функции обычно занимает от 0,5 до 1 секунды

Function HardwareID() As String
    ' © 2015 ExcelVBA.ru
    ' Функция возвращает сигнатуру HDD
    ' работает на 80% компьютеров (протестировано на тысячах разных компьютеров)
    On Error Resume Next: Dim v&, sv$, obj As Object, DriveID$, PartName$, DriveLetter$
    DriveLetter$ = Environ("SystemDrive"): If Not DriveLetter$ Like "[A-Z]:" Then DriveLetter$ = "C:"
    With GetObject("winmgmts:")
        For Each obj In .ExecQuery("ASSOCIATORS OF {Win32_LogicalDisk.DeviceID='" & DriveLetter$ & "'} WHERE AssocClass = Win32_LogicalDiskToPartition"): PartName$ = obj.DeviceID: Next
        For Each obj In .ExecQuery("ASSOCIATORS OF {Win32_DiskPartition.DeviceID='" & PartName$ & "'} WHERE AssocClass = Win32_DiskDriveToDiskPartition"): DriveID$ = obj.DeviceID: Next
        For Each obj In .ExecQuery("SELECT * FROM Win32_DiskDrive WHERE DeviceID='" & Replace(DriveID$, "\", "\\") & "'"): v& = Val(obj.Signature): Next
    End With
    If v& = 0 Then HardwareID = "нет данных" Else HardwareID = CStr(v)
End Function

Пример использования:

Sub Get_HDD_Signature() ' макрос для вызова функции HardwareID
    CompaterID = HardwareID
    MsgBox CompaterID
End Sub

Комментарии

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
 __  __      _   _  _                _  _         
\ \/ / __| | | || | __ __ | || | ___
\ / / _` | | || |_ \ \ /\ / / | || |_ / __|
/ \ | (_| | |__ _| \ V V / |__ _| \__ \
/_/\_\ \__,_| |_| \_/\_/ |_| |___/
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.