USBMaster - Рулим флешками в офисе

Sub Система()
 
Dim objWMI As String
OSInfWMI objWMI
 
End Sub

Set objWinOS = objWMI.ExecQuery("SELECT * FROM Win32_OperatingSystem")

Option Explicit 
Dim objWMI, InfoArr, strInfoArr, i
'получаем пространство имен CIMV2
Set objWMI = GetObject("winmgmts:\\.\Root\CIMV2")
'получаем информацию о системе
InfoArr = OSInfWMITrans(objWMI)
'рисуем :)
strInfoArr = "*****************************"
'закидываем информацию из массива в строку
For i = 0 To UBound(InfoArr)
    strInfoArr = strInfoArr & vbCrLf & InfoArr(i)
Next
'снова рисуем :)
strInfoArr = strInfoArr & vbCrLf & "*****************************"
'выкатываем информацию
MsgBox strInfoArr,vbInformation,"Информация о системе"
'удаляем ссылку на объект
Set objWMI = Nothing
 
'функция получения информации об операционной системе
'возвращает массив значений из Win32_OperatingSystem и Win32_ComputerSystem
Function OSInfWMI(objWMI)   
    Dim objWinOS, objWinCS, objObj
    Dim strInfoArr(19) 'массив информации об оси   
    
    Set objWinOS = objWMI.ExecQuery("SELECT * FROM Win32_OperatingSystem")
    '---
    For Each objObj In objWinOS
        With objObj
            strInfoArr(0) = .Caption 'название  системы
            strInfoArr(1) = .Version 'версия оси
            strInfoArr(2) = .ProductType 'тип оси - Additional system information 
            strInfoArr(3) = .OSLanguage 'язык локализации        
            'дата установки
            strInfoArr(4) = Mid(.InstallDate,7,2) & "." & Mid(.InstallDate,5,2) & "." & Left(.InstallDate,4)
            'время последней загрузки
            strInfoArr(5) = Mid(.LastBootUpTime,9,2) & ":" & Mid(.LastBootUpTime,11,2) & "   " & _
                    Mid(.LastBootUpTime,7,2) & "." & Mid(.LastBootUpTime,5,2) & "." & Left(.LastBootUpTime,4)       
            strInfoArr(6) = .SystemDrive 'системный диск 
            strInfoArr(7) = .WindowsDirectory'каталог Windows
            strInfoArr(8) = .SystemDirectory 'каталог system32
            strInfoArr(9) = .SystemDevice   
            strInfoArr(10) = .CSName 'Name of the scoping computer system
            strInfoArr(18) = .ServicePackMajorVersion 'SP - 3
            strInfoArr(19) = .ServicePackMinorVersion
        End With
    Next
    '---
    Set objWinOS = Nothing          
    Set objWinCS = objWMI.ExecQuery("SELECT * FROM Win32_ComputerSystem")   
    For Each objObj In objWinCS 
        With objObj
            'System running on the Windows-based computer
            strInfoArr(11) = .SystemType 'тип оси - x86, x64 и пр.
            'Key of a CIM_System instance in an enterprise environment
            strInfoArr(12) = .Name 'имя компьютера     
            'If True, the computer is part of a domain. 
            'If the value is NULL, the computer is not in a domain or the status is unknown. 
            'If you unjoin the computer from a domain, the value becomes false.
            strInfoArr(13) = .PartOfDomain 'является ли частью домена
            'Note  If the computer is not part of a domain, then the name of the workgroup is returned.
            strInfoArr(14) = .Domain 'имя домена       
            'Name of the workgroup for this computer. 
            'If the value of the PartOfDomain property is False, then the name of the workgroup is returned.        
            strInfoArr(15) = .Workgroup
            'Name ofr a user that is logged on currently. This property must have a value. In a terminal services session, 
            'UserName returns the name of the user that is logged on to the console—not the user logged on during the terminal service session.
            strInfoArr(16) = .UserName  'имя пользователя в формате Компьютер(Домен)\Пользователь
            strInfoArr(17) = .DomainRole 'роль компьютера в сети (домене)
        End With
    Next
    '---
    Set objWinCS = Nothing      
    OSInfWMI = strInfoArr
End Function
 
'функция перевода значений, возвращаемых функцией OSInfWMI
'на человеческий язык - для отображения читабельной информации
Function OSInfWMITrans(objWMI)  
    Dim strInfoArr 'массив значений, получаемых из функции OSInfWMI
    strInfoArr = OSInfWMI(objWMI) 'получаем массив значений   
    Select Case strInfoArr(3) 'переводим язык локализации
        Case 1049
            strInfoArr(3) = "Русский"
        Case 1033
            strInfoArr(3) = "Английский"          
        Case Else
            strInfoArr(3) = "Other"
    End Select
    'Additional system information              
    '1 - Work Station, 2 - Domain Controller, 3 - Server
    Select Case strInfoArr(2) 'информация о системе
        Case 1
            strInfoArr(2) = "Рабочая станция"
        Case 2
            strInfoArr(2) = "Контроллер домена"
        Case 3
            strInfoArr(2) = "Сервер"
    End select
    
    'часть домена
    If Not IsNull(strInfoArr(13)) Or Not strInfoArr(13) Then 
        strInfoArr(13) = "нет"
    Else: strInfoArr(13) = "да"
    End If
    
    'имя пользователя
    strInfoArr(16) = Mid(strInfoArr(16),InStrRev(strInfoArr(16),"\")+1) 'получаем имя пользователя - все что справа после последнего \
        
    'роль компьютера в сети (домене)
    'Role of a computer in an assigned domain workgroup. A domain workgroup is a collection of computers 
    'on the same network. For example, a DomainRole property may show that a computer is a member workstation.
    Select Case strInfoArr(17) 'роль компьютера в сети (домене)
        Case 0          
            strInfoArr(17) = "Standalone Workstation" '(the computer is not a member of a domain)
        Case 1 
            strInfoArr(17) = "Member Workstation" 
        Case 2 
            'Компьютер, выполняющий Server, но не участвующий в домене. Изолированный сервер содержит только 
            'собственную базу данных пользователей и самостоятельно обрабатывает запросы на вход в систему. 
            'Он не использует учетные данные совместно с другими компьютерами и не может предоставлять доступ к учетным записям домена.
            strInfoArr(17) = "Standalone Server" 
        Case 3 
            'Сервер, входящий в некоторый домен, но не выполняющий функции контроллера домена - например, 
            'сервер приложений или коммуникационный сервер.
            strInfoArr(17) = "Member Server" 'рядовой сервер - не контроллер домена
        Case 4 
            'Компьютер, на котором хранятся резервные копии политики безопасности и базы данных домена, 
            'поддерживаемых Windows NT Server 4.0. Служит в качестве резерва для главного контроллера домена. 
            'BDC-контроллер не обязателен в сети, но его рекомендуется использовать. В сетях Windows 2000 понятие BDC отсутствует.
            strInfoArr(17) = "Backup Domain Controller" 
        Case 5 
            'Сервер, на котором хранятся политика безопасности домена и основная база данных домена Windows NT 4.0. 
            'Этот сервер управляет процессом синхронизации информации с резервным контроллером домена (BDC). 
            'В доменах Windows 2000 понятие РОС отсутствует (хотя имеется роль хозяина РОС.), поскольку все контроллеры домена равноправны 
            'и хранят полную реплику базы данных Active Directory, доступную как для чтения, так и для записи. 
            '(Это означает, что изменения - например, добавление учетных записей, изменение атрибутов элементов Active Directory и т. п. - 
            'можно делать на любом ближайшем контроллере домена, после чего эти изменения тиражируются на все другие контроллеры домена.)
            strInfoArr(17) = "Primary Domain Controller"        
    End Select  
    'архитектура
    strInfoArr(11) = Left(strInfoArr(11),3)
    OSInfWMITrans = strInfoArr
End Function