Const ForReading = 1

Const ForWriting = 2

 

strComputer = "."

 

 

 

'Set objComputer = CreateObject("Shell.LocalMachine")

 

Set objWMIService = GetObject( "winmgmts://./root/cimv2" )

               

                Set colItems = objWMIService.ExecQuery( "Select * from Win32_ComputerSystem", "WQL", 48 )

               

                For Each objItem in colItems

                               strComputer = objItem.Name

                Next

 

Set objFSO = CreateObject("Scripting.FileSystemObject")

 

Set objCommentFile = objFSO.OpenTextFile(strComputer & ".ini",  ForWriting, TRUE)

 

 

on error resume next

 

objCommentFile.Write "[Суммарная информация]"

objCommentFile.Write VbCrLf

objCommentFile.Write VbCrLf

 

 

               

objCommentFile.Write "Компьютер|Имя компьютера= " & strComputer & VbCrLf

 

on error resume next

Set colItems = objWMIService.ExecQuery("SELECT TotalVisibleMemorySize FROM Win32_OperatingSystem")

If Err Then ShowError

 

For Each objItem in colItems

     objCommentFile.Write "Системная плата|Системная память= " & round((((objItem.TotalVisibleMemorySize +1023) / 1024) / 1024),0) & " ГБ"  & VbCrLf

Next

 

on error resume next

Set colItems = objWMIService.ExecQuery("SELECT Name FROM Win32_Keyboard")

For Each objItem in colItems

    objCommentFile.Write "Ввод|Клавиатура= " & objItem.Name & VbCrLf

Next

on error resume next

Set colMice = objWMIService.ExecQuery _
    ("Select * from Win32_PointingDevice")

 

For Each objMouse in colMice

     objCommentFile.Write "Ввод|Мышь= " & objMouse.HardwareType & VbCrLf

 

Next

on error resume next

Set colItems = objWMIService.ExecQuery("SELECT Description, Manufacturer FROM Win32_SoundDevice")

i=1

For Each objItem in colItems

    objCommentFile.Write "Мультимедиа|Звуковой адаптер" & i & "=" & ltrim(objItem.Description) & VbCrLf

    i=i+1

Next

on error resume next

Set colItems = objWMIService.ExecQuery("SELECT Product, OtherIdentifyingInfo, SerialNumber, Manufacturer FROM Win32_BaseBoard")

 

For Each objItem in colItems

 

objCommentFile.Write "DMI|DMI серийный номер системной платы= " & ltrim(objItem.SerialNumber) & VbCrLf

 

Next

 

 

objCommentFile.Write VbCrLf

objCommentFile.Write VbCrLf

 

objCommentFile.Write "[DMI]"

 

objCommentFile.Write VbCrLf

objCommentFile.Write VbCrLf

on error resume next

Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

 

Set colItems = objWMIService.ExecQuery("SELECT Name, CurrentClockSpeed, SocketDesignation, Manufacturer FROM Win32_Processor")

 

i=1

For Each objItem in colItems

   objCommentFile.Write "Процессоры" & i & "|Свойства процессора|Производитель= " & ltrim(objItem.Manufacturer) & VbCrLf

   objCommentFile.Write "Процессоры" & i & "|Свойства процессора|Версия= " & ltrim(objItem.Name) & VbCrLf

   objCommentFile.Write "Процессоры" & i & "|Свойства процессора|Тип разъёма= " & ltrim(objItem.SocketDesignation) & VbCrLf

   objCommentFile.Write "Процессоры" & i & "|Свойства процессора|Текущая частота= " & ltrim(objItem.CurrentClockSpeed) & VbCrLf

i=i+1

Next

 

objCommentFile.Write VbCrLf

objCommentFile.Write VbCrLf

 

objCommentFile.Write "[Системная плата]"

objCommentFile.Write VbCrLf

objCommentFile.Write VbCrLf

 

on error resume next

Set colItems = objWMIService.ExecQuery("SELECT Product, OtherIdentifyingInfo, SerialNumber, Manufacturer FROM Win32_BaseBoard")

 

For Each objItem in colItems

 

 

objCommentFile.Write "Производитель системной платы|Фирма= " & ltrim(objItem.Manufacturer) & VbCrLf

objCommentFile.Write "Свойства системной платы|Системная плата= " & ltrim(objItem.Product) & VbCrLf

objCommentFile.Write "DMI|DMI серийный номер системной платы= " & ltrim(objItem.SerialNumber) & VbCrLf

 

Next

 

 

 

objCommentFile.Write VbCrLf

objCommentFile.Write VbCrLf

 

objCommentFile.Write "[Видео Windows]"

 

objCommentFile.Write VbCrLf

objCommentFile.Write VbCrLf

 

on error resume next

Set colItems = objWMIService.ExecQuery ("SELECT Name, AdapterRAM FROM Win32_VideoController")

i=1

For Each objItem in colItems

    objCommentFile.Write "Видео Windows" & i & "|Свойства видеоадаптера|Объем видеоОЗУ= " & round((((objItem.AdapterRAM) / 1024) / 1024),0) & " Мб."  & VbCrLf

    objCommentFile.Write "Видео Windows" & i & "|Свойства видеоадаптера|Описание устройства= " & ltrim(objItem.Name)  & VbCrLf

i=i+1

Next

 

objCommentFile.Write VbCrLf

objCommentFile.Write VbCrLf

 

objCommentFile.Write "[Монитор]"

 

objCommentFile.Write VbCrLf

objCommentFile.Write VbCrLf

 

on error resume next

Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_DesktopMonitor")

i=1

For Each objItem in colItems

   

objCommentFile.Write "Монитор" & i & "|Свойства монитора|Имя монитора= " & ltrim(objItem.Name)  & VbCrLf

objCommentFile.Write "Монитор" & i & "|Свойства монитора|ID монитора= " & ltrim(objItem.DeviceID)  & VbCrLf

objCommentFile.Write "Монитор" & i & "|Производитель монитора|Фирма= " & ltrim(objItem.MonitorManufacturer)  & VbCrLf

objCommentFile.Write "Монитор" & i & "|Свойства монитора|Тип монитора= " & ltrim(objItem.DisplayType)  & VbCrLf

i=i+1

Next

 

 

objCommentFile.Write VbCrLf

objCommentFile.Write VbCrLf

 

objCommentFile.Write "[ATA]"

 

objCommentFile.Write VbCrLf

objCommentFile.Write VbCrLf

 

on error resume next

Set colDiskDrives = objWMIService.ExecQuery ("SELECT Model, size, Manufacturer FROM Win32_DiskDrive")

 

i=1

For each objDiskDrive in colDiskDrives

 

   objCommentFile.Write "ATA" & i & "|Производитель ATA-устройства|Фирма= " & ltrim(objDiskDrive.Manufacturer)  & VbCrLf

   objCommentFile.Write "ATA" & i & "|Свойства устройства ATA|ID модели= " & ltrim(objDiskDrive.Model)  & VbCrLf

   objCommentFile.Write "ATA" & i & "|Физические данные устройства ATA|Форматированная ёмкость= " & round(((objDiskDrive.Size /1024)/1024)/1024,0)  & " ГБ"  & VbCrLf  

    

    i=i+1

Next

 
Set colDiskDrives = objWMIService.ExecQuery ("SELECT * FROM Win32_PhysicalMedia")
i=1

For each objDiskDrive in colDiskDrives
   objCommentFile.Write "ATA" & i & "|Свойства устройства ATA|Серийный номер= " & ltrim(objDiskDrive.SerialNumber)  & VbCrLf
    i=i+1

Next


objCommentFile.Write VbCrLf
objCommentFile.Write VbCrLf



objCommentFile.Write VbCrLf

objCommentFile.Write VbCrLf

 

objCommentFile.Write "[Оптические накопители]"

 

objCommentFile.Write VbCrLf

objCommentFile.Write VbCrLf

 

on error resume next

Set colItems = objWMIService.ExecQuery("Select * from Win32_CDROMDrive")

i=1

For Each objItem in colItems

 

    objCommentFile.Write "Оптические накопители" & i & "|Свойства оптического накопителя|Производитель= " & ltrim(objItem.Manufacturer)  & VbCrLf

    objCommentFile.Write "Оптические накопители" & i & "|Свойства оптического накопителя|Описание устройства= " & ltrim(objItem.Name)  & VbCrLf

   

    i=i+1

Next

 

 

 

objCommentFile.Write VbCrLf

objCommentFile.Write VbCrLf

 

objCommentFile.Write "[Принтеры]"

 

objCommentFile.Write VbCrLf

objCommentFile.Write VbCrLf

 

on error resume next

Set colInstalledPrinters =  objWMIService.ExecQuery ("SELECT Name FROM Win32_Printer")

i=1

For each objPrinter in colInstalledPrinters

 

if (objPrinter.Name = "Fax") or (objPrinter.Name = "Microsoft XPS Document Writer") or objPrinter.name = "Отправить в OneNote 2010" then
'If (clpSTR Like "*'*") And Not (tagSTR Like "*apos*") Then 

 

else

    objCommentFile.Write "Принтеры" & i & "|Свойства принтера|Имя принтера= " & ltrim(objPrinter.Name)   & VbCrLf

     i=i+1

end if

Next

 

objCommentFile.Write VbCrLf

objCommentFile.Write VbCrLf

 

objCommentFile.Write "[Сеть Windows]"

 

objCommentFile.Write VbCrLf

objCommentFile.Write VbCrLf

'######################################################################################################

 

on error resume next

Set colItems = objWMIService.ExecQuery _
    ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")

On Error Resume Next

 

i=1

For Each objItem in colItems

 

 

For Each arrValue In arrIPAddress

 

If Not IsNull(objItem.IPAddress) Then

      For z = 0 To UBound(objItem.IPAddress)

        objCommentFile.Write  "Сеть Windows" & i & "|Адреса сетевого адаптера|Маска IP / Подсети= " & ltrim(objItem.IPAddress(z))  & VbCrLf

      i=i+1

Next

   End If

 

i=1

objCommentFile.Write  "Сеть Windows" & i & "|Свойства сетевого адаптера|Аппаратный адрес= " & ltrim(objItem.MACAddress)  & VbCrLf

objCommentFile.Write  "Сеть Windows" & i & "|Свойства сетевого адаптера|Сетевой адаптер= " & ltrim(objItem.Description)  & VbCrLf

i=i+1

Next

 

 

 

Next

 

 

 

'#######################################################################################################

 

 

objCommentFile.Write VbCrLf

objCommentFile.Write VbCrLf

 

objCommentFile.Write "[Операционная система]"

 

objCommentFile.Write VbCrLf

objCommentFile.Write VbCrLf

 

on error resume next

Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

 

Set colOperatingSystems = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")

 

For Each objOperatingSystem in colOperatingSystems

    objCommentFile.Write "Свойства операционной системы|Название ОС= " & ltrim(objOperatingSystem.Caption) & VbCrLf

    objCommentFile.Write "Лицензионная информация|Ключ продукта= " & ltrim(objOperatingSystem.SerialNumber) & VbCrLf

    objCommentFile.Write "Свойства операционной системы|Версия ОС= " & ltrim(objOperatingSystem.Version) & VbCrLf

Next

 

objCommentFile.Write VbCrLf

objCommentFile.Write VbCrLf

 

objCommentFile.Write "[Установленные программы]"

 

objCommentFile.Write VbCrLf

objCommentFile.Write VbCrLf

 

on error resume next   

Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colSoftware = objWMIService.ExecQuery("SELECT Name, Vendor FROM Win32_Product")

 

i=1

For Each objSoftware in colSoftware

   objCommentFile.Write "Установленные программы" & i & "= " & ltrim(objSoftware.Name) & VbCrLf

   objCommentFile.Write objSoftware.Name & "|Publisher=" & ltrim(objSoftware.Vendor) & VbCrLf

      i=i+1

Next

 

 

Sub ShowError()

                strMsg = vbCrLf & "Error # " & Err.Number & vbCrLf & _
                         Err.Description & vbCrLf & vbCrLf

                Syntax

End Sub

 

 

objCommentFile.Close

    Dim oFSO As New FileSystemObject
    Dim oT As TextStream
  
    Set oT = oFSO.CreateTextFile("C:\a.txt")
    oT.WriteLine "1"
    oT.WriteLine "2"
    oT.Close