Страницы: 1 2 След.
RSS
Просьба протестировать работу макроса
 
Приветствую, коллеги

У меня к вам просьба, - запустить макрос, и скопировать в свой ответ результат работы макроса из окна Immediate
Хочу узнать, на всех ли компах будет работать, и как медленно выполняется код.
(код планируется использовать на тысячах самых разных компов)

Важно! При первом запуске макроса, он выполняется гораздо медленнее, чем при последующих,
потому мне хотелось бы увидеть результат вывода после ПЕРВОГО запуска макроса.

Собственно, код:
Код
Sub test_WMI()
    On Error Resume Next: Err.Clear
    Dim obj As Object, DriveID$, PartName$, t As Double: t = Timer
    With GetObject("winmgmts:{impersonationLevel=Impersonate}!//.")
        For Each obj In .ExecQuery("ASSOCIATORS OF {Win32_LogicalDisk.DeviceID='" & Environ("SystemDrive") & "'} 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$, "\", "\\") & "'"): Debug.Print obj.Caption, obj.Signature: Next
        For Each obj In .ExecQuery("SELECT * FROM Win32_BaseBoard"): Debug.Print "Материнская плата: " & obj.SerialNumber: Next
        Debug.Print "Partition = " & PartName$, "DriveID = " & DriveID$: Debug.Print "time = " & Format(Timer - t, "0.00 сек.")
        If Err Then Debug.Print "error " & Err.Number, Err.Description
    End With
End Sub 

Вставьте код в любой модуль, нажмите Ctrl + G (чтобы отобразить окно Immediate),
потом поставьте курсор в макрос, и нажмите F5 для запуска макроса.

В окне Immediate появится результат типа такого, - вот он меня и интересует:
Цитата
WDC WD10EZRX-00A8LB0 ATA Device           -458719218
Материнская плата: MS1C64B15802714
Partition = Disk #1, Partition #0         DriveID = \\.\PHYSICALDRIVE1
time = 1,28 сек.
PS: Если не затруднит, - напишите время (последняя строка вывода) повторного запуска макроса (например, time = 0,22 сек.), и какая версия Windows у вас установлена.

Заранее спасибо)
 
Игорь, на моем компе эти объекты вообще не выводятся, возможно из-за каких-то настроек или железа.
Поэтому результат такой:
Partition = DriveID =
time = 0,25 сек.
error 91 Object variable or With block variable not set

Ошибка возникает на первом же For Each
Изменено: ZVI - 03.07.2014 05:43:16
 
Большое спасибо, Владимир

Не подскажете, можно ли надеяться на наличие непустой переменной окружения Environ "SystemDrive"?
(или она может быть пустой?)

А вообще на WMI?

а с таким вариантом первой строки работает?
Код
With GetObject("winmgmts:{impersonationLevel=Impersonate}!//./") 
или с таким?
Код
With GetObject("winmgmts:") 
 
А такой макрос ещё можете проверить?
Код
Sub test_2_WMI()
    ' http://msdn.microsoft.com/en-us/library/aa394592(v=vs.85).aspx
    ComputerName = "."
    Set wmiServices = GetObject("winmgmts:{impersonationLevel=Impersonate}!//.")
    Set wmiDiskDrives = wmiServices.ExecQuery("SELECT Caption, DeviceID, Signature FROM Win32_DiskDrive")

    For Each wmiDiskDrive In wmiDiskDrives
        Debug.Print vbNewLine & "Disk drive Caption: " & wmiDiskDrive.Caption & vbNewLine & "DeviceID: " & " (" & wmiDiskDrive.DeviceID & ")"

        'Use the disk drive device id to     find associated partition
        Query = "ASSOCIATORS OF {Win32_DiskDrive.DeviceID='" & wmiDiskDrive.DeviceID & "'} WHERE AssocClass = Win32_DiskDriveToDiskPartition"
        Set wmiDiskPartitions = wmiServices.ExecQuery(Query)

        For Each wmiDiskPartition In wmiDiskPartitions
            'Use partition device id to find logical disk
            Set wmiLogicalDisks = wmiServices.ExecQuery("ASSOCIATORS OF {Win32_DiskPartition.DeviceID='" & wmiDiskPartition.DeviceID & "'} WHERE AssocClass = Win32_LogicalDiskToPartition")

            For Each wmiLogicalDisk In wmiLogicalDisks
                Debug.Print "Letter = " & wmiLogicalDisk.DeviceID, wmiDiskDrive.Signature
                Debug.Print "Drive = " & wmiDiskDrive.Caption & ", DeviceID = " & wmiDiskDrive.DeviceID, " Partition = " & wmiDiskPartition.DeviceID
            Next
        Next
    Next
End Sub
 
Результат должен быть типа такого:
Цитата
Disk drive Caption: ST31000524NS ATA Device
DeviceID:  (\\.\PHYSICALDRIVE0)
Letter = H:   -973683210
Drive = ST31000524NS ATA Device, DeviceID = \\.\PHYSICALDRIVE0         Partition = Disk #0, Partition #0
Letter = I:   -973683210
Drive = ST31000524NS ATA Device, DeviceID = \\.\PHYSICALDRIVE0         Partition = Disk #0, Partition #1
Letter = J:   -973683210
Drive = ST31000524NS ATA Device, DeviceID = \\.\PHYSICALDRIVE0         Partition = Disk #0, Partition #1
Моя задача, - получить сигнатуру HDD физического диска, на котором расположен системный раздел
 
Первый макрос, первый запуск (на работе Win-7):
ATA WDC WD5000AAKX-0 SCSI Disk Device     -457779567
Материнская плата: B22F3065
Partition = Disk #0, Partition #1   DriveID = \\.\PHYSICALDRIVE0
time = 0,84 сек.

Дома проверю на ХР
 
TOSHIBA MK5065GSX            2004080449
Материнская плата: BSS-0123456789
Partition = Disk #0, Partition #0         DriveID = \\.\PHYSICALDRIVE0
time = 0,67 сек.

повторный запуск - 0,44 сек., третий и далее - 0,22
Win XP
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
Второй макрос:
Disk drive Caption: ATA ST3200827AS SCSI Disk Device
DeviceID:  (\\.\PHYSICALDRIVE1)
Letter = F:    33344700
Drive = ATA ST3200827AS SCSI Disk Device, DeviceID = \\.\PHYSICALDRIVE1  Partition = Disk #1, Partition #0

Disk drive Caption: ATA WDC WD5000AAKX-0 SCSI Disk Device
DeviceID:  (\\.\PHYSICALDRIVE0)
Letter = C:   -457779567
Drive = ATA WDC WD5000AAKX-0 SCSI Disk Device, DeviceID = \\.\PHYSICALDRIVE0   Partition = Disk #0, Partition #1
Letter = D:   -457779567
Drive = ATA WDC WD5000AAKX-0 SCSI Disk Device, DeviceID = \\.\PHYSICALDRIVE0   Partition = Disk #0, Partition #2
 
Disk drive Caption: TOSHIBA MK5065GSX
DeviceID:  (\\.\PHYSICALDRIVE0)
Letter = C:    2004080449
Drive = TOSHIBA MK5065GSX, DeviceID = \\.\PHYSICALDRIVE0               Partition = Disk #0, Partition #0
Letter = D:    2004080449
Drive = TOSHIBA MK5065GSX, DeviceID = \\.\PHYSICALDRIVE0               Partition = Disk #0, Partition #1

Disk drive Caption: HUAWEI SD Storage USB Device
DeviceID:  (\\.\PHYSICALDRIVE1)
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
Повторный запуск первого макроса: 0,38 и потом 0,33
 
Спасибо всем за тестирование

Ждём результатов от других форумчан, - надо добиться работы макроса на 100% компов
(хочу узнать, будет у кого-нибудь ошибка, как у ZVI, и понять причину ошибки)
По идее, WMI должен работать на любой версии Windows

Если кто-то дружит с WMI, и может подсказать, что подправить в коде, - буду раз выслушать замечания и пожелания.


PS: Сразу вопрос:
функция .ExecQuery(запрос) объекта WMI возвращает коллекцию (или что-то типа коллекции) объектов
Как, без цикла, получить значение из первого возвращенного объекта?

сейчас используется цикл вида
Код
For Each obj In .ExecQuery("запрос"): Результат$ = obj.ParameterName: Next 
а хотелось бы упростить (т.к. интересует всегда только первый объект из выдачи)
что-то типа
Код
Результат$ = .ExecQuery("запрос").Item(1).ParameterName
Пробовал варианты Item(0) Item(1) Items(0) Items(1) Item() - не работает
Изменено: Игорь - 03.07.2014 06:50:27
 
Второй макрос виснет на test_2_WMI() на строке For Each wmiDiskDrive In wmiDiskDrives, потому что в отладчике wmiDiskDrives.Count показывает <Класс не зарегистрирован>
На переменные окружения расчитывать можно, если не учитывать, что их кто-то специально поменяет, например, в ярлыке запуска.
На моем компе, если сделать так:
Код
  Dim x As Object
  Set x = GetObject("winmgmts:") 

то в Locals Windows увидим:


Поэтому к WMI мой интерес пропал давно. Хотя это, возможно, и глюк моего компьютера.
Когда-то видел код с API, который работал надежнее и значительно быстрее.

Серийный номер SerialNumber логического диска можно вытащить из FSO.Drives, но этот номер меняется при форматировании
Изменено: ZVI - 03.07.2014 06:59:44
 
Владимир, я бы очень хотел найти код на WinAPI, — но пока не попадалось ничего
Поищу — тормоза мне не нравятся, а вероятность несработки кода вообще очень напрягает

Проблема в том, что код должен работать на самых разных версиях Windows - от WinXP до Win8 (32 и 64 бит) с самой разной архитектурой
Не уверен, что универсальность кода на WinAPI будет на высоте - WMI, возможно, более универсальное решение

PS: Серийник материнской платы не важен, - главное, сигнатуру физического диска считать
Если кто видел примеры кода на VB для работы с физическими дисками, - пожалуйста, напишите хоть названия функций или библиотек

------
Цитата

На моем компе, если сделать так:
Код
Dim x As Object
Set x = GetObject("winmgmts:"  ;)  
то в Locals Windows увидим:
у меня с этим кодом видно то же самое
но макрос работает

Цитата
Серийный номер SerialNumber логического диска можно вытащить из FSO.Drives, но этот номер меняется при форматировании
я сейчас так и делаю
но меня постоянно напрягают пользователи, которые переустановили Windows, - приходится давать им дополнительные бесплатные активации
Потому и затеял создание такой привязки, которая не слетает после форматирования HDD

--------------

Еще такая проблема: (цитата с одного из форумов)
Цитата
> Как определить какому HDD принадлежит логический диск?
Он может вообще ни одному не принадлежать.
Как и принадлежать сразу нескольким. Это не только RAID, но и возможность создания тома на нескольких дисках. Так что это нетривиальная задача.
Как тут отработают WinAPI - неизвестно...

WinAPI функция GetVolumeInformation точно не подходит:
Цитата

lpVolumeSerialNumber [out, optional]
This function returns the volume serial number that the operating system assigns when a hard disk is formatted. To programmatically obtain the hard disk's serial number that the manufacturer assigns, use the Windows Management Instrumentation (WMI) Win32_PhysicalMedia property SerialNumber.
Изменено: Игорь - 03.07.2014 07:16:06
 
Игорь, сейчас поищу в своем архиве, точно помню, что сохранял у себя и это работало на моем компе.
 
Вот ссылка на вариант с API (32 bit), который у меня быстро и надежно определяет и модель и серийный номер обоих винчестеров.
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=57366&lngWId=1
Оригинал вроде бы взят отсюда: http://vbnet.mvps.org/index.html?code/disk/smartide.htm
Остается только код сделать еще и 64-битным.
Если что-то по ссылке не скачается, то у меня есть копия архива.
Изменено: ZVI - 03.07.2014 07:22:34
 
Спасибо, Владимир
Только что сам нашел такой же код, протестировал, - вроде работает.
http://www.vbforums.com/showthread.php?456757-Code-Hard-Disk-Serial-Number-(firmware-)

Смущает то, что кода - километр, и, похоже, он работает с использованием тех же внутренностей Windows, что и WMI:
Цитата
Код
hdh = CreateFile("\\.\PhysicalDrive" & mvarCurrentDrive 
Очень древний код, и что-то пишут про проблемы с ним на современных дисках и системах.

Сейчас буду внимательно изучать современные отзывы

3 строки кода с WMI - гораздо более симпатичное решение
Будем ждать результаты тестирования форумчанами (если в 98% случаев будет работать - в оставшихся 2% случаев буду брать SN логического диска)

---------------
PS: Изучил отзывы - этот вариант не подходит, т.к. макрос должен работать с правами пользователя в любой версии Windows:
Цитата
I played around for a while, and the "blank fields" are due to User Account Control in Vista. The CreateFile function that is called needs to have administrative permissions (see http://msdn2.microsoft.com/en-us/lib...8(VS.85).aspx).

If you're developing an app that you'll only run yourself, you can just right-click the application and choose "Run as Administrator." For real world software, you'll need a Vista UAC work around.
придется разбираться с WMI, скорее всего
Изменено: Игорь - 03.07.2014 07:37:29
 
Игорь, помнится, на SQL.RU кто-то жаловался на отсутствие универсальности определения серийного номера HDD, и в случае несрабатывания надежных методов он вроде бы прописывал код "от балды", но с какой-то статической контрольной суммой, насколько я понял. Вероятность того, что этим воспользуются, невысока и  не стоит того, чтобы тратить доп. время на выписку новых лицензий при переформатировании.
Кстати, там по ссылке про WMI написано, что его могут и отключить: The WMI part is easy but a user can easily disable or uninstall WMI from his or her system and this will break any software which is built around WMI. I am not interested in that....
Изменено: ZVI - 03.07.2014 07:58:35
 
Поднятием прав exe до административных на SQL.RU занимался Дмитрий77
 
Владимир, да какое мне поднятие прав...
У меня же не EXE, а обычный XLS (XLA)
Из-за нескольких строк кода, мудрить сложную систему не буду

Меня вполне устраивает озвученный вами вариант:
Цитата
в случае несрабатывания надежных методов он вроде бы прописывал код "от балды"

Осталось только понять, как часто мой код (из первого поста) срабатывает
Пока только у вас не сработало
Ждём новостей с других компов)
 
К сожаленю не знаю, поможет ли мое мнение. Проверяю с рабочего. Сижу на тонком клиенте, поэтому выполнение где-то на сервере, знаю что W7 64x, MS Excel 2010, остальной просмотр заблочен коллегами из IT.

Игорь у меня результат
Partition =   DriveID =
time = 30281.59 cек.
Но:
1. Это только если я не использую
Код
If Err Then Debug.Print "error " & Err.Number, Err.Description
С ним вообще не дает. "Invalid watch expression"
2. Выполняется код за секунду, но все равно пишет время более 30 тыс сек.
Изменено: Abakumov - 03.07.2014 15:06:49 (Забыл версию Excel указать)
Когда испробованы все варианты, я начинаю плясать с бубном. Как правило — помогает.
 
хм... Invalid watch expression... что-то новенькое
Пришлось пользоваться гуглом, чтобы узнать, что за чудная ошибка

Код надо вставлять в модуль листа или в модуль книги или в стандартный модуль, а не в окно Immediate!
В окне Immediate будет РЕЗУЛЬТАТ выполнения макроса

Тогда такая ошибка не будет появляться
(а вы выполняли код построчно - потому и результат пустой, и время неправильное)
Изменено: Игорь - 03.07.2014 08:56:46
 
WinXP

WDC WD3200AAKS-00B3A0        819767
Материнская плата:  
Partition = Disk #0, Partition #0         DriveID = \\.\PHYSICALDRIVE0
time = 0,45 сек.
WDC WD3200AAKS-00B3A0        819767
Материнская плата:  
Partition = Disk #0, Partition #0         DriveID = \\.\PHYSICALDRIVE0
time = 0,09 сек.
WDC WD3200AAKS-00B3A0        819767
Материнская плата:  
Partition = Disk #0, Partition #0         DriveID = \\.\PHYSICALDRIVE0
time = 0,13 сек.


Disk drive Caption: WDC WD3200AAKS-00B3A0
DeviceID:  (\\.\PHYSICALDRIVE0)
Letter = C:    819767
Drive = WDC WD3200AAKS-00B3A0, DeviceID = \\.\PHYSICALDRIVE0           Partition = Disk #0, Partition #0
Letter = D:    819767
Drive = WDC WD3200AAKS-00B3A0, DeviceID = \\.\PHYSICALDRIVE0           Partition = Disk #0, Partition #1

Disk drive Caption: StoreJet Transcend USB Device
DeviceID:  (\\.\PHYSICALDRIVE1)
Letter = H:    4536346
Drive = StoreJet Transcend USB Device, DeviceID = \\.\PHYSICALDRIVE1   Partition = Disk #1, Partition #0
 
На Win7
WDC WD5000AAKX-60U6AA0 1080389014
Материнская плата: CZC3263JPV
Partition = Disk #0, Partition #1   DriveID = \\.\PHYSICALDRIVE0
time = 0,45 сек.
Последующие запуски макроса в основном дают время в диапазоне 0,28-0,31 сек., иногда выпадало меньше (мин 0,19) иногда чуть больше до 0,39
 
Дома (ХР).
Первый:
ST375052 8AS SCSI Disk Device -1010580541
Материнская плата:
Partition = Disk #0, Partition #0 DriveID = \\.\PHYSICALDRIVE0
time = 0,42 сек.
Повторный 0,22
===
Второй:
Disk drive Caption: ST375052 8AS SCSI Disk Device
DeviceID: (\\.\PHYSICALDRIVE0)
Letter = C: -1010580541
Drive = ST375052 8AS SCSI Disk Device, DeviceID = \\.\PHYSICALDRIVE0 Partition = Disk #0, Partition #0
Letter = D: -1010580541
Drive = ST375052 8AS SCSI Disk Device, DeviceID = \\.\PHYSICALDRIVE0 Partition = Disk #0, Partition #1
 
Первый макрос: Invalid in Immediate pane.
Второй макрос то же самое.

Win7x64, Office2010x64, notebook Asus X55A.

Перечитал. Исправился.
Первый:
===
Второй:
Изменено: JayBhagavan - 03.07.2014 14:31:40

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
первый прогон:
ATA KINGSTON SMS200S SCSI Disk Device      1768273343
Материнская плата: To be filled by O.E.M.
Partition = Disk #1, Partition #1         DriveID = \\.\PHYSICALDRIVE1
time = 0,09 сек.

Второй:
ATA KINGSTON SMS200S SCSI Disk Device      1768273343
Материнская плата: To be filled by O.E.M.
Partition = Disk #1, Partition #1         DriveID = \\.\PHYSICALDRIVE1
time = 0,07 сек.
 
Павел, добавьте информацию о системе.
 
Игорь, доброе время суток
Может так будет побыстрее, да и системный диск не из переменной окружения?
Код
Public Sub test()
    Const PartQuery = "ASSOCIATORS OF {Win32_LogicalDisk.DeviceID='$1'} WHERE ResultClass = Win32_DiskPartition"
    Const DiskQuery = "ASSOCIATORS OF {Win32_DiskPartition='$1'} Where ResultClass = Win32_DiskDrive"
    Dim pWMI As Object, pOS As Object, pOSItem As Object
    Dim pPartitions As Object, pPartition As Object
    Dim pDisks As Object, pDisk As Object, t As Single
    t = Timer
    Set pWMI = GetObject("winmgmts:\\.\root\cimv2")
    Set pOS = pWMI.ExecQuery("Select SystemDevice,SystemDrive From Win32_OperatingSystem", , 48)
    For Each pOSItem In pOS
        Set pPartitions = pWMI.ExecQuery(Replace$(PartQuery, "$1", pOSItem.SystemDrive))
        For Each pPartition In pPartitions
            Set pDisks = pWMI.ExecQuery(Replace$(DiskQuery, "$1", pPartition.DeviceID))
            For Each pDisk In pDisks
                Debug.Print pDisk.SerialNumber
                Debug.Print pDisk.Signature
                Debug.Print pDisk.Caption
            Next
        Next
    Next
    Debug.Print Timer - t
End Sub
 

Win7 64бит с SSD, Excel 2010 32бин - 0.28 секунды на первом запуске. Ваш второй на втором запуске 0.18
 
Windows 7
Первый прогон:

Скрытый текст

Второй прогон - 0,41, третий и далее - ~0.35

Второй тест:
Скрытый текст
 
Андрей,  у меня отказывается обрабатывать строку. Говорит не поддерживаю...
             
Код
 Debug.Print pDisk.SerialNumber
 
Андрей, добрый день.
Цитата
Говорит не поддерживаю...
Да, спасибо, пропустил, что в XP и 2003 не поддерживается SerialNumber, тогда придётся добавить ещё один запрос
Скрытый текст

Проверьте, пожалуйста, у меня только Win7.
Страницы: 1 2 След.
Наверх